1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 $VERSION = eval $VERSION;
7 use CPAN::HandleConfig;
16 use ExtUtils::MakeMaker qw(prompt); # for some unknown reason,
17 # 5.005_04 does not work without
19 use File::Basename ();
26 use Sys::Hostname qw(hostname);
27 use Text::ParseWords ();
29 no lib "."; # we need to run chdir all over and we would get at wrong
32 require Mac::BuildTools if $^O eq 'MacOS';
34 END { $CPAN::End++; &cleanup; }
37 $CPAN::Frontend ||= "CPAN::Shell";
38 @CPAN::Defaultsites = ("http://www.perl.org/CPAN/","ftp://ftp.perl.org/pub/CPAN/")
39 unless @CPAN::Defaultsites;
40 # $CPAN::iCwd (i for initial) is going to be initialized during find_perl
41 $CPAN::Perl ||= CPAN::find_perl();
42 $CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
43 $CPAN::Defaultrecent ||= "http://search.cpan.org/recent";
49 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term
50 $Signal $Suppress_readline $Frontend
51 @Defaultsites $Have_warned $Defaultdocs $Defaultrecent
54 @CPAN::ISA = qw(CPAN::Debug Exporter);
56 # note that these functions live in CPAN::Shell and get executed via
57 # AUTOLOAD when called directly
78 sub soft_chdir_with_alternatives ($);
80 #-> sub CPAN::AUTOLOAD ;
85 @EXPORT{@EXPORT} = '';
86 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
87 if (exists $EXPORT{$l}){
90 die(qq{Unknown CPAN command "$AUTOLOAD". }.
91 qq{Type ? for help.\n});
98 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
99 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
101 my $oprompt = shift || CPAN::Prompt->new;
102 my $prompt = $oprompt;
103 my $commandline = shift || "";
104 $CPAN::CurrentCommandId ||= 1;
107 unless ($Suppress_readline) {
108 require Term::ReadLine;
111 $term->ReadLine eq "Term::ReadLine::Stub"
113 $term = Term::ReadLine->new('CPAN Monitor');
115 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
116 my $attribs = $term->Attribs;
117 $attribs->{attempted_completion_function} = sub {
118 &CPAN::Complete::gnu_cpl;
121 $readline::rl_completion_function =
122 $readline::rl_completion_function = 'CPAN::Complete::cpl';
124 if (my $histfile = $CPAN::Config->{'histfile'}) {{
125 unless ($term->can("AddHistory")) {
126 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
129 my($fh) = FileHandle->new;
130 open $fh, "<$histfile" or last;
134 $term->AddHistory($_);
138 # $term->OUT is autoflushed anyway
139 my $odef = select STDERR;
146 # no strict; # I do not recall why no strict was here (2000-09-03)
150 File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
151 File::Spec->rootdir(),
153 my $try_detect_readline;
154 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
155 my $rl_avail = $Suppress_readline ? "suppressed" :
156 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
157 "available (try 'install Bundle::CPAN')";
159 $CPAN::Frontend->myprint(
161 cpan shell -- CPAN exploration and modules installation (v%s)
168 unless $CPAN::Config->{'inhibit_startup_message'} ;
169 my($continuation) = "";
170 SHELLCOMMAND: while () {
171 if ($Suppress_readline) {
173 last SHELLCOMMAND unless defined ($_ = <> );
176 last SHELLCOMMAND unless
177 defined ($_ = $term->readline($prompt, $commandline));
179 $_ = "$continuation$_" if $continuation;
181 next SHELLCOMMAND if /^$/;
182 $_ = 'h' if /^\s*\?/;
183 if (/^(?:q(?:uit)?|bye|exit)$/i) {
194 use vars qw($import_done);
195 CPAN->import(':DEFAULT') unless $import_done++;
196 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
203 if ($] < 5.00322) { # parsewords had a bug until recently
206 eval { @line = Text::ParseWords::shellwords($_) };
207 warn($@), next SHELLCOMMAND if $@;
208 warn("Text::Parsewords could not parse the line [$_]"),
209 next SHELLCOMMAND unless @line;
211 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
212 my $command = shift @line;
213 eval { CPAN::Shell->$command(@line) };
215 if ($command =~ /^(make|test|install|force|notest|clean)$/) {
216 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
218 soft_chdir_with_alternatives(\@cwd);
219 $CPAN::Frontend->myprint("\n");
221 $CPAN::CurrentCommandId++;
225 $commandline = ""; # I do want to be able to pass a default to
226 # shell, but on the second command I see no
229 CPAN::Queue->nullify_queue;
230 if ($try_detect_readline) {
231 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
233 $CPAN::META->has_inst("Term::ReadLine::Perl")
235 delete $INC{"Term/ReadLine.pm"};
237 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
238 require Term::ReadLine;
239 $CPAN::Frontend->myprint("\n$redef subroutines in ".
240 "Term::ReadLine redefined\n");
246 soft_chdir_with_alternatives(\@cwd);
249 sub soft_chdir_with_alternatives ($) {
251 while (not chdir $cwd->[0]) {
253 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
254 Trying to chdir to "$cwd->[1]" instead.
258 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
263 package CPAN::CacheMgr;
265 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
270 use vars qw($Ua $Thesite $ThesiteURL $Themethod);
271 @CPAN::FTP::ISA = qw(CPAN::Debug);
273 package CPAN::LWP::UserAgent;
275 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
276 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
278 package CPAN::Complete;
280 @CPAN::Complete::ISA = qw(CPAN::Debug);
281 @CPAN::Complete::COMMANDS = sort qw(
282 ! a b d h i m o q r u
304 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03);
305 @CPAN::Index::ISA = qw(CPAN::Debug);
308 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
311 package CPAN::InfoObj;
313 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
315 package CPAN::Author;
317 @CPAN::Author::ISA = qw(CPAN::InfoObj);
319 package CPAN::Distribution;
321 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
323 package CPAN::Bundle;
325 @CPAN::Bundle::ISA = qw(CPAN::Module);
327 package CPAN::Module;
329 @CPAN::Module::ISA = qw(CPAN::InfoObj);
331 package CPAN::Exception::RecursiveDependency;
333 use overload '""' => "as_string";
340 for my $dep (@$deps) {
342 last if $seen{$dep}++;
344 bless { deps => \@deps }, $class;
349 "\nRecursive dependency detected:\n " .
350 join("\n => ", @{$self->{deps}}) .
351 ".\nCannot continue.\n";
354 package CPAN::Prompt; use overload '""' => "as_string";
355 use vars qw($prompt);
357 $CPAN::CurrentCommandId ||= 0;
362 if ($CPAN::Config->{commandnumber_in_prompt}) {
363 sprintf "cpan[%d]> ", $CPAN::CurrentCommandId;
369 package CPAN::Distrostatus;
370 use overload '""' => "as_string",
373 my($class,$arg) = @_;
376 FAILED => substr($arg,0,2) eq "NO",
377 COMMANDID => $CPAN::CurrentCommandId,
380 sub commandid { shift->{COMMANDID} }
381 sub failed { shift->{FAILED} }
385 $self->{TEXT} = $set;
396 use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY $PRINT_ORNAMENTING);
397 @CPAN::Shell::ISA = qw(CPAN::Debug);
398 $COLOR_REGISTERED ||= 0;
399 $PRINT_ORNAMENTING ||= 0;
401 #-> sub CPAN::Shell::AUTOLOAD ;
403 my($autoload) = $AUTOLOAD;
404 my $class = shift(@_);
405 # warn "autoload[$autoload] class[$class]";
406 $autoload =~ s/.*:://;
407 if ($autoload =~ /^w/) {
408 if ($CPAN::META->has_inst('CPAN::WAIT')) {
409 CPAN::WAIT->$autoload(@_);
411 $CPAN::Frontend->mywarn(qq{
412 Commands starting with "w" require CPAN::WAIT to be installed.
413 Please consider installing CPAN::WAIT to use the fulltext index.
414 For this you just need to type
419 $CPAN::Frontend->mywarn(qq{Unknown shell command '$autoload @_'. }.
428 # One use of the queue is to determine if we should or shouldn't
429 # announce the availability of a new CPAN module
431 # Now we try to use it for dependency tracking. For that to happen
432 # we need to draw a dependency tree and do the leaves first. This can
433 # easily be reached by running CPAN.pm recursively, but we don't want
434 # to waste memory and run into deep recursion. So what we can do is
437 # CPAN::Queue is the package where the queue is maintained. Dependencies
438 # often have high priority and must be brought to the head of the queue,
439 # possibly by jumping the queue if they are already there. My first code
440 # attempt tried to be extremely correct. Whenever a module needed
441 # immediate treatment, I either unshifted it to the front of the queue,
442 # or, if it was already in the queue, I spliced and let it bypass the
443 # others. This became a too correct model that made it impossible to put
444 # an item more than once into the queue. Why would you need that? Well,
445 # you need temporary duplicates as the manager of the queue is a loop
448 # (1) looks at the first item in the queue without shifting it off
450 # (2) cares for the item
452 # (3) removes the item from the queue, *even if its agenda failed and
453 # even if the item isn't the first in the queue anymore* (that way
454 # protecting against never ending queues)
456 # So if an item has prerequisites, the installation fails now, but we
457 # want to retry later. That's easy if we have it twice in the queue.
459 # I also expect insane dependency situations where an item gets more
460 # than two lives in the queue. Simplest example is triggered by 'install
461 # Foo Foo Foo'. People make this kind of mistakes and I don't want to
462 # get in the way. I wanted the queue manager to be a dumb servant, not
463 # one that knows everything.
465 # Who would I tell in this model that the user wants to be asked before
466 # processing? I can't attach that information to the module object,
467 # because not modules are installed but distributions. So I'd have to
468 # tell the distribution object that it should ask the user before
469 # processing. Where would the question be triggered then? Most probably
470 # in CPAN::Distribution::rematein.
471 # Hope that makes sense, my head is a bit off:-) -- AK
478 my $self = bless { qmod => $s }, $class;
483 # CPAN::Queue::first ;
489 # CPAN::Queue::delete_first ;
491 my($class,$what) = @_;
493 for my $i (0..$#All) {
494 if ( $All[$i]->{qmod} eq $what ) {
501 # CPAN::Queue::jumpqueue ;
505 CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
506 join(",",map {$_->{qmod}} @All),
509 WHAT: for my $what (reverse @what) {
511 for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
512 CPAN->debug("i[$All[$i]]what[$what]") if $CPAN::DEBUG;
513 if ($All[$i]->{qmod} eq $what){
515 if ($jumped > 100) { # one's OK if e.g. just
516 # processing now; more are OK if
517 # user typed it several times
518 $CPAN::Frontend->mywarn(
519 qq{Object [$what] queued more than 100 times, ignoring}
525 my $obj = bless { qmod => $what }, $class;
528 CPAN->debug(sprintf("after jumpqueue All[%s] what[%s]",
529 join(",",map {$_->{qmod}} @All),
534 # CPAN::Queue::exists ;
536 my($self,$what) = @_;
537 my @all = map { $_->{qmod} } @All;
538 my $exists = grep { $_->{qmod} eq $what } @All;
539 # warn "in exists what[$what] all[@all] exists[$exists]";
543 # CPAN::Queue::delete ;
546 @All = grep { $_->{qmod} ne $mod } @All;
549 # CPAN::Queue::nullify_queue ;
559 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
561 # from here on only subs.
562 ################################################################################
564 #-> sub CPAN::all_objects ;
566 my($mgr,$class) = @_;
567 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
568 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
570 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
572 *all = \&all_objects;
574 # Called by shell, not in batch mode. In batch mode I see no risk in
575 # having many processes updating something as installations are
576 # continually checked at runtime. In shell mode I suspect it is
577 # unintentional to open more than one shell at a time
579 #-> sub CPAN::checklock ;
582 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
583 if (-f $lockfile && -M _ > 0) {
584 my $fh = FileHandle->new($lockfile) or
585 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
586 my $otherpid = <$fh>;
587 my $otherhost = <$fh>;
589 if (defined $otherpid && $otherpid) {
592 if (defined $otherhost && $otherhost) {
595 my $thishost = hostname();
596 if (defined $otherhost && defined $thishost &&
597 $otherhost ne '' && $thishost ne '' &&
598 $otherhost ne $thishost) {
599 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
600 "reports other host $otherhost and other ".
601 "process $otherpid.\n".
602 "Cannot proceed.\n"));
604 elsif (defined $otherpid && $otherpid) {
605 return if $$ == $otherpid; # should never happen
606 $CPAN::Frontend->mywarn(
608 There seems to be running another CPAN process (pid $otherpid). Contacting...
610 if (kill 0, $otherpid) {
611 $CPAN::Frontend->mydie(qq{Other job is running.
612 You may want to kill it and delete the lockfile, maybe. On UNIX try:
616 } elsif (-w $lockfile) {
618 ExtUtils::MakeMaker::prompt
619 (qq{Other job not responding. Shall I overwrite }.
620 qq{the lockfile '$lockfile'? (Y/n)},"y");
621 $CPAN::Frontend->myexit("Ok, bye\n")
622 unless $ans =~ /^y/i;
625 qq{Lockfile '$lockfile' not writeable by you. }.
626 qq{Cannot proceed.\n}.
628 qq{ rm '$lockfile'\n}.
629 qq{ and then rerun us.\n}
633 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
634 "reports other process with ID ".
635 "$otherpid. Cannot proceed.\n"));
638 my $dotcpan = $CPAN::Config->{cpan_home};
639 eval { File::Path::mkpath($dotcpan);};
641 # A special case at least for Jarkko.
646 $symlinkcpan = readlink $dotcpan;
647 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
648 eval { File::Path::mkpath($symlinkcpan); };
652 $CPAN::Frontend->mywarn(qq{
653 Working directory $symlinkcpan created.
657 unless (-d $dotcpan) {
659 Your configuration suggests "$dotcpan" as your
660 CPAN.pm working directory. I could not create this directory due
661 to this error: $firsterror\n};
663 As "$dotcpan" is a symlink to "$symlinkcpan",
664 I tried to create that, but I failed with this error: $seconderror
667 Please make sure the directory exists and is writable.
669 $CPAN::Frontend->mydie($diemess);
671 } # $@ after eval mkpath $dotcpan
673 unless ($fh = FileHandle->new(">$lockfile")) {
674 if ($! =~ /Permission/) {
675 $CPAN::Frontend->myprint(qq{
677 Your configuration suggests that CPAN.pm should use a working
679 $CPAN::Config->{cpan_home}
680 Unfortunately we could not create the lock file
682 due to permission problems.
684 Please make sure that the configuration variable
685 \$CPAN::Config->{cpan_home}
686 points to a directory where you can write a .lock file. You can set
687 this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
690 if(!$INC{'CPAN/MyConfig.pm'}) {
691 $CPAN::Frontend->myprint("You don't seem to have a user ".
692 "configuration (MyConfig.pm) yet.\n");
693 my $new = ExtUtils::MakeMaker::prompt("Do you want to create a ".
694 "user configuration now? (Y/n)",
697 CPAN::Shell->mkmyconfig();
702 $CPAN::Frontend->mydie("Could not open >$lockfile: $!");
704 $fh->print($$, "\n");
705 $fh->print(hostname(), "\n");
706 $self->{LOCK} = $lockfile;
710 $CPAN::Frontend->mydie("Got SIGTERM, leaving");
715 $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
716 print "Caught SIGINT\n";
720 # From: Larry Wall <larry@wall.org>
721 # Subject: Re: deprecating SIGDIE
722 # To: perl5-porters@perl.org
723 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
725 # The original intent of __DIE__ was only to allow you to substitute one
726 # kind of death for another on an application-wide basis without respect
727 # to whether you were in an eval or not. As a global backstop, it should
728 # not be used any more lightly (or any more heavily :-) than class
729 # UNIVERSAL. Any attempt to build a general exception model on it should
730 # be politely squashed. Any bug that causes every eval {} to have to be
731 # modified should be not so politely squashed.
733 # Those are my current opinions. It is also my optinion that polite
734 # arguments degenerate to personal arguments far too frequently, and that
735 # when they do, it's because both people wanted it to, or at least didn't
736 # sufficiently want it not to.
740 # global backstop to cleanup if we should really die
741 $SIG{__DIE__} = \&cleanup;
742 $self->debug("Signal handler set.") if $CPAN::DEBUG;
745 #-> sub CPAN::DESTROY ;
747 &cleanup; # need an eval?
750 #-> sub CPAN::anycwd ;
753 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
758 sub cwd {Cwd::cwd();}
760 #-> sub CPAN::getcwd ;
761 sub getcwd {Cwd::getcwd();}
763 #-> sub CPAN::fastcwd ;
764 sub fastcwd {Cwd::fastcwd();}
766 #-> sub CPAN::backtickcwd ;
767 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
769 #-> sub CPAN::find_perl ;
771 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
772 my $pwd = $CPAN::iCwd = CPAN::anycwd();
773 my $candidate = File::Spec->catfile($pwd,$^X);
774 $perl ||= $candidate if MM->maybe_command($candidate);
777 my ($component,$perl_name);
778 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
779 PATH_COMPONENT: foreach $component (File::Spec->path(),
780 $Config::Config{'binexp'}) {
781 next unless defined($component) && $component;
782 my($abs) = File::Spec->catfile($component,$perl_name);
783 if (MM->maybe_command($abs)) {
795 #-> sub CPAN::exists ;
797 my($mgr,$class,$id) = @_;
798 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
800 ### Carp::croak "exists called without class argument" unless $class;
802 $id =~ s/:+/::/g if $class eq "CPAN::Module";
803 exists $META->{readonly}{$class}{$id} or
804 exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
807 #-> sub CPAN::delete ;
809 my($mgr,$class,$id) = @_;
810 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
811 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
814 #-> sub CPAN::has_usable
815 # has_inst is sometimes too optimistic, we should replace it with this
816 # has_usable whenever a case is given
818 my($self,$mod,$message) = @_;
819 return 1 if $HAS_USABLE->{$mod};
820 my $has_inst = $self->has_inst($mod,$message);
821 return unless $has_inst;
824 LWP => [ # we frequently had "Can't locate object
825 # method "new" via package "LWP::UserAgent" at
826 # (eval 69) line 2006
828 sub {require LWP::UserAgent},
829 sub {require HTTP::Request},
830 sub {require URI::URL},
833 sub {require Net::FTP},
834 sub {require Net::Config},
837 sub {require File::HomeDir;
838 unless (File::HomeDir->VERSION >= 0.52){
839 for ("Will not use File::HomeDir, need 0.52\n") {
847 if ($usable->{$mod}) {
848 for my $c (0..$#{$usable->{$mod}}) {
849 my $code = $usable->{$mod}[$c];
850 my $ret = eval { &$code() };
851 $ret = "" unless defined $ret;
853 # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
858 return $HAS_USABLE->{$mod} = 1;
861 #-> sub CPAN::has_inst
863 my($self,$mod,$message) = @_;
864 Carp::croak("CPAN->has_inst() called without an argument")
866 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
867 keys %{$CPAN::Config->{dontload_hash}||{}},
868 @{$CPAN::Config->{dontload_list}||[]};
869 if (defined $message && $message eq "no" # afair only used by Nox
873 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
881 # checking %INC is wrong, because $INC{LWP} may be true
882 # although $INC{"URI/URL.pm"} may have failed. But as
883 # I really want to say "bla loaded OK", I have to somehow
885 ### warn "$file in %INC"; #debug
887 } elsif (eval { require $file }) {
888 # eval is good: if we haven't yet read the database it's
889 # perfect and if we have installed the module in the meantime,
890 # it tries again. The second require is only a NOOP returning
891 # 1 if we had success, otherwise it's retrying
893 $CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
894 if ($mod eq "CPAN::WAIT") {
895 push @CPAN::Shell::ISA, 'CPAN::WAIT';
898 } elsif ($mod eq "Net::FTP") {
899 $CPAN::Frontend->mywarn(qq{
900 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
902 install Bundle::libnet
904 }) unless $Have_warned->{"Net::FTP"}++;
906 } elsif ($mod eq "Digest::SHA"){
907 if ($Have_warned->{"Digest::SHA"}++) {
908 $CPAN::Frontend->myprint(qq{CPAN: checksum security checks disabled}.
909 qq{because Digest::SHA not installed.\n});
911 $CPAN::Frontend->myprint(qq{
912 CPAN: checksum security checks disabled because Digest::SHA not installed.
913 Please consider installing the Digest::SHA module.
918 } elsif ($mod eq "Module::Signature"){
919 unless ($Have_warned->{"Module::Signature"}++) {
920 # No point in complaining unless the user can
921 # reasonably install and use it.
922 if (eval { require Crypt::OpenPGP; 1 } ||
923 defined $CPAN::Config->{'gpg'}) {
924 $CPAN::Frontend->myprint(qq{
925 CPAN: Module::Signature security checks disabled because Module::Signature
926 not installed. Please consider installing the Module::Signature module.
927 You may also need to be able to connect over the Internet to the public
928 keyservers like pgp.mit.edu (port 11371).
935 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
940 #-> sub CPAN::instance ;
942 my($mgr,$class,$id) = @_;
945 # unsafe meta access, ok?
946 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
947 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
955 #-> sub CPAN::cleanup ;
957 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
958 local $SIG{__DIE__} = '';
963 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
965 $subroutine eq '(eval)';
967 return if $ineval && !$CPAN::End;
968 return unless defined $META->{LOCK};
969 return unless -f $META->{LOCK};
971 unlink $META->{LOCK};
973 # Carp::cluck("DEBUGGING");
974 $CPAN::Frontend->mywarn("Lockfile removed.\n");
977 #-> sub CPAN::savehist
980 my($histfile,$histsize);
981 unless ($histfile = $CPAN::Config->{'histfile'}){
982 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
985 $histsize = $CPAN::Config->{'histsize'} || 100;
987 unless ($CPAN::term->can("GetHistory")) {
988 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
994 my @h = $CPAN::term->GetHistory;
995 splice @h, 0, @h-$histsize if @h>$histsize;
996 my($fh) = FileHandle->new;
997 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
998 local $\ = local $, = "\n";
1004 my($self,$what) = @_;
1005 $self->{is_tested}{$what} = 1;
1009 my($self,$what) = @_;
1010 delete $self->{is_tested}{$what};
1015 $self->{is_tested} ||= {};
1016 return unless %{$self->{is_tested}};
1017 my $env = $ENV{PERL5LIB};
1018 $env = $ENV{PERLLIB} unless defined $env;
1020 push @env, $env if defined $env and length $env;
1021 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1022 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1023 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1026 package CPAN::CacheMgr;
1029 #-> sub CPAN::CacheMgr::as_string ;
1031 eval { require Data::Dumper };
1033 return shift->SUPER::as_string;
1035 return Data::Dumper::Dumper(shift);
1039 #-> sub CPAN::CacheMgr::cachesize ;
1044 #-> sub CPAN::CacheMgr::tidyup ;
1047 return unless -d $self->{ID};
1048 while ($self->{DU} > $self->{'MAX'} ) {
1049 my($toremove) = shift @{$self->{FIFO}};
1050 $CPAN::Frontend->myprint(sprintf(
1051 "Deleting from cache".
1052 ": $toremove (%.1f>%.1f MB)\n",
1053 $self->{DU}, $self->{'MAX'})
1055 return if $CPAN::Signal;
1056 $self->force_clean_cache($toremove);
1057 return if $CPAN::Signal;
1061 #-> sub CPAN::CacheMgr::dir ;
1066 #-> sub CPAN::CacheMgr::entries ;
1068 my($self,$dir) = @_;
1069 return unless defined $dir;
1070 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1071 $dir ||= $self->{ID};
1072 my($cwd) = CPAN::anycwd();
1073 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1074 my $dh = DirHandle->new(File::Spec->curdir)
1075 or Carp::croak("Couldn't opendir $dir: $!");
1078 next if $_ eq "." || $_ eq "..";
1080 push @entries, File::Spec->catfile($dir,$_);
1082 push @entries, File::Spec->catdir($dir,$_);
1084 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1087 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1088 sort { -M $b <=> -M $a} @entries;
1091 #-> sub CPAN::CacheMgr::disk_usage ;
1093 my($self,$dir) = @_;
1094 return if exists $self->{SIZE}{$dir};
1095 return if $CPAN::Signal;
1099 unless (chmod 0755, $dir) {
1100 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1101 "permission to change the permission; cannot ".
1102 "estimate disk usage of '$dir'\n");
1103 $CPAN::Frontend->mysleep(5);
1108 $CPAN::Frontend->mywarn("Directory '$dir' has gone. Cannot continue.\n");
1109 $CPAN::Frontend->mysleep(2);
1114 $File::Find::prune++ if $CPAN::Signal;
1116 if ($^O eq 'MacOS') {
1118 my $cat = Mac::Files::FSpGetCatInfo($_);
1119 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1123 unless (chmod 0755, $_) {
1124 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1125 "the permission to change the permission; ".
1126 "can only partially estimate disk usage ".
1139 return if $CPAN::Signal;
1140 $self->{SIZE}{$dir} = $Du/1024/1024;
1141 push @{$self->{FIFO}}, $dir;
1142 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1143 $self->{DU} += $Du/1024/1024;
1147 #-> sub CPAN::CacheMgr::force_clean_cache ;
1148 sub force_clean_cache {
1149 my($self,$dir) = @_;
1150 return unless -e $dir;
1151 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1153 File::Path::rmtree($dir);
1154 $self->{DU} -= $self->{SIZE}{$dir};
1155 delete $self->{SIZE}{$dir};
1158 #-> sub CPAN::CacheMgr::new ;
1165 ID => $CPAN::Config->{'build_dir'},
1166 MAX => $CPAN::Config->{'build_cache'},
1167 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1170 File::Path::mkpath($self->{ID});
1171 my $dh = DirHandle->new($self->{ID});
1172 bless $self, $class;
1175 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1177 CPAN->debug($debug) if $CPAN::DEBUG;
1181 #-> sub CPAN::CacheMgr::scan_cache ;
1184 return if $self->{SCAN} eq 'never';
1185 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1186 unless $self->{SCAN} eq 'atstart';
1187 $CPAN::Frontend->myprint(
1188 sprintf("Scanning cache %s for sizes\n",
1191 for $e ($self->entries($self->{ID})) {
1192 next if $e eq ".." || $e eq ".";
1193 $self->disk_usage($e);
1194 return if $CPAN::Signal;
1199 package CPAN::Shell;
1202 #-> sub CPAN::Shell::h ;
1204 my($class,$about) = @_;
1205 if (defined $about) {
1206 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1208 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1209 $CPAN::Frontend->myprint(qq{
1210 Display Information $filler (ver $CPAN::VERSION)
1211 command argument description
1212 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1213 i WORD or /REGEXP/ about any of the above
1214 r NONE report updatable modules
1215 ls AUTHOR or GLOB about files in the author's directory
1216 (with WORD being a module, bundle or author name or a distribution
1217 name of the form AUTHOR/DISTRIBUTION)
1219 Download, Test, Make, Install...
1220 get download clean make clean
1221 make make (implies get) look open subshell in dist directory
1222 test make test (implies make) readme display these README files
1223 install make install (implies test) perldoc display POD documentation
1226 force COMMAND unconditionally do command
1227 notest COMMAND skip testing
1230 h,? display this menu ! perl-code eval a perl command
1231 o conf [opt] set and query options q quit the cpan shell
1232 reload cpan load CPAN.pm again reload index load newer indices
1233 autobundle Snapshot recent latest CPAN uploads});
1239 #-> sub CPAN::Shell::a ;
1241 my($self,@arg) = @_;
1242 # authors are always UPPERCASE
1244 $_ = uc $_ unless /=/;
1246 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1249 #-> sub CPAN::Shell::globls ;
1251 my($self,$s,$pragmas) = @_;
1252 # ls is really very different, but we had it once as an ordinary
1253 # command in the Shell (upto rev. 321) and we could not handle
1255 my(@accept,@preexpand);
1256 if ($s =~ /[\*\?\/]/) {
1257 if ($CPAN::META->has_inst("Text::Glob")) {
1258 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1259 my $rau = Text::Glob::glob_to_regex(uc $au);
1260 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1262 push @preexpand, map { $_->id . "/" . $pathglob }
1263 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1265 my $rau = Text::Glob::glob_to_regex(uc $s);
1266 push @preexpand, map { $_->id }
1267 CPAN::Shell->expand_by_method('CPAN::Author',
1272 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1275 push @preexpand, uc $s;
1278 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1279 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1284 my $silent = @accept>1;
1285 my $last_alpha = "";
1287 for my $a (@accept){
1288 my($author,$pathglob);
1289 if ($a =~ m|(.*?)/(.*)|) {
1292 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1294 $a2) or die "No author found for $a2";
1296 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1298 $a) or die "No author found for $a";
1301 my $alpha = substr $author->id, 0, 1;
1303 if ($alpha eq $last_alpha) {
1307 $last_alpha = $alpha;
1309 $CPAN::Frontend->myprint($ad);
1311 for my $pragma (@$pragmas) {
1312 if ($author->can($pragma)) {
1316 push @results, $author->ls($pathglob,$silent); # silent if
1319 for my $pragma (@$pragmas) {
1320 my $meth = "un$pragma";
1321 if ($author->can($meth)) {
1329 #-> sub CPAN::Shell::local_bundles ;
1331 my($self,@which) = @_;
1332 my($incdir,$bdir,$dh);
1333 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1334 my @bbase = "Bundle";
1335 while (my $bbase = shift @bbase) {
1336 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1337 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1338 if ($dh = DirHandle->new($bdir)) { # may fail
1340 for $entry ($dh->read) {
1341 next if $entry =~ /^\./;
1342 next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
1343 if (-d File::Spec->catdir($bdir,$entry)){
1344 push @bbase, "$bbase\::$entry";
1346 next unless $entry =~ s/\.pm(?!\n)\Z//;
1347 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1355 #-> sub CPAN::Shell::b ;
1357 my($self,@which) = @_;
1358 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1359 $self->local_bundles;
1360 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1363 #-> sub CPAN::Shell::d ;
1364 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1366 #-> sub CPAN::Shell::m ;
1367 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1369 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1372 #-> sub CPAN::Shell::i ;
1376 @args = '/./' unless @args;
1378 for my $type (qw/Bundle Distribution Module/) {
1379 push @result, $self->expand($type,@args);
1381 # Authors are always uppercase.
1382 push @result, $self->expand("Author", map { uc $_ } @args);
1384 my $result = @result == 1 ?
1385 $result[0]->as_string :
1387 "No objects found of any type for argument @args\n" :
1389 (map {$_->as_glimpse} @result),
1390 scalar @result, " items found\n",
1392 $CPAN::Frontend->myprint($result);
1395 #-> sub CPAN::Shell::o ;
1397 # CPAN::Shell::o and CPAN::Config::edit are closely related. 'o conf'
1398 # should have been called set and 'o debug' maybe 'set debug'
1400 my($self,$o_type,@o_what) = @_;
1403 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1404 if ($o_type eq 'conf') {
1405 if (!@o_what) { # print all things, "o conf"
1407 $CPAN::Frontend->myprint("CPAN::Config options");
1408 if (exists $INC{'CPAN/Config.pm'}) {
1409 $CPAN::Frontend->myprint(" from $INC{'CPAN/Config.pm'}");
1411 if (exists $INC{'CPAN/MyConfig.pm'}) {
1412 $CPAN::Frontend->myprint(" and $INC{'CPAN/MyConfig.pm'}");
1414 $CPAN::Frontend->myprint(":\n");
1415 for $k (sort keys %CPAN::HandleConfig::can) {
1416 $v = $CPAN::HandleConfig::can{$k};
1417 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
1419 $CPAN::Frontend->myprint("\n");
1420 for $k (sort keys %$CPAN::Config) {
1421 CPAN::HandleConfig->prettyprint($k);
1423 $CPAN::Frontend->myprint("\n");
1424 } elsif (!CPAN::HandleConfig->edit(@o_what)) {
1425 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
1428 } elsif ($o_type eq 'debug') {
1430 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1433 my($what) = shift @o_what;
1434 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1435 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1438 if ( exists $CPAN::DEBUG{$what} ) {
1439 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1440 } elsif ($what =~ /^\d/) {
1441 $CPAN::DEBUG = $what;
1442 } elsif (lc $what eq 'all') {
1444 for (values %CPAN::DEBUG) {
1447 $CPAN::DEBUG = $max;
1450 for (keys %CPAN::DEBUG) {
1451 next unless lc($_) eq lc($what);
1452 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1455 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1460 my $raw = "Valid options for debug are ".
1461 join(", ",sort(keys %CPAN::DEBUG), 'all').
1462 qq{ or a number. Completion works on the options. }.
1463 qq{Case is ignored.};
1465 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1466 $CPAN::Frontend->myprint("\n\n");
1469 $CPAN::Frontend->myprint("Options set for debugging:\n");
1471 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1472 $v = $CPAN::DEBUG{$k};
1473 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1474 if $v & $CPAN::DEBUG;
1477 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1480 $CPAN::Frontend->myprint(qq{
1482 conf set or get configuration variables
1483 debug set or get debugging options
1488 sub paintdots_onreload {
1491 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
1495 # $CPAN::Frontend->myprint(".($subr)");
1496 $CPAN::Frontend->myprint(".");
1503 #-> sub CPAN::Shell::reload ;
1505 my($self,$command,@arg) = @_;
1507 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1508 if ($command =~ /cpan/i) {
1510 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
1512 MFILE: for my $f (qw(CPAN.pm CPAN/HandleConfig.pm CPAN/FirstTime.pm CPAN/Tarzip.pm
1513 CPAN/Debug.pm CPAN/Version.pm)) {
1514 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
1515 $self->reload_this($f) or $failed++;
1517 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1518 $failed++ unless $redef;
1520 $CPAN::Frontend->mywarn("\n$failed errors during reload. You better quit ".
1523 } elsif ($command =~ /index/) {
1524 CPAN::Index->force_reload;
1526 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
1527 index re-reads the index files\n});
1533 return 1 unless $INC{$f};
1534 my $pwd = CPAN::anycwd();
1535 CPAN->debug("reloading the whole '$f' from '$INC{$f}' while pwd='$pwd'")
1538 for my $inc (@INC) {
1539 $read = File::Spec->catfile($inc,split /\//, $f);
1546 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
1549 my $fh = FileHandle->new($read) or
1550 $CPAN::Frontend->mydie("Could not open $read: $!");
1554 CPAN->debug(sprintf("evaling [%s...]\n",substr($eval,0,64)))
1564 #-> sub CPAN::Shell::mkmyconfig ;
1566 my($self, $cpanpm, %args) = @_;
1567 require CPAN::FirstTime;
1568 my $home = CPAN::HandleConfig::home;
1569 $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
1570 File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
1571 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
1572 CPAN::HandleConfig::require_myconfig_or_config;
1573 $CPAN::Config ||= {};
1578 keep_source_where => undef,
1581 CPAN::FirstTime::init($cpanpm, %args);
1584 #-> sub CPAN::Shell::_binary_extensions ;
1585 sub _binary_extensions {
1586 my($self) = shift @_;
1587 my(@result,$module,%seen,%need,$headerdone);
1588 for $module ($self->expand('Module','/./')) {
1589 my $file = $module->cpan_file;
1590 next if $file eq "N/A";
1591 next if $file =~ /^Contact Author/;
1592 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
1593 next if $dist->isa_perl;
1594 next unless $module->xs_file;
1596 $CPAN::Frontend->myprint(".");
1597 push @result, $module;
1599 # print join " | ", @result;
1600 $CPAN::Frontend->myprint("\n");
1604 #-> sub CPAN::Shell::recompile ;
1606 my($self) = shift @_;
1607 my($module,@module,$cpan_file,%dist);
1608 @module = $self->_binary_extensions();
1609 for $module (@module){ # we force now and compile later, so we
1611 $cpan_file = $module->cpan_file;
1612 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1614 $dist{$cpan_file}++;
1616 for $cpan_file (sort keys %dist) {
1617 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1618 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1620 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1621 # stop a package from recompiling,
1622 # e.g. IO-1.12 when we have perl5.003_10
1626 #-> sub CPAN::Shell::_u_r_common ;
1628 my($self) = shift @_;
1629 my($what) = shift @_;
1630 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1631 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
1632 $what && $what =~ /^[aru]$/;
1634 @args = '/./' unless @args;
1635 my(@result,$module,%seen,%need,$headerdone,
1636 $version_undefs,$version_zeroes);
1637 $version_undefs = $version_zeroes = 0;
1638 my $sprintf = "%s%-25s%s %9s %9s %s\n";
1639 my @expand = $self->expand('Module',@args);
1640 my $expand = scalar @expand;
1641 if (0) { # Looks like noise to me, was very useful for debugging
1642 # for metadata cache
1643 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
1645 MODULE: for $module (@expand) {
1646 my $file = $module->cpan_file;
1647 next MODULE unless defined $file; # ??
1648 $file =~ s|^./../||;
1649 my($latest) = $module->cpan_version;
1650 my($inst_file) = $module->inst_file;
1652 return if $CPAN::Signal;
1655 $have = $module->inst_version;
1656 } elsif ($what eq "r") {
1657 $have = $module->inst_version;
1659 if ($have eq "undef"){
1661 } elsif ($have == 0){
1664 next MODULE unless CPAN::Version->vgt($latest, $have);
1665 # to be pedantic we should probably say:
1666 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
1667 # to catch the case where CPAN has a version 0 and we have a version undef
1668 } elsif ($what eq "u") {
1674 } elsif ($what eq "r") {
1676 } elsif ($what eq "u") {
1680 return if $CPAN::Signal; # this is sometimes lengthy
1683 push @result, sprintf "%s %s\n", $module->id, $have;
1684 } elsif ($what eq "r") {
1685 push @result, $module->id;
1686 next MODULE if $seen{$file}++;
1687 } elsif ($what eq "u") {
1688 push @result, $module->id;
1689 next MODULE if $seen{$file}++;
1690 next MODULE if $file =~ /^Contact/;
1692 unless ($headerdone++){
1693 $CPAN::Frontend->myprint("\n");
1694 $CPAN::Frontend->myprint(sprintf(
1697 "Package namespace",
1709 $CPAN::META->has_inst("Term::ANSIColor")
1711 $module->description
1713 $color_on = Term::ANSIColor::color("green");
1714 $color_off = Term::ANSIColor::color("reset");
1716 $CPAN::Frontend->myprint(sprintf $sprintf,
1723 $need{$module->id}++;
1727 $CPAN::Frontend->myprint("No modules found for @args\n");
1728 } elsif ($what eq "r") {
1729 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
1733 if ($version_zeroes) {
1734 my $s_has = $version_zeroes > 1 ? "s have" : " has";
1735 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
1736 qq{a version number of 0\n});
1738 if ($version_undefs) {
1739 my $s_has = $version_undefs > 1 ? "s have" : " has";
1740 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
1741 qq{parseable version number\n});
1747 #-> sub CPAN::Shell::r ;
1749 shift->_u_r_common("r",@_);
1752 #-> sub CPAN::Shell::u ;
1754 shift->_u_r_common("u",@_);
1757 #-> sub CPAN::Shell::failed ;
1759 my($self,$only_id,$silent) = @_;
1761 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
1763 NAY: for my $nosayer (
1771 next unless exists $d->{$nosayer};
1773 $d->{$nosayer}->can("failed") ?
1774 $d->{$nosayer}->failed :
1775 $d->{$nosayer} =~ /^NO/
1777 next NAY if $only_id && $only_id != (
1778 $d->{$nosayer}->can("commandid")
1780 $d->{$nosayer}->commandid
1782 $CPAN::CurrentCommandId
1787 next DIST unless $failed;
1791 # " %-45s: %s %s\n",
1794 $d->{$failed}->can("failed") ?
1796 $d->{$failed}->commandid,
1799 $d->{$failed}->text,
1809 my $scope = $only_id ? "command" : "session";
1811 my $print = join "",
1812 map { sprintf " %-45s: %s %s\n", @$_[1,2,3] }
1813 sort { $a->[0] <=> $b->[0] } @failed;
1814 $CPAN::Frontend->myprint("Failed during this $scope:\n$print");
1815 } elsif (!$only_id || !$silent) {
1816 $CPAN::Frontend->myprint("Nothing failed in this $scope\n");
1820 # XXX intentionally undocumented because completely bogus, unportable,
1823 #-> sub CPAN::Shell::status ;
1826 require Devel::Size;
1827 my $ps = FileHandle->new;
1828 open $ps, "/proc/$$/status";
1831 next unless /VmSize:\s+(\d+)/;
1835 $CPAN::Frontend->mywarn(sprintf(
1836 "%-27s %6d\n%-27s %6d\n",
1840 Devel::Size::total_size($CPAN::META)/1024,
1842 for my $k (sort keys %$CPAN::META) {
1843 next unless substr($k,0,4) eq "read";
1844 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
1845 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
1846 warn sprintf " %-25s %6d %6d\n",
1848 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
1849 scalar keys %{$CPAN::META->{$k}{$k2}};
1854 #-> sub CPAN::Shell::autobundle ;
1857 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
1858 my(@bundle) = $self->_u_r_common("a",@_);
1859 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1860 File::Path::mkpath($todir);
1861 unless (-d $todir) {
1862 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
1865 my($y,$m,$d) = (localtime)[5,4,3];
1869 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
1870 my($to) = File::Spec->catfile($todir,"$me.pm");
1872 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
1873 $to = File::Spec->catfile($todir,"$me.pm");
1875 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
1877 "package Bundle::$me;\n\n",
1878 "\$VERSION = '0.01';\n\n",
1882 "Bundle::$me - Snapshot of installation on ",
1883 $Config::Config{'myhostname'},
1886 "\n\n=head1 SYNOPSIS\n\n",
1887 "perl -MCPAN -e 'install Bundle::$me'\n\n",
1888 "=head1 CONTENTS\n\n",
1889 join("\n", @bundle),
1890 "\n\n=head1 CONFIGURATION\n\n",
1892 "\n\n=head1 AUTHOR\n\n",
1893 "This Bundle has been generated automatically ",
1894 "by the autobundle routine in CPAN.pm.\n",
1897 $CPAN::Frontend->myprint("\nWrote bundle file
1901 #-> sub CPAN::Shell::expandany ;
1904 CPAN->debug("s[$s]") if $CPAN::DEBUG;
1905 if ($s =~ m|/|) { # looks like a file
1906 $s = CPAN::Distribution->normalize($s);
1907 return $CPAN::META->instance('CPAN::Distribution',$s);
1908 # Distributions spring into existence, not expand
1909 } elsif ($s =~ m|^Bundle::|) {
1910 $self->local_bundles; # scanning so late for bundles seems
1911 # both attractive and crumpy: always
1912 # current state but easy to forget
1914 return $self->expand('Bundle',$s);
1916 return $self->expand('Module',$s)
1917 if $CPAN::META->exists('CPAN::Module',$s);
1922 #-> sub CPAN::Shell::expand ;
1925 my($type,@args) = @_;
1926 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
1927 my $class = "CPAN::$type";
1928 my $methods = ['id'];
1929 for my $meth (qw(name)) {
1930 next if $] < 5.00303; # no "can"
1931 next unless $class->can($meth);
1932 push @$methods, $meth;
1934 $self->expand_by_method($class,$methods,@args);
1937 sub expand_by_method {
1939 my($class,$methods,@args) = @_;
1942 my($regex,$command);
1943 if ($arg =~ m|^/(.*)/$|) {
1945 } elsif ($arg =~ m/=/) {
1949 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
1951 defined $regex ? $regex : "UNDEFINED",
1952 defined $command ? $command : "UNDEFINED",
1954 if (defined $regex) {
1956 $CPAN::META->all_objects($class)
1959 # BUG, we got an empty object somewhere
1960 require Data::Dumper;
1961 CPAN->debug(sprintf(
1962 "Bug in CPAN: Empty id on obj[%s][%s]",
1964 Data::Dumper::Dumper($obj)
1968 for my $method (@$methods) {
1969 if ($obj->$method() =~ /$regex/i) {
1975 } elsif ($command) {
1976 die "equal sign in command disabled (immature interface), ".
1978 ! \$CPAN::Shell::ADVANCED_QUERY=1
1979 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
1980 that may go away anytime.\n"
1981 unless $ADVANCED_QUERY;
1982 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
1983 my($matchcrit) = $criterion =~ m/^~(.+)/;
1987 $CPAN::META->all_objects($class)
1989 my $lhs = $self->$method() or next; # () for 5.00503
1991 push @m, $self if $lhs =~ m/$matchcrit/;
1993 push @m, $self if $lhs eq $criterion;
1998 if ( $class eq 'CPAN::Bundle' ) {
1999 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
2000 } elsif ($class eq "CPAN::Distribution") {
2001 $xarg = CPAN::Distribution->normalize($arg);
2005 if ($CPAN::META->exists($class,$xarg)) {
2006 $obj = $CPAN::META->instance($class,$xarg);
2007 } elsif ($CPAN::META->exists($class,$arg)) {
2008 $obj = $CPAN::META->instance($class,$arg);
2015 @m = sort {$a->id cmp $b->id} @m;
2016 if ( $CPAN::DEBUG ) {
2017 my $wantarray = wantarray;
2018 my $join_m = join ",", map {$_->id} @m;
2019 $self->debug("wantarray[$wantarray]join_m[$join_m]");
2021 return wantarray ? @m : $m[0];
2024 #-> sub CPAN::Shell::format_result ;
2027 my($type,@args) = @_;
2028 @args = '/./' unless @args;
2029 my(@result) = $self->expand($type,@args);
2030 my $result = @result == 1 ?
2031 $result[0]->as_string :
2033 "No objects of type $type found for argument @args\n" :
2035 (map {$_->as_glimpse} @result),
2036 scalar @result, " items found\n",
2041 #-> sub CPAN::Shell::report_fh ;
2043 my $installation_report_fh;
2044 my $previously_noticed = 0;
2047 return $installation_report_fh if $installation_report_fh;
2048 if ($CPAN::META->has_inst("File::Temp")) {
2049 $installation_report_fh
2051 template => 'cpan_install_XXXX',
2056 unless ( $installation_report_fh ) {
2057 warn("Couldn't open installation report file; " .
2058 "no report file will be generated."
2059 ) unless $previously_noticed++;
2065 # The only reason for this method is currently to have a reliable
2066 # debugging utility that reveals which output is going through which
2067 # channel. No, I don't like the colors ;-)
2069 #-> sub CPAN::Shell::print_ornameted ;
2070 sub print_ornamented {
2071 my($self,$what,$ornament) = @_;
2073 return unless defined $what;
2075 local $| = 1; # Flush immediately
2076 if ( $CPAN::Be_Silent ) {
2077 print {report_fh()} $what;
2081 if ($CPAN::Config->{term_is_latin}){
2084 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
2086 if ($PRINT_ORNAMENTING) {
2087 unless (defined &color) {
2088 if ($CPAN::META->has_inst("Term::ANSIColor")) {
2089 import Term::ANSIColor "color";
2091 *color = sub { return "" };
2095 for $line (split /\n/, $what) {
2096 $longest = length($line) if length($line) > $longest;
2098 my $sprintf = "%-" . $longest . "s";
2100 $what =~ s/(.*\n?)//m;
2103 my($nl) = chomp $line ? "\n" : "";
2104 # print "line[$line]ornament[$ornament]sprintf[$sprintf]\n";
2105 print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
2109 # $what .= "\n"; # newlines unless $PRINT_ORNAMENTING
2115 my($self,$what) = @_;
2117 $self->print_ornamented($what, 'bold blue on_yellow');
2121 my($self,$what) = @_;
2122 $self->myprint($what);
2127 my($self,$what) = @_;
2128 $self->print_ornamented($what, 'bold red on_yellow');
2132 # my($self,$what) = @_;
2133 # $self->print_ornamented($what, 'bold red on_white');
2134 # Carp::confess "died";
2137 # only to be used for shell commands
2139 my($self,$what) = @_;
2140 $self->print_ornamented($what, 'bold red on_white');
2142 # If it is the shell, we want that the following die to be silent,
2143 # but if it is not the shell, we would need a 'die $what'. We need
2144 # to take care that only shell commands use mydie. Is this
2150 # use this only for unrecoverable errors!
2151 sub unrecoverable_error {
2152 my($self,$what) = @_;
2153 my @lines = split /\n/, $what;
2155 for my $l (@lines) {
2156 $longest = length $l if length $l > $longest;
2158 $longest = 62 if $longest > 62;
2159 for my $l (@lines) {
2165 if (length $l < 66) {
2166 $l = pack "A66 A*", $l, "<==";
2170 unshift @lines, "\n";
2171 $self->mydie(join "", @lines);
2175 my($self, $sleep) = @_;
2180 return if -t STDOUT;
2181 my $odef = select STDERR;
2188 #-> sub CPAN::Shell::rematein ;
2189 # RE-adme||MA-ke||TE-st||IN-stall
2192 my($meth,@some) = @_;
2194 while($meth =~ /^(force|notest)$/) {
2195 push @pragma, $meth;
2196 $meth = shift @some or
2197 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
2201 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
2203 # Here is the place to set "test_count" on all involved parties to
2204 # 0. We then can pass this counter on to the involved
2205 # distributions and those can refuse to test if test_count > X. In
2206 # the first stab at it we could use a 1 for "X".
2208 # But when do I reset the distributions to start with 0 again?
2209 # Jost suggested to have a random or cycling interaction ID that
2210 # we pass through. But the ID is something that is just left lying
2211 # around in addition to the counter, so I'd prefer to set the
2212 # counter to 0 now, and repeat at the end of the loop. But what
2213 # about dependencies? They appear later and are not reset, they
2214 # enter the queue but not its copy. How do they get a sensible
2217 # construct the queue
2219 STHING: foreach $s (@some) {
2222 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
2224 } elsif ($s =~ m|^/|) { # looks like a regexp
2225 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
2229 } elsif ($meth eq "ls") {
2230 $self->globls($s,\@pragma);
2233 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
2234 $obj = CPAN::Shell->expandany($s);
2237 $obj->color_cmd_tmps(0,1);
2238 CPAN::Queue->new($obj->id);
2240 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
2241 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
2242 if ($meth =~ /^(dump|ls)$/) {
2245 $CPAN::Frontend->myprint(
2247 "Don't be silly, you can't $meth ",
2255 ->myprint(qq{Warning: Cannot $meth $s, }.
2256 qq{don\'t know what it is.
2261 to find objects with matching identifiers.
2267 # queuerunner (please be warned: when I started to change the
2268 # queue to hold objects instead of names, I made one or two
2269 # mistakes and never found which. I reverted back instead)
2270 while ($s = CPAN::Queue->first) {
2273 $obj = $s; # I do not believe, we would survive if this happened
2275 $obj = CPAN::Shell->expandany($s);
2277 for my $pragma (@pragma) {
2280 ($] < 5.00303 || $obj->can($pragma))){
2281 ### compatibility with 5.003
2282 $obj->$pragma($meth); # the pragma "force" in
2283 # "CPAN::Distribution" must know
2284 # what we are intending
2287 if ($]>=5.00303 && $obj->can('called_for')) {
2288 $obj->called_for($s);
2291 qq{pragma[@pragma]meth[$meth]obj[$obj]as_string[$obj->{ID}]}
2295 CPAN::Queue->delete($s);
2297 CPAN->debug("failed");
2301 CPAN::Queue->delete_first($s);
2303 for my $obj (@qcopy) {
2304 $obj->color_cmd_tmps(0,0);
2305 delete $obj->{incommandcolor};
2309 #-> sub CPAN::Shell::recent ;
2313 CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
2318 # set up the dispatching methods
2320 for my $command (qw(
2335 *$command = sub { shift->rematein($command, @_); };
2339 package CPAN::LWP::UserAgent;
2343 return if $SETUPDONE;
2344 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2345 require LWP::UserAgent;
2346 @ISA = qw(Exporter LWP::UserAgent);
2349 $CPAN::Frontend->mywarn("LWP::UserAgent not available\n");
2353 sub get_basic_credentials {
2354 my($self, $realm, $uri, $proxy) = @_;
2355 return unless $proxy;
2356 if ($USER && $PASSWD) {
2357 } elsif (defined $CPAN::Config->{proxy_user} &&
2358 defined $CPAN::Config->{proxy_pass}) {
2359 $USER = $CPAN::Config->{proxy_user};
2360 $PASSWD = $CPAN::Config->{proxy_pass};
2362 ExtUtils::MakeMaker->import(qw(prompt));
2363 $USER = prompt("Proxy authentication needed!
2364 (Note: to permanently configure username and password run
2365 o conf proxy_user your_username
2366 o conf proxy_pass your_password
2368 if ($CPAN::META->has_inst("Term::ReadKey")) {
2369 Term::ReadKey::ReadMode("noecho");
2371 $CPAN::Frontend->mywarn("Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n");
2373 $PASSWD = prompt("Password:");
2374 if ($CPAN::META->has_inst("Term::ReadKey")) {
2375 Term::ReadKey::ReadMode("restore");
2377 $CPAN::Frontend->myprint("\n\n");
2379 return($USER,$PASSWD);
2382 # mirror(): Its purpose is to deal with proxy authentication. When we
2383 # call SUPER::mirror, we relly call the mirror method in
2384 # LWP::UserAgent. LWP::UserAgent will then call
2385 # $self->get_basic_credentials or some equivalent and this will be
2386 # $self->dispatched to our own get_basic_credentials method.
2388 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2390 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2391 # although we have gone through our get_basic_credentials, the proxy
2392 # server refuses to connect. This could be a case where the username or
2393 # password has changed in the meantime, so I'm trying once again without
2394 # $USER and $PASSWD to give the get_basic_credentials routine another
2395 # chance to set $USER and $PASSWD.
2397 # mirror(): Its purpose is to deal with proxy authentication. When we
2398 # call SUPER::mirror, we relly call the mirror method in
2399 # LWP::UserAgent. LWP::UserAgent will then call
2400 # $self->get_basic_credentials or some equivalent and this will be
2401 # $self->dispatched to our own get_basic_credentials method.
2403 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2405 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2406 # although we have gone through our get_basic_credentials, the proxy
2407 # server refuses to connect. This could be a case where the username or
2408 # password has changed in the meantime, so I'm trying once again without
2409 # $USER and $PASSWD to give the get_basic_credentials routine another
2410 # chance to set $USER and $PASSWD.
2413 my($self,$url,$aslocal) = @_;
2414 my $result = $self->SUPER::mirror($url,$aslocal);
2415 if ($result->code == 407) {
2418 $result = $self->SUPER::mirror($url,$aslocal);
2426 #-> sub CPAN::FTP::ftp_get ;
2428 my($class,$host,$dir,$file,$target) = @_;
2430 qq[Going to fetch file [$file] from dir [$dir]
2431 on host [$host] as local [$target]\n]
2433 my $ftp = Net::FTP->new($host);
2435 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
2438 return 0 unless defined $ftp;
2439 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
2440 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
2441 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
2442 my $msg = $ftp->message;
2443 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
2446 unless ( $ftp->cwd($dir) ){
2447 my $msg = $ftp->message;
2448 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
2452 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
2453 unless ( $ftp->get($file,$target) ){
2454 my $msg = $ftp->message;
2455 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
2458 $ftp->quit; # it's ok if this fails
2462 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
2464 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
2465 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
2467 # > *** 1562,1567 ****
2468 # > --- 1562,1580 ----
2469 # > return 1 if substr($url,0,4) eq "file";
2470 # > return 1 unless $url =~ m|://([^/]+)|;
2472 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
2474 # > + $proxy =~ m|://([^/:]+)|;
2476 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
2477 # > + if ($noproxy) {
2478 # > + if ($host !~ /$noproxy$/) {
2479 # > + $host = $proxy;
2482 # > + $host = $proxy;
2485 # > require Net::Ping;
2486 # > return 1 unless $Net::Ping::VERSION >= 2;
2490 #-> sub CPAN::FTP::localize ;
2492 my($self,$file,$aslocal,$force) = @_;
2494 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
2495 unless defined $aslocal;
2496 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
2499 if ($^O eq 'MacOS') {
2500 # Comment by AK on 2000-09-03: Uniq short filenames would be
2501 # available in CHECKSUMS file
2502 my($name, $path) = File::Basename::fileparse($aslocal, '');
2503 if (length($name) > 31) {
2514 my $size = 31 - length($suf);
2515 while (length($name) > $size) {
2519 $aslocal = File::Spec->catfile($path, $name);
2523 if (-f $aslocal && -r _ && !($force & 1)){
2525 if ($size = -s $aslocal) {
2526 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
2529 # empty file from a previous unsuccessful attempt to download it
2531 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I could not remove.");
2536 rename $aslocal, "$aslocal.bak";
2540 my($aslocal_dir) = File::Basename::dirname($aslocal);
2541 File::Path::mkpath($aslocal_dir);
2542 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
2543 qq{directory "$aslocal_dir".
2544 I\'ll continue, but if you encounter problems, they may be due
2545 to insufficient permissions.\n}) unless -w $aslocal_dir;
2547 # Inheritance is not easier to manage than a few if/else branches
2548 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2550 CPAN::LWP::UserAgent->config;
2551 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
2553 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
2557 $Ua->proxy('ftp', $var)
2558 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
2559 $Ua->proxy('http', $var)
2560 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
2563 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
2565 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
2566 # > use ones that require basic autorization.
2568 # > Example of when I use it manually in my own stuff:
2570 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
2571 # > $req->proxy_authorization_basic("username","password");
2572 # > $res = $ua->request($req);
2576 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
2580 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
2581 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
2584 # Try the list of urls for each single object. We keep a record
2585 # where we did get a file from
2586 my(@reordered,$last);
2587 $CPAN::Config->{urllist} ||= [];
2588 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
2589 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
2590 $CPAN::Config->{urllist} = [];
2592 $last = $#{$CPAN::Config->{urllist}};
2593 if ($force & 2) { # local cpans probably out of date, don't reorder
2594 @reordered = (0..$last);
2598 (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
2600 (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
2602 defined($ThesiteURL)
2604 ($CPAN::Config->{urllist}[$b] eq $ThesiteURL)
2606 ($CPAN::Config->{urllist}[$a] eq $ThesiteURL)
2611 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
2613 @levels = qw/easy hard hardest/;
2615 @levels = qw/easy/ if $^O eq 'MacOS';
2617 local $ENV{FTP_PASSIVE} =
2618 exists $CPAN::Config->{ftp_passive} ?
2619 $CPAN::Config->{ftp_passive} : 1;
2620 for $levelno (0..$#levels) {
2621 my $level = $levels[$levelno];
2622 my $method = "host$level";
2623 my @host_seq = $level eq "easy" ?
2624 @reordered : 0..$last; # reordered has CDROM up front
2625 my @urllist = map { $CPAN::Config->{urllist}[$_] } @host_seq;
2626 for my $u (@urllist) {
2627 $u .= "/" unless substr($u,-1) eq "/";
2629 for my $u (@CPAN::Defaultsites) {
2630 push @urllist, $u unless grep { $_ eq $u } @urllist;
2632 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
2633 my $ret = $self->$method(\@urllist,$file,$aslocal);
2635 $Themethod = $level;
2637 # utime $now, $now, $aslocal; # too bad, if we do that, we
2638 # might alter a local mirror
2639 $self->debug("level[$level]") if $CPAN::DEBUG;
2643 last if $CPAN::Signal; # need to cleanup
2646 unless ($CPAN::Signal) {
2649 qq{Please check, if the URLs I found in your configuration file \(}.
2650 join(", ", @{$CPAN::Config->{urllist}}).
2651 qq{\) are valid. The urllist can be edited.},
2652 qq{E.g. with 'o conf urllist push ftp://myurl/'};
2653 $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
2655 $CPAN::Frontend->myprint("Could not fetch $file\n");
2658 rename "$aslocal.bak", $aslocal;
2659 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
2660 $self->ls($aslocal));
2666 # package CPAN::FTP;
2668 my($self,$host_seq,$file,$aslocal) = @_;
2670 HOSTEASY: for $ro_url (@$host_seq) {
2671 my $url .= "$ro_url$file";
2672 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
2673 if ($url =~ /^file:/) {
2675 if ($CPAN::META->has_inst('URI::URL')) {
2676 my $u = URI::URL->new($url);
2678 } else { # works only on Unix, is poorly constructed, but
2679 # hopefully better than nothing.
2680 # RFC 1738 says fileurl BNF is
2681 # fileurl = "file://" [ host | "localhost" ] "/" fpath
2682 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
2684 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
2685 $l =~ s|^file:||; # assume they
2689 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
2691 $self->debug("local file[$l]") if $CPAN::DEBUG;
2692 if ( -f $l && -r _) {
2693 $ThesiteURL = $ro_url;
2696 if ($l =~ /(.+)\.gz$/) {
2698 if ( -f $ungz && -r _) {
2699 $ThesiteURL = $ro_url;
2703 # Maybe mirror has compressed it?
2705 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
2706 CPAN::Tarzip->new("$l.gz")->gunzip($aslocal);
2708 $ThesiteURL = $ro_url;
2713 if ($CPAN::META->has_usable('LWP')) {
2714 $CPAN::Frontend->myprint("Fetching with LWP:
2718 CPAN::LWP::UserAgent->config;
2719 eval { $Ua = CPAN::LWP::UserAgent->new; };
2721 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
2724 my $res = $Ua->mirror($url, $aslocal);
2725 if ($res->is_success) {
2726 $ThesiteURL = $ro_url;
2728 utime $now, $now, $aslocal; # download time is more
2729 # important than upload time
2731 } elsif ($url !~ /\.gz(?!\n)\Z/) {
2732 my $gzurl = "$url.gz";
2733 $CPAN::Frontend->myprint("Fetching with LWP:
2736 $res = $Ua->mirror($gzurl, "$aslocal.gz");
2737 if ($res->is_success &&
2738 CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)
2740 $ThesiteURL = $ro_url;
2744 $CPAN::Frontend->myprint(sprintf(
2745 "LWP failed with code[%s] message[%s]\n",
2749 # Alan Burlison informed me that in firewall environments
2750 # Net::FTP can still succeed where LWP fails. So we do not
2751 # skip Net::FTP anymore when LWP is available.
2754 $CPAN::Frontend->myprint("LWP not available\n");
2756 return if $CPAN::Signal;
2757 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2758 # that's the nice and easy way thanks to Graham
2759 my($host,$dir,$getfile) = ($1,$2,$3);
2760 if ($CPAN::META->has_usable('Net::FTP')) {
2762 $CPAN::Frontend->myprint("Fetching with Net::FTP:
2765 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
2766 "aslocal[$aslocal]") if $CPAN::DEBUG;
2767 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
2768 $ThesiteURL = $ro_url;
2771 if ($aslocal !~ /\.gz(?!\n)\Z/) {
2772 my $gz = "$aslocal.gz";
2773 $CPAN::Frontend->myprint("Fetching with Net::FTP
2776 if (CPAN::FTP->ftp_get($host,
2780 CPAN::Tarzip->new($gz)->gunzip($aslocal)
2782 $ThesiteURL = $ro_url;
2789 return if $CPAN::Signal;
2793 # package CPAN::FTP;
2795 my($self,$host_seq,$file,$aslocal) = @_;
2797 # Came back if Net::FTP couldn't establish connection (or
2798 # failed otherwise) Maybe they are behind a firewall, but they
2799 # gave us a socksified (or other) ftp program...
2802 my($devnull) = $CPAN::Config->{devnull} || "";
2804 my($aslocal_dir) = File::Basename::dirname($aslocal);
2805 File::Path::mkpath($aslocal_dir);
2806 HOSTHARD: for $ro_url (@$host_seq) {
2807 my $url = "$ro_url$file";
2808 my($proto,$host,$dir,$getfile);
2810 # Courtesy Mark Conty mark_conty@cargill.com change from
2811 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2813 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
2814 # proto not yet used
2815 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
2817 next HOSTHARD; # who said, we could ftp anything except ftp?
2819 next HOSTHARD if $proto eq "file"; # file URLs would have had
2820 # success above. Likely a bogus URL
2822 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
2824 # Try the most capable first and leave ncftp* for last as it only
2826 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
2827 my $funkyftp = $CPAN::Config->{$f};
2828 next unless defined $funkyftp;
2829 next if $funkyftp =~ /^\s*$/;
2831 my($asl_ungz, $asl_gz);
2832 ($asl_ungz = $aslocal) =~ s/\.gz//;
2833 $asl_gz = "$asl_ungz.gz";
2835 my($src_switch) = "";
2837 my($stdout_redir) = " > $asl_ungz";
2839 $src_switch = " -source";
2840 } elsif ($f eq "ncftp"){
2841 $src_switch = " -c";
2842 } elsif ($f eq "wget"){
2843 $src_switch = " -O $asl_ungz";
2845 } elsif ($f eq 'curl'){
2846 $src_switch = ' -L -f -s -S --netrc-optional';
2849 if ($f eq "ncftpget"){
2850 $chdir = "cd $aslocal_dir && ";
2853 $CPAN::Frontend->myprint(
2855 Trying with "$funkyftp$src_switch" to get
2859 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
2860 $self->debug("system[$system]") if $CPAN::DEBUG;
2861 my($wstatus) = system($system);
2863 # lynx returns 0 when it fails somewhere
2865 my $content = do { local *FH; open FH, $asl_ungz or die; local $/; <FH> };
2866 if ($content =~ /^<.*<title>[45]/si) {
2867 $CPAN::Frontend->myprint(qq{
2868 No success, the file that lynx has has downloaded looks like an error message:
2871 $CPAN::Frontend->mysleep(1);
2875 $CPAN::Frontend->myprint(qq{
2876 No success, the file that lynx has has downloaded is an empty file.
2881 if ($wstatus == 0) {
2884 } elsif ($asl_ungz ne $aslocal) {
2885 # test gzip integrity
2886 if (CPAN::Tarzip->new($asl_ungz)->gtest) {
2887 # e.g. foo.tar is gzipped --> foo.tar.gz
2888 rename $asl_ungz, $aslocal;
2890 CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz);
2893 $ThesiteURL = $ro_url;
2895 } elsif ($url !~ /\.gz(?!\n)\Z/) {
2897 -f $asl_ungz && -s _ == 0;
2898 my $gz = "$aslocal.gz";
2899 my $gzurl = "$url.gz";
2900 $CPAN::Frontend->myprint(
2902 Trying with "$funkyftp$src_switch" to get
2905 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
2906 $self->debug("system[$system]") if $CPAN::DEBUG;
2908 if (($wstatus = system($system)) == 0
2912 # test gzip integrity
2913 my $ct = CPAN::Tarzip->new($asl_gz);
2915 $ct->gunzip($aslocal);
2917 # somebody uncompressed file for us?
2918 rename $asl_ungz, $aslocal;
2920 $ThesiteURL = $ro_url;
2923 unlink $asl_gz if -f $asl_gz;
2926 my $estatus = $wstatus >> 8;
2927 my $size = -f $aslocal ?
2928 ", left\n$aslocal with size ".-s _ :
2929 "\nWarning: expected file [$aslocal] doesn't exist";
2930 $CPAN::Frontend->myprint(qq{
2931 System call "$system"
2932 returned status $estatus (wstat $wstatus)$size
2935 return if $CPAN::Signal;
2936 } # transfer programs
2940 # package CPAN::FTP;
2942 my($self,$host_seq,$file,$aslocal) = @_;
2945 my($aslocal_dir) = File::Basename::dirname($aslocal);
2946 File::Path::mkpath($aslocal_dir);
2947 my $ftpbin = $CPAN::Config->{ftp};
2948 unless (length $ftpbin && MM->maybe_command($ftpbin)) {
2949 $CPAN::Frontend->myprint("No external ftp command available\n\n");
2952 $CPAN::Frontend->myprint(qq{
2953 As a last ressort we now switch to the external ftp command '$ftpbin'
2956 Doing so often leads to problems that are hard to diagnose, even endless
2957 loops may be encountered.
2959 If you're victim of such problems, please consider unsetting the ftp
2960 config variable with
2966 $CPAN::Frontend->mysleep(4);
2967 HOSTHARDEST: for $ro_url (@$host_seq) {
2968 my $url = "$ro_url$file";
2969 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
2970 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2973 my($host,$dir,$getfile) = ($1,$2,$3);
2975 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
2976 $ctime,$blksize,$blocks) = stat($aslocal);
2977 $timestamp = $mtime ||= 0;
2978 my($netrc) = CPAN::FTP::netrc->new;
2979 my($netrcfile) = $netrc->netrc;
2980 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
2981 my $targetfile = File::Basename::basename($aslocal);
2987 map("cd $_", split /\//, $dir), # RFC 1738
2989 "get $getfile $targetfile",
2993 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
2994 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
2995 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
2997 $netrc->contains($host))) if $CPAN::DEBUG;
2998 if ($netrc->protected) {
2999 my $dialog = join "", map { " $_\n" } @dialog;
3001 if ($netrc->contains($host)) {
3002 $netrc_explain = "Relying that your .netrc entry for '$host' ".
3003 "manages the login";
3005 $netrc_explain = "Relying that your default .netrc entry ".
3006 "manages the login";
3008 $CPAN::Frontend->myprint(qq{
3009 Trying with external ftp to get
3012 Going to send the dialog
3016 $self->talk_ftp("$ftpbin$verbose $host",
3018 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3019 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3021 if ($mtime > $timestamp) {
3022 $CPAN::Frontend->myprint("GOT $aslocal\n");
3023 $ThesiteURL = $ro_url;
3026 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
3028 return if $CPAN::Signal;
3030 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
3031 qq{correctly protected.\n});
3034 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
3035 nor does it have a default entry\n");
3038 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
3039 # then and login manually to host, using e-mail as
3041 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
3045 "user anonymous $Config::Config{'cf_email'}"
3047 my $dialog = join "", map { " $_\n" } @dialog;
3048 $CPAN::Frontend->myprint(qq{
3049 Trying with external ftp to get
3051 Going to send the dialog
3055 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
3056 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3057 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3059 if ($mtime > $timestamp) {
3060 $CPAN::Frontend->myprint("GOT $aslocal\n");
3061 $ThesiteURL = $ro_url;
3064 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
3066 return if $CPAN::Signal;
3067 $CPAN::Frontend->myprint("Can't access URL $url.\n\n");
3072 # package CPAN::FTP;
3074 my($self,$command,@dialog) = @_;
3075 my $fh = FileHandle->new;
3076 $fh->open("|$command") or die "Couldn't open ftp: $!";
3077 foreach (@dialog) { $fh->print("$_\n") }
3078 $fh->close; # Wait for process to complete
3080 my $estatus = $wstatus >> 8;
3081 $CPAN::Frontend->myprint(qq{
3082 Subprocess "|$command"
3083 returned status $estatus (wstat $wstatus)
3087 # find2perl needs modularization, too, all the following is stolen
3091 my($self,$name) = @_;
3092 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
3093 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
3095 my($perms,%user,%group);
3099 $blocks = int(($blocks + 1) / 2);
3102 $blocks = int(($sizemm + 1023) / 1024);
3105 if (-f _) { $perms = '-'; }
3106 elsif (-d _) { $perms = 'd'; }
3107 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
3108 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
3109 elsif (-p _) { $perms = 'p'; }
3110 elsif (-S _) { $perms = 's'; }
3111 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
3113 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
3114 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
3115 my $tmpmode = $mode;
3116 my $tmp = $rwx[$tmpmode & 7];
3118 $tmp = $rwx[$tmpmode & 7] . $tmp;
3120 $tmp = $rwx[$tmpmode & 7] . $tmp;
3121 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
3122 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
3123 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
3126 my $user = $user{$uid} || $uid; # too lazy to implement lookup
3127 my $group = $group{$gid} || $gid;
3129 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
3131 my($moname) = $moname[$mon];
3132 if (-M _ > 365.25 / 2) {
3133 $timeyear = $year + 1900;
3136 $timeyear = sprintf("%02d:%02d", $hour, $min);
3139 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
3153 package CPAN::FTP::netrc;
3156 # package CPAN::FTP::netrc;
3159 my $home = CPAN::HandleConfig::home;
3160 my $file = File::Spec->catfile($home,".netrc");
3162 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3163 $atime,$mtime,$ctime,$blksize,$blocks)
3168 my($fh,@machines,$hasdefault);
3170 $fh = FileHandle->new or die "Could not create a filehandle";
3172 if($fh->open($file)){
3173 $protected = ($mode & 077) == 0;
3175 NETRC: while (<$fh>) {
3176 my(@tokens) = split " ", $_;
3177 TOKEN: while (@tokens) {
3178 my($t) = shift @tokens;
3179 if ($t eq "default"){
3183 last TOKEN if $t eq "macdef";
3184 if ($t eq "machine") {
3185 push @machines, shift @tokens;
3190 $file = $hasdefault = $protected = "";
3194 'mach' => [@machines],
3196 'hasdefault' => $hasdefault,
3197 'protected' => $protected,
3201 # CPAN::FTP::netrc::hasdefault;
3202 sub hasdefault { shift->{'hasdefault'} }
3203 sub netrc { shift->{'netrc'} }
3204 sub protected { shift->{'protected'} }
3206 my($self,$mach) = @_;
3207 for ( @{$self->{'mach'}} ) {
3208 return 1 if $_ eq $mach;
3213 package CPAN::Complete;
3217 my($text, $line, $start, $end) = @_;
3218 my(@perlret) = cpl($text, $line, $start);
3219 # find longest common match. Can anybody show me how to peruse
3220 # T::R::Gnu to have this done automatically? Seems expensive.
3221 return () unless @perlret;
3222 my($newtext) = $text;
3223 for (my $i = length($text)+1;;$i++) {
3224 last unless length($perlret[0]) && length($perlret[0]) >= $i;
3225 my $try = substr($perlret[0],0,$i);
3226 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
3227 # warn "try[$try]tries[@tries]";
3228 if (@tries == @perlret) {
3234 ($newtext,@perlret);
3237 #-> sub CPAN::Complete::cpl ;
3239 my($word,$line,$pos) = @_;
3243 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3245 if ($line =~ s/^(force\s*)//) {
3250 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
3251 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
3253 } elsif ($line =~ /^(a|ls)\s/) {
3254 @return = cplx('CPAN::Author',uc($word));
3255 } elsif ($line =~ /^b\s/) {
3256 CPAN::Shell->local_bundles;
3257 @return = cplx('CPAN::Bundle',$word);
3258 } elsif ($line =~ /^d\s/) {
3259 @return = cplx('CPAN::Distribution',$word);
3260 } elsif ($line =~ m/^(
3261 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
3263 if ($word =~ /^Bundle::/) {
3264 CPAN::Shell->local_bundles;
3266 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3267 } elsif ($line =~ /^i\s/) {
3268 @return = cpl_any($word);
3269 } elsif ($line =~ /^reload\s/) {
3270 @return = cpl_reload($word,$line,$pos);
3271 } elsif ($line =~ /^o\s/) {
3272 @return = cpl_option($word,$line,$pos);
3273 } elsif ($line =~ m/^\S+\s/ ) {
3274 # fallback for future commands and what we have forgotten above
3275 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3282 #-> sub CPAN::Complete::cplx ;
3284 my($class, $word) = @_;
3285 # I believed for many years that this was sorted, today I
3286 # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
3287 # make it sorted again. Maybe sort was dropped when GNU-readline
3288 # support came in? The RCS file is difficult to read on that:-(
3289 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
3292 #-> sub CPAN::Complete::cpl_any ;
3296 cplx('CPAN::Author',$word),
3297 cplx('CPAN::Bundle',$word),
3298 cplx('CPAN::Distribution',$word),
3299 cplx('CPAN::Module',$word),
3303 #-> sub CPAN::Complete::cpl_reload ;
3305 my($word,$line,$pos) = @_;
3307 my(@words) = split " ", $line;
3308 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3309 my(@ok) = qw(cpan index);
3310 return @ok if @words == 1;
3311 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
3314 #-> sub CPAN::Complete::cpl_option ;
3316 my($word,$line,$pos) = @_;
3318 my(@words) = split " ", $line;
3319 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3320 my(@ok) = qw(conf debug);
3321 return @ok if @words == 1;
3322 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
3324 } elsif ($words[1] eq 'index') {
3326 } elsif ($words[1] eq 'conf') {
3327 return CPAN::HandleConfig::cpl(@_);
3328 } elsif ($words[1] eq 'debug') {
3329 return sort grep /^\Q$word\E/i,
3330 sort keys %CPAN::DEBUG, 'all';
3334 package CPAN::Index;
3337 #-> sub CPAN::Index::force_reload ;
3340 $CPAN::Index::LAST_TIME = 0;
3344 #-> sub CPAN::Index::reload ;
3346 my($cl,$force) = @_;
3349 # XXX check if a newer one is available. (We currently read it
3350 # from time to time)
3351 for ($CPAN::Config->{index_expire}) {
3352 $_ = 0.001 unless $_ && $_ > 0.001;
3354 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
3355 # debug here when CPAN doesn't seem to read the Metadata
3357 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
3359 unless ($CPAN::META->{PROTOCOL}) {
3360 $cl->read_metadata_cache;
3361 $CPAN::META->{PROTOCOL} ||= "1.0";
3363 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
3364 # warn "Setting last_time to 0";
3365 $LAST_TIME = 0; # No warning necessary
3367 return if $LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
3370 # IFF we are developing, it helps to wipe out the memory
3371 # between reloads, otherwise it is not what a user expects.
3372 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
3373 $CPAN::META = CPAN->new;
3377 local $LAST_TIME = $time;
3378 local $CPAN::META->{PROTOCOL} = PROTOCOL;
3380 my $needshort = $^O eq "dos";
3382 $cl->rd_authindex($cl
3384 "authors/01mailrc.txt.gz",
3386 File::Spec->catfile('authors', '01mailrc.gz') :
3387 File::Spec->catfile('authors', '01mailrc.txt.gz'),
3390 $debug = "timing reading 01[".($t2 - $time)."]";
3392 return if $CPAN::Signal; # this is sometimes lengthy
3393 $cl->rd_modpacks($cl
3395 "modules/02packages.details.txt.gz",
3397 File::Spec->catfile('modules', '02packag.gz') :
3398 File::Spec->catfile('modules', '02packages.details.txt.gz'),
3401 $debug .= "02[".($t2 - $time)."]";
3403 return if $CPAN::Signal; # this is sometimes lengthy
3406 "modules/03modlist.data.gz",
3408 File::Spec->catfile('modules', '03mlist.gz') :
3409 File::Spec->catfile('modules', '03modlist.data.gz'),
3411 $cl->write_metadata_cache;
3413 $debug .= "03[".($t2 - $time)."]";
3415 CPAN->debug($debug) if $CPAN::DEBUG;
3418 $CPAN::META->{PROTOCOL} = PROTOCOL;
3421 #-> sub CPAN::Index::reload_x ;
3423 my($cl,$wanted,$localname,$force) = @_;
3424 $force |= 2; # means we're dealing with an index here
3425 CPAN::HandleConfig->load; # we should guarantee loading wherever we rely
3427 $localname ||= $wanted;
3428 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
3432 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
3435 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
3436 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
3437 qq{day$s. I\'ll use that.});
3440 $force |= 1; # means we're quite serious about it.
3442 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
3445 #-> sub CPAN::Index::rd_authindex ;
3447 my($cl, $index_target) = @_;
3449 return unless defined $index_target;
3450 $CPAN::Frontend->myprint("Going to read $index_target\n");
3452 tie *FH, 'CPAN::Tarzip', $index_target;
3455 push @lines, split /\012/ while <FH>;
3457 my($userid,$fullname,$email) =
3458 m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
3459 next unless $userid && $fullname && $email;
3461 # instantiate an author object
3462 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
3463 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
3464 return if $CPAN::Signal;
3469 my($self,$dist) = @_;
3470 $dist = $self->{'id'} unless defined $dist;
3471 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
3475 #-> sub CPAN::Index::rd_modpacks ;
3477 my($self, $index_target) = @_;
3479 return unless defined $index_target;
3480 $CPAN::Frontend->myprint("Going to read $index_target\n");
3481 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3484 while ($_ = $fh->READLINE) {
3486 my @ls = map {"$_\n"} split /\n/, $_;
3487 unshift @ls, "\n" x length($1) if /^(\n+)/;
3491 my($line_count,$last_updated);
3493 my $shift = shift(@lines);
3494 last if $shift =~ /^\s*$/;
3495 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
3496 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
3498 if (not defined $line_count) {
3500 warn qq{Warning: Your $index_target does not contain a Line-Count header.
3501 Please check the validity of the index file by comparing it to more
3502 than one CPAN mirror. I'll continue but problems seem likely to
3507 } elsif ($line_count != scalar @lines) {
3509 warn sprintf qq{Warning: Your %s
3510 contains a Line-Count header of %d but I see %d lines there. Please
3511 check the validity of the index file by comparing it to more than one
3512 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
3513 $index_target, $line_count, scalar(@lines);
3516 if (not defined $last_updated) {
3518 warn qq{Warning: Your $index_target does not contain a Last-Updated header.
3519 Please check the validity of the index file by comparing it to more
3520 than one CPAN mirror. I'll continue but problems seem likely to
3528 ->myprint(sprintf qq{ Database was generated on %s\n},
3530 $DATE_OF_02 = $last_updated;
3533 if ($CPAN::META->has_inst('HTTP::Date')) {
3535 $age -= HTTP::Date::str2time($last_updated);
3537 $CPAN::Frontend->myprint(" HTTP::Date not available\n");
3538 require Time::Local;
3539 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
3540 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
3541 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
3548 qq{Warning: This index file is %d days old.
3549 Please check the host you chose as your CPAN mirror for staleness.
3550 I'll continue but problems seem likely to happen.\a\n},
3553 } elsif ($age < -1) {
3557 qq{Warning: Your system date is %d days behind this index file!
3559 Timestamp index file: %s
3560 Please fix your system time, problems with the make command expected.\n},
3570 # A necessity since we have metadata_cache: delete what isn't
3572 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
3573 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
3577 # before 1.56 we split into 3 and discarded the rest. From
3578 # 1.57 we assign remaining text to $comment thus allowing to
3579 # influence isa_perl
3580 my($mod,$version,$dist,$comment) = split " ", $_, 4;
3581 my($bundle,$id,$userid);
3583 if ($mod eq 'CPAN' &&
3585 CPAN::Queue->exists('Bundle::CPAN') ||
3586 CPAN::Queue->exists('CPAN')
3590 if ($version > $CPAN::VERSION){
3591 $CPAN::Frontend->myprint(qq{
3592 There's a new CPAN.pm version (v$version) available!
3593 [Current version is v$CPAN::VERSION]
3594 You might want to try
3597 without quitting the current session. It should be a seamless upgrade
3598 while we are running...
3601 $CPAN::Frontend->myprint(qq{\n});
3603 last if $CPAN::Signal;
3604 } elsif ($mod =~ /^Bundle::(.*)/) {
3609 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
3610 # Let's make it a module too, because bundles have so much
3611 # in common with modules.
3613 # Changed in 1.57_63: seems like memory bloat now without
3614 # any value, so commented out
3616 # $CPAN::META->instance('CPAN::Module',$mod);
3620 # instantiate a module object
3621 $id = $CPAN::META->instance('CPAN::Module',$mod);
3625 # Although CPAN prohibits same name with different version the
3626 # indexer may have changed the version for the same distro
3627 # since the last time ("Force Reindexing" feature)
3628 if ($id->cpan_file ne $dist
3630 $id->cpan_version ne $version
3632 $userid = $id->userid || $self->userid($dist);
3634 'CPAN_USERID' => $userid,
3635 'CPAN_VERSION' => $version,
3636 'CPAN_FILE' => $dist,
3640 # instantiate a distribution object
3641 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
3642 # we do not need CONTAINSMODS unless we do something with
3643 # this dist, so we better produce it on demand.
3645 ## my $obj = $CPAN::META->instance(
3646 ## 'CPAN::Distribution' => $dist
3648 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
3650 $CPAN::META->instance(
3651 'CPAN::Distribution' => $dist
3653 'CPAN_USERID' => $userid,
3654 'CPAN_COMMENT' => $comment,
3658 for my $name ($mod,$dist) {
3659 CPAN->debug("exists name[$name]") if $CPAN::DEBUG;
3660 $exists{$name} = undef;
3663 return if $CPAN::Signal;
3667 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
3668 for my $o ($CPAN::META->all_objects($class)) {
3669 next if exists $exists{$o->{ID}};
3670 $CPAN::META->delete($class,$o->{ID});
3671 CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
3678 #-> sub CPAN::Index::rd_modlist ;
3680 my($cl,$index_target) = @_;
3681 return unless defined $index_target;
3682 $CPAN::Frontend->myprint("Going to read $index_target\n");
3683 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3687 while ($_ = $fh->READLINE) {
3689 my @ls = map {"$_\n"} split /\n/, $_;
3690 unshift @ls, "\n" x length($1) if /^(\n+)/;
3694 my $shift = shift(@eval);
3695 if ($shift =~ /^Date:\s+(.*)/){
3696 return if $DATE_OF_03 eq $1;
3699 last if $shift =~ /^\s*$/;
3702 push @eval, q{CPAN::Modulelist->data;};
3704 my($comp) = Safe->new("CPAN::Safe1");
3705 my($eval) = join("", @eval);
3706 my $ret = $comp->reval($eval);
3707 Carp::confess($@) if $@;
3708 return if $CPAN::Signal;
3710 my $obj = $CPAN::META->instance("CPAN::Module",$_);
3711 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
3712 $obj->set(%{$ret->{$_}});
3713 return if $CPAN::Signal;
3717 #-> sub CPAN::Index::write_metadata_cache ;
3718 sub write_metadata_cache {
3720 return unless $CPAN::Config->{'cache_metadata'};
3721 return unless $CPAN::META->has_usable("Storable");
3723 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
3724 CPAN::Distribution)) {
3725 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
3727 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
3728 $cache->{last_time} = $LAST_TIME;
3729 $cache->{DATE_OF_02} = $DATE_OF_02;
3730 $cache->{PROTOCOL} = PROTOCOL;
3731 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
3732 eval { Storable::nstore($cache, $metadata_file) };
3733 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
3736 #-> sub CPAN::Index::read_metadata_cache ;
3737 sub read_metadata_cache {
3739 return unless $CPAN::Config->{'cache_metadata'};
3740 return unless $CPAN::META->has_usable("Storable");
3741 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
3742 return unless -r $metadata_file and -f $metadata_file;
3743 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
3745 eval { $cache = Storable::retrieve($metadata_file) };
3746 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
3747 if (!$cache || ref $cache ne 'HASH'){
3751 if (exists $cache->{PROTOCOL}) {
3752 if (PROTOCOL > $cache->{PROTOCOL}) {
3753 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
3754 "with protocol v%s, requiring v%s\n",
3761 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
3762 "with protocol v1.0\n");
3767 while(my($class,$v) = each %$cache) {
3768 next unless $class =~ /^CPAN::/;
3769 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
3770 while (my($id,$ro) = each %$v) {
3771 $CPAN::META->{readwrite}{$class}{$id} ||=
3772 $class->new(ID=>$id, RO=>$ro);
3777 unless ($clcnt) { # sanity check
3778 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
3781 if ($idcnt < 1000) {
3782 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
3783 "in $metadata_file\n");
3786 $CPAN::META->{PROTOCOL} ||=
3787 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
3788 # does initialize to some protocol
3789 $LAST_TIME = $cache->{last_time};
3790 $DATE_OF_02 = $cache->{DATE_OF_02};
3791 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
3792 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
3796 package CPAN::InfoObj;
3801 exists $self->{RO} and return $self->{RO};
3806 my $ro = $self->ro or return;
3807 return $ro->{CPAN_USERID};
3810 sub id { shift->{ID}; }
3812 #-> sub CPAN::InfoObj::new ;
3814 my $this = bless {}, shift;
3819 # The set method may only be used by code that reads index data or
3820 # otherwise "objective" data from the outside world. All session
3821 # related material may do anything else with instance variables but
3822 # must not touch the hash under the RO attribute. The reason is that
3823 # the RO hash gets written to Metadata file and is thus persistent.
3825 #-> sub CPAN::InfoObj::safe_chdir ;
3827 my($self,$todir) = @_;
3828 # we die if we cannot chdir and we are debuggable
3829 Carp::confess("safe_chdir called without todir argument")
3830 unless defined $todir and length $todir;
3832 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
3836 unless (-x $todir) {
3837 unless (chmod 0755, $todir) {
3838 my $cwd = CPAN::anycwd();
3839 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
3840 "permission to change the permission; cannot ".
3841 "chdir to '$todir'\n");
3842 $CPAN::Frontend->mysleep(5);
3843 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
3844 qq{to todir[$todir]: $!});
3848 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
3851 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
3854 my $cwd = CPAN::anycwd();
3855 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
3856 qq{to todir[$todir] (a chmod has been issued): $!});
3861 #-> sub CPAN::InfoObj::set ;
3863 my($self,%att) = @_;
3864 my $class = ref $self;
3866 # This must be ||=, not ||, because only if we write an empty
3867 # reference, only then the set method will write into the readonly
3868 # area. But for Distributions that spring into existence, maybe
3869 # because of a typo, we do not like it that they are written into
3870 # the readonly area and made permanent (at least for a while) and
3871 # that is why we do not "allow" other places to call ->set.
3872 unless ($self->id) {
3873 CPAN->debug("Bug? Empty ID, rejecting");
3876 my $ro = $self->{RO} =
3877 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
3879 while (my($k,$v) = each %att) {
3884 #-> sub CPAN::InfoObj::as_glimpse ;
3888 my $class = ref($self);
3889 $class =~ s/^CPAN:://;
3890 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
3894 #-> sub CPAN::InfoObj::as_string ;
3898 my $class = ref($self);
3899 $class =~ s/^CPAN:://;
3900 push @m, $class, " id = $self->{ID}\n";
3902 unless ($ro = $self->ro) {
3903 $CPAN::Frontend->mydie("Unknown object $self->{ID}");
3905 for (sort keys %$ro) {
3906 # next if m/^(ID|RO)$/;
3908 if ($_ eq "CPAN_USERID") {
3910 $extra .= $self->fullname;
3911 my $email; # old perls!
3912 if ($email = $CPAN::META->instance("CPAN::Author",
3915 $extra .= " <$email>";
3917 $extra .= " <no email>";
3920 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
3921 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
3924 next unless defined $ro->{$_};
3925 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
3927 for (sort keys %$self) {
3928 next if m/^(ID|RO)$/;
3929 if (ref($self->{$_}) eq "ARRAY") {
3930 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
3931 } elsif (ref($self->{$_}) eq "HASH") {
3935 join(" ",sort keys %{$self->{$_}}),
3938 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
3944 #-> sub CPAN::InfoObj::fullname ;
3947 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
3950 #-> sub CPAN::InfoObj::dump ;
3953 unless ($CPAN::META->has_inst("Data::Dumper")) {
3954 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
3956 local $Data::Dumper::Sortkeys;
3957 $Data::Dumper::Sortkeys = 1;
3958 print Data::Dumper::Dumper($self);
3961 package CPAN::Author;
3964 #-> sub CPAN::Author::force
3970 #-> sub CPAN::Author::force
3973 delete $self->{force};
3976 #-> sub CPAN::Author::id
3979 my $id = $self->{ID};
3980 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
3984 #-> sub CPAN::Author::as_glimpse ;
3988 my $class = ref($self);
3989 $class =~ s/^CPAN:://;
3990 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
3998 #-> sub CPAN::Author::fullname ;
4000 shift->ro->{FULLNAME};
4004 #-> sub CPAN::Author::email ;
4005 sub email { shift->ro->{EMAIL}; }
4007 #-> sub CPAN::Author::ls ;
4010 my $glob = shift || "";
4011 my $silent = shift || 0;
4014 # adapted from CPAN::Distribution::verifyCHECKSUM ;
4015 my(@csf); # chksumfile
4016 @csf = $self->id =~ /(.)(.)(.*)/;
4017 $csf[1] = join "", @csf[0,1];
4018 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
4020 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
4021 unless (grep {$_->[2] eq $csf[1]} @dl) {
4022 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
4025 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
4026 unless (grep {$_->[2] eq $csf[2]} @dl) {
4027 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
4030 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
4032 if ($CPAN::META->has_inst("Text::Glob")) {
4033 my $rglob = Text::Glob::glob_to_regex($glob);
4034 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
4036 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
4039 $CPAN::Frontend->myprint(join "", map {
4040 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
4041 } sort { $a->[2] cmp $b->[2] } @dl);
4045 # returns an array of arrays, the latter contain (size,mtime,filename)
4046 #-> sub CPAN::Author::dir_listing ;
4049 my $chksumfile = shift;
4050 my $recursive = shift;
4051 my $may_ftp = shift;
4054 File::Spec->catfile($CPAN::Config->{keep_source_where},
4055 "authors", "id", @$chksumfile);
4059 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
4060 # hazard. (Without GPG installed they are not that much better,
4062 $fh = FileHandle->new;
4063 if (open($fh, $lc_want)) {
4064 my $line = <$fh>; close $fh;
4065 unlink($lc_want) unless $line =~ /PGP/;
4069 # connect "force" argument with "index_expire".
4070 my $force = $self->{force};
4071 if (my @stat = stat $lc_want) {
4072 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
4076 $lc_file = CPAN::FTP->localize(
4077 "authors/id/@$chksumfile",
4082 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
4083 $chksumfile->[-1] .= ".gz";
4084 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
4087 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
4088 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
4094 $lc_file = $lc_want;
4095 # we *could* second-guess and if the user has a file: URL,
4096 # then we could look there. But on the other hand, if they do
4097 # have a file: URL, wy did they choose to set
4098 # $CPAN::Config->{show_upload_date} to false?
4101 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
4102 $fh = FileHandle->new;
4104 if (open $fh, $lc_file){
4107 $eval =~ s/\015?\012/\n/g;
4109 my($comp) = Safe->new();
4110 $cksum = $comp->reval($eval);
4112 rename $lc_file, "$lc_file.bad";
4113 Carp::confess($@) if $@;
4115 } elsif ($may_ftp) {
4116 Carp::carp "Could not open '$lc_file' for reading.";
4118 # Maybe should warn: "You may want to set show_upload_date to a true value"
4122 for $f (sort keys %$cksum) {
4123 if (exists $cksum->{$f}{isdir}) {
4125 my(@dir) = @$chksumfile;
4127 push @dir, $f, "CHECKSUMS";
4129 [$_->[0], $_->[1], "$f/$_->[2]"]
4130 } $self->dir_listing(\@dir,1,$may_ftp);
4132 push @result, [ 0, "-", $f ];
4136 ($cksum->{$f}{"size"}||0),
4137 $cksum->{$f}{"mtime"}||"---",
4145 package CPAN::Distribution;
4151 my $ro = $self->ro or return;
4155 # CPAN::Distribution::undelay
4158 delete $self->{later};
4161 # add the A/AN/ stuff
4162 # CPAN::Distribution::normalize
4165 $s = $self->id unless defined $s;
4169 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
4171 return $s if $s =~ m:^N/A|^Contact Author: ;
4172 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
4173 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
4174 CPAN->debug("s[$s]") if $CPAN::DEBUG;
4179 #-> sub CPAN::Distribution::author ;
4182 my($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
4183 CPAN::Shell->expand("Author",$authorid);
4186 # tries to get the yaml from CPAN instead of the distro itself:
4187 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
4190 my $meta = $self->pretty_id;
4191 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
4192 my(@ls) = CPAN::Shell->globls($meta);
4193 my $norm = $self->normalize($meta);
4197 File::Spec->catfile(
4198 $CPAN::Config->{keep_source_where},
4203 $self->debug("Doing localize") if $CPAN::DEBUG;
4204 unless ($local_file =
4205 CPAN::FTP->localize("authors/id/$norm",
4207 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
4209 if ($CPAN::META->has_inst("YAML")) {
4210 my $yaml = YAML::LoadFile($local_file);
4213 $CPAN::Frontend->mydie("Yaml not installed, cannot parse '$local_file'\n");
4220 return $id unless $id =~ m|^./../|;
4224 # mark as dirty/clean
4225 #-> sub CPAN::Distribution::color_cmd_tmps ;
4226 sub color_cmd_tmps {
4228 my($depth) = shift || 0;
4229 my($color) = shift || 0;
4230 my($ancestors) = shift || [];
4231 # a distribution needs to recurse into its prereq_pms
4233 return if exists $self->{incommandcolor}
4234 && $self->{incommandcolor}==$color;
4236 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
4238 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
4239 my $prereq_pm = $self->prereq_pm;
4240 if (defined $prereq_pm) {
4241 PREREQ: for my $pre (keys %$prereq_pm) {
4243 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
4244 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
4245 $CPAN::Frontend->mysleep(2);
4248 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
4252 delete $self->{sponsored_mods};
4253 delete $self->{badtestcnt};
4255 $self->{incommandcolor} = $color;
4258 #-> sub CPAN::Distribution::as_string ;
4261 $self->containsmods;
4263 $self->SUPER::as_string(@_);
4266 #-> sub CPAN::Distribution::containsmods ;
4269 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
4270 my $dist_id = $self->{ID};
4271 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
4272 my $mod_file = $mod->cpan_file or next;
4273 my $mod_id = $mod->{ID} or next;
4274 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
4276 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
4278 keys %{$self->{CONTAINSMODS}};
4281 #-> sub CPAN::Distribution::upload_date ;
4284 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
4285 my(@local_wanted) = split(/\//,$self->id);
4286 my $filename = pop @local_wanted;
4287 push @local_wanted, "CHECKSUMS";
4288 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
4289 return unless $author;
4290 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
4292 my($dirent) = grep { $_->[2] eq $filename } @dl;
4293 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
4294 return unless $dirent->[1];
4295 return $self->{UPLOAD_DATE} = $dirent->[1];
4298 #-> sub CPAN::Distribution::uptodate ;
4302 foreach $c ($self->containsmods) {
4303 my $obj = CPAN::Shell->expandany($c);
4304 return 0 unless $obj->uptodate;
4309 #-> sub CPAN::Distribution::called_for ;
4312 $self->{CALLED_FOR} = $id if defined $id;
4313 return $self->{CALLED_FOR};
4316 #-> sub CPAN::Distribution::get ;
4321 exists $self->{'build_dir'} and push @e,
4322 "Is already unwrapped into directory $self->{'build_dir'}";
4323 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4325 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
4328 # Get the file on local disk
4333 File::Spec->catfile(
4334 $CPAN::Config->{keep_source_where},
4337 split(/\//,$self->id)
4340 $self->debug("Doing localize") if $CPAN::DEBUG;
4341 unless ($local_file =
4342 CPAN::FTP->localize("authors/id/$self->{ID}",
4345 if ($CPAN::Index::DATE_OF_02) {
4346 $note = "Note: Current database in memory was generated ".
4347 "on $CPAN::Index::DATE_OF_02\n";
4349 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
4351 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4352 $self->{localfile} = $local_file;
4353 return if $CPAN::Signal;
4358 if ($CPAN::META->has_inst("Digest::SHA")) {
4359 $self->debug("Digest::SHA is installed, verifying");
4360 $self->verifyCHECKSUM;
4362 $self->debug("Digest::SHA is NOT installed");
4364 return if $CPAN::Signal;
4367 # Create a clean room and go there
4369 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
4370 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
4371 $self->safe_chdir($builddir);
4372 $self->debug("Removing tmp") if $CPAN::DEBUG;
4373 File::Path::rmtree("tmp");
4374 unless (mkdir "tmp", 0755) {
4375 $CPAN::Frontend->unrecoverable_error(<<EOF);
4376 Couldn't mkdir '$builddir/tmp': $!
4378 Cannot continue: Please find the reason why I cannot make the
4381 and fix the problem, then retry.
4386 $self->safe_chdir($sub_wd);
4389 $self->safe_chdir("tmp");
4394 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4395 my $ct = CPAN::Tarzip->new($local_file);
4396 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
4397 $self->{was_uncompressed}++ unless $ct->gtest();
4398 $self->untar_me($ct);
4399 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
4400 $self->unzip_me($ct);
4401 } elsif ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/) {
4402 $self->{was_uncompressed}++ unless $ct->gtest();
4403 $self->debug("calling pm2dir for local_file[$local_file]") if $CPAN::DEBUG;
4404 $self->pm2dir_me($local_file);
4406 $self->{archived} = "NO";
4407 $self->safe_chdir($sub_wd);
4411 # we are still in the tmp directory!
4412 # Let's check if the package has its own directory.
4413 my $dh = DirHandle->new(File::Spec->curdir)
4414 or Carp::croak("Couldn't opendir .: $!");
4415 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
4417 my ($distdir,$packagedir);
4418 if (@readdir == 1 && -d $readdir[0]) {
4419 $distdir = $readdir[0];
4420 $packagedir = File::Spec->catdir($builddir,$distdir);
4421 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
4423 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
4425 File::Path::rmtree($packagedir);
4426 unless (File::Copy::move($distdir,$packagedir)) {
4427 $CPAN::Frontend->unrecoverable_error(<<EOF);
4428 Couldn't move '$distdir' to '$packagedir': $!
4430 Cannot continue: Please find the reason why I cannot move
4431 $builddir/tmp/$distdir
4434 and fix the problem, then retry
4438 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
4445 my $userid = $self->cpan_userid;
4447 CPAN->debug("no userid? self[$self]");
4450 my $pragmatic_dir = $userid . '000';
4451 $pragmatic_dir =~ s/\W_//g;
4452 $pragmatic_dir++ while -d "../$pragmatic_dir";
4453 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
4454 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
4455 File::Path::mkpath($packagedir);
4457 for $f (@readdir) { # is already without "." and ".."
4458 my $to = File::Spec->catdir($packagedir,$f);
4459 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
4463 $self->safe_chdir($sub_wd);
4467 $self->{'build_dir'} = $packagedir;
4468 $self->safe_chdir($builddir);
4469 File::Path::rmtree("tmp");
4471 $self->safe_chdir($packagedir);
4472 if ($CPAN::META->has_inst("Module::Signature")) {
4473 if (-f "SIGNATURE") {
4474 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
4475 my $rv = Module::Signature::verify();
4476 if ($rv != Module::Signature::SIGNATURE_OK() and
4477 $rv != Module::Signature::SIGNATURE_MISSING()) {
4478 $CPAN::Frontend->myprint(
4479 qq{\nSignature invalid for }.
4480 qq{distribution file. }.
4481 qq{Please investigate.\n\n}.
4483 $CPAN::META->instance(
4490 sprintf(qq{I'd recommend removing %s. Its signature
4491 is invalid. Maybe you have configured your 'urllist' with
4492 a bad URL. Please check this array with 'o conf urllist', and
4493 retry. For more information, try opening a subshell with
4501 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
4502 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
4503 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
4505 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
4508 $CPAN::Frontend->myprint(qq{Package came without SIGNATURE\n\n});
4511 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
4513 $self->safe_chdir($builddir);
4514 return if $CPAN::Signal;
4517 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
4518 my($mpl_exists) = -f $mpl;
4519 unless ($mpl_exists) {
4520 # NFS has been reported to have racing problems after the
4521 # renaming of a directory in some environments.
4524 my $mpldh = DirHandle->new($packagedir)
4525 or Carp::croak("Couldn't opendir $packagedir: $!");
4526 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
4529 my $prefer_installer = "eumm"; # eumm|mb
4530 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
4531 if ($mpl_exists) { # they *can* choose
4532 if ($CPAN::META->has_inst("Module::Build")) {
4533 $prefer_installer = $CPAN::Config->{prefer_installer};
4536 $prefer_installer = "mb";
4539 if (lc($prefer_installer) eq "mb") {
4540 $self->{modulebuild} = 1;
4541 } elsif (! $mpl_exists) {
4542 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
4546 my($configure) = File::Spec->catfile($packagedir,"Configure");
4547 if (-f $configure) {
4548 # do we have anything to do?
4549 $self->{'configure'} = $configure;
4550 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
4551 $CPAN::Frontend->myprint(qq{
4552 Package comes with a Makefile and without a Makefile.PL.
4553 We\'ll try to build it with that Makefile then.
4555 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
4558 my $cf = $self->called_for || "unknown";
4563 $cf =~ s|[/\\:]||g; # risk of filesystem damage
4564 $cf = "unknown" unless length($cf);
4565 $CPAN::Frontend->myprint(qq{Package seems to come without Makefile.PL.
4566 (The test -f "$mpl" returned false.)
4567 Writing one on our own (setting NAME to $cf)\a\n});
4568 $self->{had_no_makefile_pl}++;
4571 # Writing our own Makefile.PL
4573 my $fh = FileHandle->new;
4575 or Carp::croak("Could not open >$mpl: $!");
4577 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
4578 # because there was no Makefile.PL supplied.
4579 # Autogenerated on: }.scalar localtime().qq{
4581 use ExtUtils::MakeMaker;
4582 WriteMakefile(NAME => q[$cf]);
4592 # CPAN::Distribution::untar_me ;
4595 $self->{archived} = "tar";
4597 $self->{unwrapped} = "YES";
4599 $self->{unwrapped} = "NO";
4603 # CPAN::Distribution::unzip_me ;
4606 $self->{archived} = "zip";
4608 $self->{unwrapped} = "YES";
4610 $self->{unwrapped} = "NO";
4616 my($self,$local_file) = @_;
4617 $self->{archived} = "pm";
4618 my $to = File::Basename::basename($local_file);
4619 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
4620 if (CPAN::Tarzip->new($local_file)->gunzip($to)) {
4621 $self->{unwrapped} = "YES";
4623 $self->{unwrapped} = "NO";
4626 File::Copy::cp($local_file,".");
4627 $self->{unwrapped} = "YES";
4631 #-> sub CPAN::Distribution::new ;
4633 my($class,%att) = @_;
4635 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
4637 my $this = { %att };
4638 return bless $this, $class;
4641 #-> sub CPAN::Distribution::look ;
4645 if ($^O eq 'MacOS') {
4646 $self->Mac::BuildTools::look;
4650 if ( $CPAN::Config->{'shell'} ) {
4651 $CPAN::Frontend->myprint(qq{
4652 Trying to open a subshell in the build directory...
4655 $CPAN::Frontend->myprint(qq{
4656 Your configuration does not define a value for subshells.
4657 Please define it with "o conf shell <your shell>"
4661 my $dist = $self->id;
4663 unless ($dir = $self->dir) {
4666 unless ($dir ||= $self->dir) {
4667 $CPAN::Frontend->mywarn(qq{
4668 Could not determine which directory to use for looking at $dist.
4672 my $pwd = CPAN::anycwd();
4673 $self->safe_chdir($dir);
4674 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
4676 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
4677 $ENV{CPAN_SHELL_LEVEL} += 1;
4678 unless (system($CPAN::Config->{'shell'}) == 0) {
4680 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
4683 $self->safe_chdir($pwd);
4686 # CPAN::Distribution::cvs_import ;
4690 my $dir = $self->dir;
4692 my $package = $self->called_for;
4693 my $module = $CPAN::META->instance('CPAN::Module', $package);
4694 my $version = $module->cpan_version;
4696 my $userid = $self->cpan_userid;
4698 my $cvs_dir = (split /\//, $dir)[-1];
4699 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
4701 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
4703 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
4704 if ($cvs_site_perl) {
4705 $cvs_dir = "$cvs_site_perl/$cvs_dir";
4707 my $cvs_log = qq{"imported $package $version sources"};
4708 $version =~ s/\./_/g;
4709 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
4710 "$cvs_dir", $userid, "v$version");
4712 my $pwd = CPAN::anycwd();
4713 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
4715 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
4717 $CPAN::Frontend->myprint(qq{@cmd\n});
4718 system(@cmd) == 0 or
4719 $CPAN::Frontend->mydie("cvs import failed");
4720 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
4723 #-> sub CPAN::Distribution::readme ;
4726 my($dist) = $self->id;
4727 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
4728 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
4731 File::Spec->catfile(
4732 $CPAN::Config->{keep_source_where},
4735 split(/\//,"$sans.readme"),
4737 $self->debug("Doing localize") if $CPAN::DEBUG;
4738 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
4740 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
4742 if ($^O eq 'MacOS') {
4743 Mac::BuildTools::launch_file($local_file);
4747 my $fh_pager = FileHandle->new;
4748 local($SIG{PIPE}) = "IGNORE";
4749 $fh_pager->open("|$CPAN::Config->{'pager'}")
4750 or die "Could not open pager $CPAN::Config->{'pager'}: $!";
4751 my $fh_readme = FileHandle->new;
4752 $fh_readme->open($local_file)
4753 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
4754 $CPAN::Frontend->myprint(qq{
4757 with pager "$CPAN::Config->{'pager'}"
4760 $fh_pager->print(<$fh_readme>);
4764 #-> sub CPAN::Distribution::verifyCHECKSUM ;
4765 sub verifyCHECKSUM {
4769 $self->{CHECKSUM_STATUS} ||= "";
4770 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
4771 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4773 my($lc_want,$lc_file,@local,$basename);
4774 @local = split(/\//,$self->id);
4776 push @local, "CHECKSUMS";
4778 File::Spec->catfile($CPAN::Config->{keep_source_where},
4779 "authors", "id", @local);
4781 if (my $size = -s $lc_want) {
4782 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
4783 if ($self->CHECKSUM_check_file($lc_want,1)) {
4784 return $self->{CHECKSUM_STATUS} = "OK";
4787 $lc_file = CPAN::FTP->localize("authors/id/@local",
4790 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
4791 $local[-1] .= ".gz";
4792 $lc_file = CPAN::FTP->localize("authors/id/@local",
4795 $lc_file =~ s/\.gz(?!\n)\Z//;
4796 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
4801 if ($self->CHECKSUM_check_file($lc_file)) {
4802 return $self->{CHECKSUM_STATUS} = "OK";
4806 #-> sub CPAN::Distribution::SIG_check_file ;
4807 sub SIG_check_file {
4808 my($self,$chk_file) = @_;
4809 my $rv = eval { Module::Signature::_verify($chk_file) };
4811 if ($rv == Module::Signature::SIGNATURE_OK()) {
4812 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
4813 return $self->{SIG_STATUS} = "OK";
4815 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
4816 qq{distribution file. }.
4817 qq{Please investigate.\n\n}.
4819 $CPAN::META->instance(
4824 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
4825 is invalid. Maybe you have configured your 'urllist' with
4826 a bad URL. Please check this array with 'o conf urllist', and
4829 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
4833 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
4835 # sloppy is 1 when we have an old checksums file that maybe is good
4838 sub CHECKSUM_check_file {
4839 my($self,$chk_file,$sloppy) = @_;
4840 my($cksum,$file,$basename);
4843 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
4844 if ($CPAN::META->has_inst("Module::Signature") and Module::Signature->VERSION >= 0.26) {
4845 $self->debug("Module::Signature is installed, verifying");
4846 $self->SIG_check_file($chk_file);
4848 $self->debug("Module::Signature is NOT installed");
4851 $file = $self->{localfile};
4852 $basename = File::Basename::basename($file);
4853 my $fh = FileHandle->new;
4854 if (open $fh, $chk_file){
4857 $eval =~ s/\015?\012/\n/g;
4859 my($comp) = Safe->new();
4860 $cksum = $comp->reval($eval);
4862 rename $chk_file, "$chk_file.bad";
4863 Carp::confess($@) if $@;
4866 Carp::carp "Could not open $chk_file for reading";
4869 if (! ref $cksum or ref $cksum ne "HASH") {
4870 $CPAN::Frontend->mywarn(qq{
4871 Warning: checksum file '$chk_file' broken.
4873 When trying to read that file I expected to get a hash reference
4874 for further processing, but got garbage instead.
4876 my $answer = ExtUtils::MakeMaker::prompt("Proceed nonetheless?", "no");
4877 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
4878 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
4880 } elsif (exists $cksum->{$basename}{sha256}) {
4881 $self->debug("Found checksum for $basename:" .
4882 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
4886 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
4888 $fh = CPAN::Tarzip->TIEHANDLE($file);
4891 my $dg = Digest::SHA->new(256);
4894 while ($fh->READ($ref, 4096) > 0){
4897 my $hexdigest = $dg->hexdigest;
4898 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
4902 $CPAN::Frontend->myprint("Checksum for $file ok\n");
4903 return $self->{CHECKSUM_STATUS} = "OK";
4905 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
4906 qq{distribution file. }.
4907 qq{Please investigate.\n\n}.
4909 $CPAN::META->instance(
4914 my $wrap = qq{I\'d recommend removing $file. Its
4915 checksum is incorrect. Maybe you have configured your 'urllist' with
4916 a bad URL. Please check this array with 'o conf urllist', and
4919 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
4921 # former versions just returned here but this seems a
4922 # serious threat that deserves a die
4924 # $CPAN::Frontend->myprint("\n\n");
4928 # close $fh if fileno($fh);
4931 unless ($self->{CHECKSUM_STATUS}) {
4932 $CPAN::Frontend->mywarn(qq{
4933 Warning: No checksum for $basename in $chk_file.
4935 The cause for this may be that the file is very new and the checksum
4936 has not yet been calculated, but it may also be that something is
4937 going awry right now.
4939 my $answer = ExtUtils::MakeMaker::prompt("Proceed?", "yes");
4940 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
4942 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
4947 #-> sub CPAN::Distribution::eq_CHECKSUM ;
4949 my($self,$fh,$expect) = @_;
4950 if ($CPAN::META->has_inst("Digest::SHA")) {
4951 my $dg = Digest::SHA->new(256);
4953 while (read($fh, $data, 4096)){
4956 my $hexdigest = $dg->hexdigest;
4957 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
4958 return $hexdigest eq $expect;
4963 #-> sub CPAN::Distribution::force ;
4965 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
4966 # effect by autoinspection, not by inspecting a global variable. One
4967 # of the reason why this was chosen to work that way was the treatment
4968 # of dependencies. They should not automatically inherit the force
4969 # status. But this has the downside that ^C and die() will return to
4970 # the prompt but will not be able to reset the force_update
4971 # attributes. We try to correct for it currently in the read_metadata
4972 # routine, and immediately before we check for a Signal. I hope this
4973 # works out in one of v1.57_53ff
4975 # "Force get forgets previous error conditions"
4977 #-> sub CPAN::Distribution::force ;
4979 my($self, $method) = @_;
4981 CHECKSUM_STATUS archived build_dir localfile make install unwrapped
4982 writemakefile modulebuild make_test
4984 delete $self->{$att};
4986 if ($method && $method =~ /make|test|install/) {
4987 $self->{"force_update"}++; # name should probably have been force_install
4992 my($self, $method) = @_;
4993 # warn "XDEBUG: set notest for $self $method";
4994 $self->{"notest"}++; # name should probably have been force_install
4999 # warn "XDEBUG: deleting notest";
5000 delete $self->{'notest'};
5003 #-> sub CPAN::Distribution::unforce ;
5006 delete $self->{'force_update'};
5009 #-> sub CPAN::Distribution::isa_perl ;
5012 my $file = File::Basename::basename($self->id);
5013 if ($file =~ m{ ^ perl
5026 } elsif ($self->cpan_comment
5028 $self->cpan_comment =~ /isa_perl\(.+?\)/){
5034 #-> sub CPAN::Distribution::perl ;
5040 #-> sub CPAN::Distribution::make ;
5043 my $make = $self->{modulebuild} ? "Build" : "make";
5044 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
5045 # Emergency brake if they said install Pippi and get newest perl
5046 if ($self->isa_perl) {
5048 $self->called_for ne $self->id &&
5049 ! $self->{force_update}
5051 # if we die here, we break bundles
5052 $CPAN::Frontend->mywarn(sprintf qq{
5053 The most recent version "%s" of the module "%s"
5054 comes with the current version of perl (%s).
5055 I\'ll build that only if you ask for something like
5060 $CPAN::META->instance(
5073 delete $self->{force_update};
5078 !$self->{archived} || $self->{archived} eq "NO" and push @e,
5079 "Is neither a tar nor a zip archive.";
5081 !$self->{unwrapped} || $self->{unwrapped} eq "NO" and push @e,
5082 "Had problems unarchiving. Please build manually";
5084 unless ($self->{force_update}) {
5085 exists $self->{signature_verify} and (
5086 $self->{signature_verify}->can("failed") ?
5087 $self->{signature_verify}->failed :
5088 $self->{signature_verify} =~ /^NO/
5090 and push @e, "Did not pass the signature test.";
5093 if (exists $self->{writemakefile} &&
5095 $self->{writemakefile}->can("failed") ?
5096 $self->{writemakefile}->failed :
5097 $self->{writemakefile} =~ /^NO/
5099 # XXX maybe a retry would be in order?
5100 my $err = $self->{writemakefile}->can("text") ?
5101 $self->{writemakefile}->text :
5102 $self->{writemakefile};
5104 $err ||= "Had some problem writing Makefile";
5105 $err .= ", won't make";
5109 defined $self->{make} and push @e,
5110 "Has already been processed within this session";
5112 if (exists $self->{later} and length($self->{later})) {
5113 if ($self->unsat_prereq) {
5114 push @e, $self->{later};
5116 delete $self->{later};
5120 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5123 delete $self->{force_update};
5126 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
5127 my $builddir = $self->dir or
5128 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
5129 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
5130 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
5132 if ($^O eq 'MacOS') {
5133 Mac::BuildTools::make($self);
5138 if ($self->{'configure'}) {
5139 $system = $self->{'configure'};
5140 } elsif ($self->{modulebuild}) {
5141 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5142 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
5144 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5146 # This needs a handler that can be turned on or off:
5147 # $switch = "-MExtUtils::MakeMaker ".
5148 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
5150 $system = sprintf("%s%s Makefile.PL%s",
5152 $switch ? " $switch" : "",
5153 $CPAN::Config->{makepl_arg} ? " $CPAN::Config->{makepl_arg}" : "",
5156 unless (exists $self->{writemakefile}) {
5157 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
5160 if ($CPAN::Config->{inactivity_timeout}) {
5162 alarm $CPAN::Config->{inactivity_timeout};
5163 local $SIG{CHLD}; # = sub { wait };
5164 if (defined($pid = fork)) {
5169 # note, this exec isn't necessary if
5170 # inactivity_timeout is 0. On the Mac I'd
5171 # suggest, we set it always to 0.
5175 $CPAN::Frontend->myprint("Cannot fork: $!");
5183 $CPAN::Frontend->myprint($@);
5184 $self->{writemakefile} = CPAN::Distrostatus->new("NO $@");
5189 $ret = system($system);
5191 $self->{writemakefile} = CPAN::Distrostatus
5192 ->new("NO '$system' returned status $ret");
5196 if (-f "Makefile" || -f "Build") {
5197 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
5198 delete $self->{make_clean}; # if cleaned before, enable next
5200 $self->{writemakefile} = CPAN::Distrostatus
5201 ->new(qq{NO -- Unknown reason.});
5205 delete $self->{force_update};
5208 if (my @prereq = $self->unsat_prereq){
5209 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5211 if ($self->{modulebuild}) {
5212 $system = sprintf "%s %s", $self->_build_command(), $CPAN::Config->{mbuild_arg};
5214 $system = join " ", _make_command(), $CPAN::Config->{make_arg};
5216 if (system($system) == 0) {
5217 $CPAN::Frontend->myprint(" $system -- OK\n");
5218 $self->{make} = CPAN::Distrostatus->new("YES");
5220 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
5221 $self->{make} = CPAN::Distrostatus->new("NO");
5222 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5227 return $CPAN::Config->{make} || $Config::Config{make} || 'make';
5230 #-> sub CPAN::Distribution::follow_prereqs ;
5231 sub follow_prereqs {
5233 my(@prereq) = grep {$_ ne "perl"} @_;
5234 return unless @prereq;
5236 $CPAN::Frontend->myprint("---- Unsatisfied dependencies detected ".
5237 "during [$id] -----\n");
5239 for my $p (@prereq) {
5240 $CPAN::Frontend->myprint(" $p\n");
5243 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
5245 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
5246 my $answer = ExtUtils::MakeMaker::prompt(
5247 "Shall I follow them and prepend them to the queue
5248 of modules we are processing right now?", "yes");
5249 $follow = $answer =~ /^\s*y/i;
5253 myprint(" Ignoring dependencies on modules @prereq\n");
5256 # color them as dirty
5257 for my $p (@prereq) {
5258 # warn "calling color_cmd_tmps(0,1)";
5259 CPAN::Shell->expandany($p)->color_cmd_tmps(0,1);
5261 CPAN::Queue->jumpqueue(@prereq,$id); # queue them and requeue yourself
5262 $self->{later} = "Delayed until after prerequisites";
5263 return 1; # signal success to the queuerunner
5267 #-> sub CPAN::Distribution::unsat_prereq ;
5270 my $prereq_pm = $self->prereq_pm or return;
5272 NEED: while (my($need_module, $need_version) = each %$prereq_pm) {
5273 my $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
5274 # we were too demanding:
5275 next if $nmo->uptodate;
5277 # if they have not specified a version, we accept any installed one
5278 if (not defined $need_version or
5279 $need_version eq "0" or
5280 $need_version eq "undef") {
5281 next if defined $nmo->inst_file;
5284 # We only want to install prereqs if either they're not installed
5285 # or if the installed version is too old. We cannot omit this
5286 # check, because if 'force' is in effect, nobody else will check.
5287 if (defined $nmo->inst_file) {
5288 my(@all_requirements) = split /\s*,\s*/, $need_version;
5291 RQ: for my $rq (@all_requirements) {
5292 if ($rq =~ s|>=\s*||) {
5293 } elsif ($rq =~ s|>\s*||) {
5295 if (CPAN::Version->vgt($nmo->inst_version,$rq)){
5299 } elsif ($rq =~ s|!=\s*||) {
5301 if (CPAN::Version->vcmp($nmo->inst_version,$rq)){
5307 } elsif ($rq =~ m|<=?\s*|) {
5309 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])");
5313 if (! CPAN::Version->vgt($rq, $nmo->inst_version)){
5316 CPAN->debug(sprintf "id[%s]inst_file[%s]inst_version[%s]rq[%s]ok[%d]",
5320 CPAN::Version->readable($rq),
5324 next NEED if $ok == @all_requirements;
5327 if ($self->{sponsored_mods}{$need_module}++){
5328 # We have already sponsored it and for some reason it's still
5329 # not available. So we do nothing. Or what should we do?
5330 # if we push it again, we have a potential infinite loop
5333 push @need, $need_module;
5338 #-> sub CPAN::Distribution::read_yaml ;
5341 return $self->{yaml_content} if exists $self->{yaml_content};
5342 my $build_dir = $self->{build_dir};
5343 my $yaml = File::Spec->catfile($build_dir,"META.yml");
5344 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
5345 return unless -f $yaml;
5346 if ($CPAN::META->has_inst("YAML")) {
5347 eval { $self->{yaml_content} = YAML::LoadFile($yaml); };
5349 $CPAN::Frontend->mywarn("Error while parsing META.yml: $@");
5353 $self->debug("yaml_content[$self->{yaml_content}]") if $CPAN::DEBUG;
5354 return $self->{yaml_content};
5357 #-> sub CPAN::Distribution::prereq_pm ;
5360 return $self->{prereq_pm} if
5361 exists $self->{prereq_pm_detected} && $self->{prereq_pm_detected};
5362 return unless $self->{writemakefile} # no need to have succeeded
5363 # but we must have run it
5364 || $self->{modulebuild};
5366 if (my $yaml = $self->read_yaml) {
5367 $req = $yaml->{requires};
5368 undef $req unless ref $req eq "HASH" && %$req;
5370 if ($yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
5371 my $eummv = do { local $^W = 0; $1+0; };
5372 if ($eummv < 6.2501) {
5373 # thanks to Slaven for digging that out: MM before
5374 # that could be wrong because it could reflect a
5381 while (my($k,$v) = each %{$req||{}}) {
5384 } elsif ($k =~ /[A-Za-z]/ &&
5386 $CPAN::META->exists("Module",$v)
5388 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
5389 "requires hash: $k => $v; I'll take both ".
5390 "key and value as a module name\n");
5397 $req = $areq if $do_replace;
5399 if ($yaml->{build_requires}
5400 && ref $yaml->{build_requires}
5401 && ref $yaml->{build_requires} eq "HASH") {
5402 while (my($k,$v) = each %{$yaml->{build_requires}}) {
5404 # merging of two "requires"-type values--what should we do?
5411 delete $req->{perl};
5415 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
5416 my $makefile = File::Spec->catfile($build_dir,"Makefile");
5420 $fh = FileHandle->new("<$makefile\0")) {
5423 last if /MakeMaker post_initialize section/;
5425 \s+PREREQ_PM\s+=>\s+(.+)
5428 # warn "Found prereq expr[$p]";
5430 # Regexp modified by A.Speer to remember actual version of file
5431 # PREREQ_PM hash key wants, then add to
5432 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){
5433 # In case a prereq is mentioned twice, complain.
5434 if ( defined $req->{$1} ) {
5435 warn "Warning: PREREQ_PM mentions $1 more than once, ".
5436 "last mention wins";
5442 } elsif (-f "Build") {
5443 if ($CPAN::META->has_inst("Module::Build")) {
5444 my $requires = Module::Build->current->requires();
5445 my $brequires = Module::Build->current->build_requires();
5446 $req = { %$requires, %$brequires };
5450 if (-f "Build.PL" && ! -f "Makefile.PL" && ! exists $req->{"Module::Build"}) {
5451 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
5452 "undeclared prerequisite.\n".
5453 " Adding it now as a prerequisite.\n"
5455 $CPAN::Frontend->mysleep(5);
5456 $req->{"Module::Build"} = 0;
5457 delete $self->{writemakefile};
5459 $self->{prereq_pm_detected}++;
5460 return $self->{prereq_pm} = $req;
5463 #-> sub CPAN::Distribution::test ;
5468 delete $self->{force_update};
5471 # warn "XDEBUG: checking for notest: $self->{notest} $self";
5472 if ($self->{notest}) {
5473 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
5477 my $make = $self->{modulebuild} ? "Build" : "make";
5478 $CPAN::Frontend->myprint("Running $make test\n");
5479 if (my @prereq = $self->unsat_prereq){
5480 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5484 unless (exists $self->{make} or exists $self->{later}) {
5486 "Make had some problems, won't test";
5489 exists $self->{make} and
5491 $self->{make}->can("failed") ?
5492 $self->{make}->failed :
5493 $self->{make} =~ /^NO/
5494 ) and push @e, "Can't test without successful make";
5496 exists $self->{build_dir} or push @e, "Has no own directory";
5497 $self->{badtestcnt} ||= 0;
5498 $self->{badtestcnt} > 0 and
5499 push @e, "Won't repeat unsuccessful test during this command";
5501 exists $self->{later} and length($self->{later}) and
5502 push @e, $self->{later};
5504 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5506 chdir $self->{'build_dir'} or
5507 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5508 $self->debug("Changed directory to $self->{'build_dir'}")
5511 if ($^O eq 'MacOS') {
5512 Mac::BuildTools::make_test($self);
5516 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
5518 : ($ENV{PERLLIB} || "");
5520 $CPAN::META->set_perl5lib;
5521 local $ENV{MAKEFLAGS}; # protect us from outer make calls
5524 if ($self->{modulebuild}) {
5525 $system = sprintf "%s test", $self->_build_command();
5527 $system = join " ", _make_command(), "test";
5529 if (system($system) == 0) {
5530 $CPAN::Frontend->myprint(" $system -- OK\n");
5531 $CPAN::META->is_tested($self->{'build_dir'});
5532 $self->{make_test} = CPAN::Distrostatus->new("YES");
5534 $self->{make_test} = CPAN::Distrostatus->new("NO");
5535 $self->{badtestcnt}++;
5536 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5540 #-> sub CPAN::Distribution::clean ;
5543 my $make = $self->{modulebuild} ? "Build" : "make";
5544 $CPAN::Frontend->myprint("Running $make clean\n");
5545 unless (exists $self->{archived}) {
5546 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
5547 "/untarred, nothing done\n");
5550 unless (exists $self->{build_dir}) {
5551 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
5556 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
5557 push @e, "make clean already called once";
5558 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5560 chdir $self->{'build_dir'} or
5561 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5562 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
5564 if ($^O eq 'MacOS') {
5565 Mac::BuildTools::make_clean($self);
5570 if ($self->{modulebuild}) {
5571 $system = sprintf "%s clean", $self->_build_command();
5573 $system = join " ", _make_command(), "clean";
5575 if (system($system) == 0) {
5576 $CPAN::Frontend->myprint(" $system -- OK\n");
5580 # Jost Krieger pointed out that this "force" was wrong because
5581 # it has the effect that the next "install" on this distribution
5582 # will untar everything again. Instead we should bring the
5583 # object's state back to where it is after untarring.
5594 $self->{make_clean} = CPAN::Distrostatus->new("YES");
5597 # Hmmm, what to do if make clean failed?
5599 $self->{make_clean} = CPAN::Distrostatus->new("NO");
5600 $CPAN::Frontend->myprint(qq{ $system -- NOT OK\n});
5602 # 2006-02-27: seems silly to me to force a make now
5603 # $self->force("make"); # so that this directory won't be used again
5608 #-> sub CPAN::Distribution::install ;
5613 delete $self->{force_update};
5616 my $make = $self->{modulebuild} ? "Build" : "make";
5617 $CPAN::Frontend->myprint("Running $make install\n");
5620 exists $self->{build_dir} or push @e, "Has no own directory";
5622 unless (exists $self->{make} or exists $self->{later}) {
5624 "Make had some problems, won't install";
5627 exists $self->{make} and
5629 $self->{make}->can("failed") ?
5630 $self->{make}->failed :
5631 $self->{make} =~ /^NO/
5633 push @e, "make had returned bad status, install seems impossible";
5635 if (exists $self->{make_test} and
5637 $self->{make_test}->can("failed") ?
5638 $self->{make_test}->failed :
5639 $self->{make_test} =~ /^NO/
5641 if ($self->{force_update}) {
5642 $self->{make_test}->text("FAILED but failure ignored because ".
5643 "'force' in effect");
5645 push @e, "make test had returned bad status, ".
5646 "won't install without force"
5649 if (exists $self->{'install'}) {
5650 if ($self->{'install'}->can("text") ?
5651 $self->{'install'}->text eq "YES" :
5652 $self->{'install'} =~ /^YES/
5654 push @e, "Already done";
5656 # comment in Todo on 2006-02-11; maybe retry?
5657 push @e, "Already tried without success";
5661 exists $self->{later} and length($self->{later}) and
5662 push @e, $self->{later};
5664 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5666 chdir $self->{'build_dir'} or
5667 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5668 $self->debug("Changed directory to $self->{'build_dir'}")
5671 if ($^O eq 'MacOS') {
5672 Mac::BuildTools::make_install($self);
5677 if ($self->{modulebuild}) {
5678 my($mbuild_install_build_command) =
5679 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
5680 $CPAN::Config->{mbuild_install_build_command} ?
5681 $CPAN::Config->{mbuild_install_build_command} :
5682 $self->_build_command();
5683 $system = sprintf("%s install %s",
5684 $mbuild_install_build_command,
5685 $CPAN::Config->{mbuild_install_arg},
5688 my($make_install_make_command) = $CPAN::Config->{make_install_make_command} ||
5690 $system = sprintf("%s install %s",
5691 $make_install_make_command,
5692 $CPAN::Config->{make_install_arg},
5696 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
5697 my($pipe) = FileHandle->new("$system $stderr |");
5700 $CPAN::Frontend->myprint($_);
5705 $CPAN::Frontend->myprint(" $system -- OK\n");
5706 $CPAN::META->is_installed($self->{build_dir});
5707 return $self->{install} = CPAN::Distrostatus->new("YES");
5709 $self->{install} = CPAN::Distrostatus->new("NO");
5710 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5712 $makeout =~ /permission/s
5715 ! $CPAN::Config->{make_install_make_command}
5716 || $CPAN::Config->{make_install_make_command} eq $CPAN::Config->{make}
5719 $CPAN::Frontend->myprint(
5721 qq{ You may have to su }.
5722 qq{to root to install the package\n}.
5723 qq{ (Or you may want to run something like\n}.
5724 qq{ o conf make_install_make_command 'sudo make'\n}.
5725 qq{ to raise your permissions.}
5729 delete $self->{force_update};
5732 #-> sub CPAN::Distribution::dir ;
5734 shift->{'build_dir'};
5737 #-> sub CPAN::Distribution::perldoc ;
5741 my($dist) = $self->id;
5742 my $package = $self->called_for;
5744 $self->_display_url( $CPAN::Defaultdocs . $package );
5747 #-> sub CPAN::Distribution::_check_binary ;
5749 my ($dist,$shell,$binary) = @_;
5752 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
5756 $pid = open README, "which $binary|"
5757 or $CPAN::Frontend->mydie(qq{Could not fork 'which $binary': $!});
5761 close README or die "Could not run 'which $binary': $!";
5763 $CPAN::Frontend->myprint(qq{ + $out \n})
5764 if $CPAN::DEBUG && $out;
5769 #-> sub CPAN::Distribution::_display_url ;
5771 my($self,$url) = @_;
5772 my($res,$saved_file,$pid,$out);
5774 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
5777 # should we define it in the config instead?
5778 my $html_converter = "html2text";
5780 my $web_browser = $CPAN::Config->{'lynx'} || undef;
5781 my $web_browser_out = $web_browser
5782 ? CPAN::Distribution->_check_binary($self,$web_browser)
5785 if ($web_browser_out) {
5786 # web browser found, run the action
5787 my $browser = $CPAN::Config->{'lynx'};
5788 $CPAN::Frontend->myprint(qq{system[$browser $url]})
5790 $CPAN::Frontend->myprint(qq{
5793 with browser $browser
5796 system("$browser $url");
5797 if ($saved_file) { 1 while unlink($saved_file) }
5799 # web browser not found, let's try text only
5800 my $html_converter_out =
5801 CPAN::Distribution->_check_binary($self,$html_converter);
5803 if ($html_converter_out ) {
5804 # html2text found, run it
5805 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
5806 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
5807 unless defined($saved_file);
5810 $pid = open README, "$html_converter $saved_file |"
5811 or $CPAN::Frontend->mydie(qq{
5812 Could not fork '$html_converter $saved_file': $!});
5814 if ($CPAN::META->has_inst("File::Temp")) {
5815 $fh = File::Temp->new(
5816 template => 'cpan_htmlconvert_XXXX',
5820 $filename = $fh->filename;
5822 $filename = "cpan_htmlconvert_$$.txt";
5823 $fh = FileHandle->new();
5824 open $fh, ">$filename" or die;
5830 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
5831 my $tmpin = $fh->filename;
5832 $CPAN::Frontend->myprint(sprintf(qq{
5834 saved output to %s\n},
5842 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
5843 my $fh_pager = FileHandle->new;
5844 local($SIG{PIPE}) = "IGNORE";
5845 $fh_pager->open("|$CPAN::Config->{'pager'}")
5846 or $CPAN::Frontend->mydie(qq{
5847 Could not open pager $CPAN::Config->{'pager'}: $!});
5848 $CPAN::Frontend->myprint(qq{
5851 with pager "$CPAN::Config->{'pager'}"
5854 $fh_pager->print(<FH>);
5857 # coldn't find the web browser or html converter
5858 $CPAN::Frontend->myprint(qq{
5859 You need to install lynx or $html_converter to use this feature.});
5864 #-> sub CPAN::Distribution::_getsave_url ;
5866 my($dist, $shell, $url) = @_;
5868 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
5872 if ($CPAN::META->has_inst("File::Temp")) {
5873 $fh = File::Temp->new(
5874 template => "cpan_getsave_url_XXXX",
5878 $filename = $fh->filename;
5880 $fh = FileHandle->new;
5881 $filename = "cpan_getsave_url_$$.html";
5883 my $tmpin = $filename;
5884 if ($CPAN::META->has_usable('LWP')) {
5885 $CPAN::Frontend->myprint("Fetching with LWP:
5889 CPAN::LWP::UserAgent->config;
5890 eval { $Ua = CPAN::LWP::UserAgent->new; };
5892 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
5896 $Ua->proxy('http', $var)
5897 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
5899 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
5902 my $req = HTTP::Request->new(GET => $url);
5903 $req->header('Accept' => 'text/html');
5904 my $res = $Ua->request($req);
5905 if ($res->is_success) {
5906 $CPAN::Frontend->myprint(" + request successful.\n")
5908 print $fh $res->content;
5910 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
5914 $CPAN::Frontend->myprint(sprintf(
5915 "LWP failed with code[%s], message[%s]\n",
5922 $CPAN::Frontend->myprint("LWP not available\n");
5927 # sub CPAN::Distribution::_build_command
5928 sub _build_command {
5930 if ($^O eq "MSWin32") { # special code needed at least up to
5931 # Module::Build 0.2611 and 0.2706; a fix
5932 # in M:B has been promised 2006-01-30
5933 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
5934 return "$perl ./Build";
5939 package CPAN::Bundle;
5944 $CPAN::Frontend->myprint($self->as_string);
5949 delete $self->{later};
5950 for my $c ( $self->contains ) {
5951 my $obj = CPAN::Shell->expandany($c) or next;
5956 # mark as dirty/clean
5957 #-> sub CPAN::Bundle::color_cmd_tmps ;
5958 sub color_cmd_tmps {
5960 my($depth) = shift || 0;
5961 my($color) = shift || 0;
5962 my($ancestors) = shift || [];
5963 # a module needs to recurse to its cpan_file, a distribution needs
5964 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
5966 return if exists $self->{incommandcolor}
5967 && $self->{incommandcolor}==$color;
5969 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
5971 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
5973 for my $c ( $self->contains ) {
5974 my $obj = CPAN::Shell->expandany($c) or next;
5975 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
5976 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
5979 delete $self->{badtestcnt};
5981 $self->{incommandcolor} = $color;
5984 #-> sub CPAN::Bundle::as_string ;
5988 # following line must be "=", not "||=" because we have a moving target
5989 $self->{INST_VERSION} = $self->inst_version;
5990 return $self->SUPER::as_string;
5993 #-> sub CPAN::Bundle::contains ;
5996 my($inst_file) = $self->inst_file || "";
5997 my($id) = $self->id;
5998 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
5999 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
6002 unless ($inst_file) {
6003 # Try to get at it in the cpan directory
6004 $self->debug("no inst_file") if $CPAN::DEBUG;
6006 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
6007 $cpan_file = $self->cpan_file;
6008 if ($cpan_file eq "N/A") {
6009 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
6010 Maybe stale symlink? Maybe removed during session? Giving up.\n");
6012 my $dist = $CPAN::META->instance('CPAN::Distribution',
6015 $self->debug("id[$dist->{ID}]") if $CPAN::DEBUG;
6016 my($todir) = $CPAN::Config->{'cpan_home'};
6017 my(@me,$from,$to,$me);
6018 @me = split /::/, $self->id;
6020 $me = File::Spec->catfile(@me);
6021 $from = $self->find_bundle_file($dist->{'build_dir'},join('/',@me));
6022 $to = File::Spec->catfile($todir,$me);
6023 File::Path::mkpath(File::Basename::dirname($to));
6024 File::Copy::copy($from, $to)
6025 or Carp::confess("Couldn't copy $from to $to: $!");
6029 my $fh = FileHandle->new;
6031 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
6033 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
6035 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
6036 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
6037 next unless $in_cont;
6042 push @result, (split " ", $_, 2)[0];
6045 delete $self->{STATUS};
6046 $self->{CONTAINS} = \@result;
6047 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
6049 $CPAN::Frontend->mywarn(qq{
6050 The bundle file "$inst_file" may be a broken
6051 bundlefile. It seems not to contain any bundle definition.
6052 Please check the file and if it is bogus, please delete it.
6053 Sorry for the inconvenience.
6059 #-> sub CPAN::Bundle::find_bundle_file
6060 # $where is in local format, $what is in unix format
6061 sub find_bundle_file {
6062 my($self,$where,$what) = @_;
6063 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
6064 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
6065 ### my $bu = File::Spec->catfile($where,$what);
6066 ### return $bu if -f $bu;
6067 my $manifest = File::Spec->catfile($where,"MANIFEST");
6068 unless (-f $manifest) {
6069 require ExtUtils::Manifest;
6070 my $cwd = CPAN::anycwd();
6071 $self->safe_chdir($where);
6072 ExtUtils::Manifest::mkmanifest();
6073 $self->safe_chdir($cwd);
6075 my $fh = FileHandle->new($manifest)
6076 or Carp::croak("Couldn't open $manifest: $!");
6078 my $bundle_filename = $what;
6079 $bundle_filename =~ s|Bundle.*/||;
6080 my $bundle_unixpath;
6083 my($file) = /(\S+)/;
6084 if ($file =~ m|\Q$what\E$|) {
6085 $bundle_unixpath = $file;
6086 # return File::Spec->catfile($where,$bundle_unixpath); # bad
6089 # retry if she managed to have no Bundle directory
6090 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
6092 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
6093 if $bundle_unixpath;
6094 Carp::croak("Couldn't find a Bundle file in $where");
6097 # needs to work quite differently from Module::inst_file because of
6098 # cpan_home/Bundle/ directory and the possibility that we have
6099 # shadowing effect. As it makes no sense to take the first in @INC for
6100 # Bundles, we parse them all for $VERSION and take the newest.
6102 #-> sub CPAN::Bundle::inst_file ;
6107 @me = split /::/, $self->id;
6110 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
6111 my $bfile = File::Spec->catfile($incdir, @me);
6112 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
6113 next unless -f $bfile;
6114 my $foundv = MM->parse_version($bfile);
6115 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
6116 $self->{INST_FILE} = $bfile;
6117 $self->{INST_VERSION} = $bestv = $foundv;
6123 #-> sub CPAN::Bundle::inst_version ;
6126 $self->inst_file; # finds INST_VERSION as side effect
6127 $self->{INST_VERSION};
6130 #-> sub CPAN::Bundle::rematein ;
6132 my($self,$meth) = @_;
6133 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
6134 my($id) = $self->id;
6135 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
6136 unless $self->inst_file || $self->cpan_file;
6138 for $s ($self->contains) {
6139 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
6140 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
6141 if ($type eq 'CPAN::Distribution') {
6142 $CPAN::Frontend->mywarn(qq{
6143 The Bundle }.$self->id.qq{ contains
6144 explicitly a file $s.
6148 # possibly noisy action:
6149 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
6150 my $obj = $CPAN::META->instance($type,$s);
6152 if ($obj->isa('CPAN::Bundle')
6154 exists $obj->{install_failed}
6156 ref($obj->{install_failed}) eq "HASH"
6158 for (keys %{$obj->{install_failed}}) {
6159 $self->{install_failed}{$_} = undef; # propagate faiure up
6162 $fail{$s} = 1; # the bundle itself may have succeeded but
6167 $success = $obj->can("uptodate") ? $obj->uptodate : 0;
6168 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
6170 delete $self->{install_failed}{$s};
6177 # recap with less noise
6178 if ( $meth eq "install" ) {
6181 my $raw = sprintf(qq{Bundle summary:
6182 The following items in bundle %s had installation problems:},
6185 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
6186 $CPAN::Frontend->myprint("\n");
6189 for $s ($self->contains) {
6191 $paragraph .= "$s ";
6192 $self->{install_failed}{$s} = undef;
6193 $reported{$s} = undef;
6196 my $report_propagated;
6197 for $s (sort keys %{$self->{install_failed}}) {
6198 next if exists $reported{$s};
6199 $paragraph .= "and the following items had problems
6200 during recursive bundle calls: " unless $report_propagated++;
6201 $paragraph .= "$s ";
6203 $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
6204 $CPAN::Frontend->myprint("\n");
6206 $self->{'install'} = 'YES';
6211 # If a bundle contains another that contains an xs_file we have here,
6212 # we just don't bother I suppose
6213 #-> sub CPAN::Bundle::xs_file
6218 #-> sub CPAN::Bundle::force ;
6219 sub force { shift->rematein('force',@_); }
6220 #-> sub CPAN::Bundle::notest ;
6221 sub notest { shift->rematein('notest',@_); }
6222 #-> sub CPAN::Bundle::get ;
6223 sub get { shift->rematein('get',@_); }
6224 #-> sub CPAN::Bundle::make ;
6225 sub make { shift->rematein('make',@_); }
6226 #-> sub CPAN::Bundle::test ;
6229 $self->{badtestcnt} ||= 0;
6230 $self->rematein('test',@_);
6232 #-> sub CPAN::Bundle::install ;
6235 $self->rematein('install',@_);
6237 #-> sub CPAN::Bundle::clean ;
6238 sub clean { shift->rematein('clean',@_); }
6240 #-> sub CPAN::Bundle::uptodate ;
6243 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
6245 foreach $c ($self->contains) {
6246 my $obj = CPAN::Shell->expandany($c);
6247 return 0 unless $obj->uptodate;
6252 #-> sub CPAN::Bundle::readme ;
6255 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
6256 No File found for bundle } . $self->id . qq{\n}), return;
6257 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
6258 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
6261 package CPAN::Module;
6265 # sub CPAN::Module::userid
6270 return $ro->{userid} || $ro->{CPAN_USERID};
6272 # sub CPAN::Module::description
6275 my $ro = $self->ro or return "";
6281 CPAN::Shell->expand("Distribution",$self->cpan_file);
6284 # sub CPAN::Module::undelay
6287 delete $self->{later};
6288 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
6293 # mark as dirty/clean
6294 #-> sub CPAN::Module::color_cmd_tmps ;
6295 sub color_cmd_tmps {
6297 my($depth) = shift || 0;
6298 my($color) = shift || 0;
6299 my($ancestors) = shift || [];
6300 # a module needs to recurse to its cpan_file
6302 return if exists $self->{incommandcolor}
6303 && $self->{incommandcolor}==$color;
6304 return if $depth>=1 && $self->uptodate;
6306 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
6308 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
6310 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
6311 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
6314 delete $self->{badtestcnt};
6316 $self->{incommandcolor} = $color;
6319 #-> sub CPAN::Module::as_glimpse ;
6323 my $class = ref($self);
6324 $class =~ s/^CPAN:://;
6328 $CPAN::Shell::COLOR_REGISTERED
6330 $CPAN::META->has_inst("Term::ANSIColor")
6334 $color_on = Term::ANSIColor::color("green");
6335 $color_off = Term::ANSIColor::color("reset");
6337 push @m, sprintf("%-8s %s%-22s%s (%s)\n",
6342 $self->distribution ? $self->distribution->pretty_id : $self->id,
6347 #-> sub CPAN::Module::dslip_status
6351 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
6352 pre-alpha alpha beta released
6354 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
6355 developer comp.lang.perl.*
6357 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
6358 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
6360 object-oriented pragma
6362 @{$stat->{P}}{qw,p g l b a o d r n,} = qw,Standard-Perl
6366 distribution_allowed
6367 restricted_distribution
6369 for my $x (qw(d s l i p)) {
6370 $stat->{$x}{' '} = 'unknown';
6371 $stat->{$x}{'?'} = 'unknown';
6374 return +{} unless $ro && $ro->{statd};
6381 DV => $stat->{D}{$ro->{statd}},
6382 SV => $stat->{S}{$ro->{stats}},
6383 LV => $stat->{L}{$ro->{statl}},
6384 IV => $stat->{I}{$ro->{stati}},
6385 PV => $stat->{P}{$ro->{statp}},
6389 #-> sub CPAN::Module::as_string ;
6393 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
6394 my $class = ref($self);
6395 $class =~ s/^CPAN:://;
6397 push @m, $class, " id = $self->{ID}\n";
6398 my $sprintf = " %-12s %s\n";
6399 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
6400 if $self->description;
6401 my $sprintf2 = " %-12s %s (%s)\n";
6403 $userid = $self->userid;
6406 if ($author = CPAN::Shell->expand('Author',$userid)) {
6409 if ($m = $author->email) {
6416 $author->fullname . $email
6420 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
6421 if $self->cpan_version;
6422 if (my $cpan_file = $self->cpan_file){
6423 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
6424 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
6425 my $upload_date = $dist->upload_date;
6427 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
6431 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
6432 my $dslip = $self->dslip_status;
6436 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
6438 my $local_file = $self->inst_file;
6439 unless ($self->{MANPAGE}) {
6441 $self->{MANPAGE} = $self->manpage_headline($local_file);
6443 # If we have already untarred it, we should look there
6444 my $dist = $CPAN::META->instance('CPAN::Distribution',
6446 # warn "dist[$dist]";
6447 # mff=manifest file; mfh=manifest handle
6452 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
6454 $mfh = FileHandle->new($mff)
6456 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
6457 my $lfre = $self->id; # local file RE
6460 my($lfl); # local file file
6462 my(@mflines) = <$mfh>;
6467 while (length($lfre)>5 and !$lfl) {
6468 ($lfl) = grep /$lfre/, @mflines;
6469 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
6472 $lfl =~ s/\s.*//; # remove comments
6473 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
6474 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
6475 # warn "lfl_abs[$lfl_abs]";
6477 $self->{MANPAGE} = $self->manpage_headline($lfl_abs);
6483 for $item (qw/MANPAGE/) {
6484 push @m, sprintf($sprintf, $item, $self->{$item})
6485 if exists $self->{$item};
6487 for $item (qw/CONTAINS/) {
6488 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
6489 if exists $self->{$item} && @{$self->{$item}};
6491 push @m, sprintf($sprintf, 'INST_FILE',
6492 $local_file || "(not installed)");
6493 push @m, sprintf($sprintf, 'INST_VERSION',
6494 $self->inst_version) if $local_file;
6498 sub manpage_headline {
6499 my($self,$local_file) = @_;
6500 my(@local_file) = $local_file;
6501 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
6502 push @local_file, $local_file;
6504 for $locf (@local_file) {
6505 next unless -f $locf;
6506 my $fh = FileHandle->new($locf)
6507 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
6511 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
6512 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
6529 #-> sub CPAN::Module::cpan_file ;
6530 # Note: also inherited by CPAN::Bundle
6533 CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
6534 unless ($self->ro) {
6535 CPAN::Index->reload;
6538 if ($ro && defined $ro->{CPAN_FILE}){
6539 return $ro->{CPAN_FILE};
6541 my $userid = $self->userid;
6543 if ($CPAN::META->exists("CPAN::Author",$userid)) {
6544 my $author = $CPAN::META->instance("CPAN::Author",
6546 my $fullname = $author->fullname;
6547 my $email = $author->email;
6548 unless (defined $fullname && defined $email) {
6549 return sprintf("Contact Author %s",
6553 return "Contact Author $fullname <$email>";
6555 return "Contact Author $userid (Email address not available)";
6563 #-> sub CPAN::Module::cpan_version ;
6569 # Can happen with modules that are not on CPAN
6572 $ro->{CPAN_VERSION} = 'undef'
6573 unless defined $ro->{CPAN_VERSION};
6574 $ro->{CPAN_VERSION};
6577 #-> sub CPAN::Module::force ;
6580 $self->{'force_update'}++;
6585 # warn "XDEBUG: set notest for Module";
6586 $self->{'notest'}++;
6589 #-> sub CPAN::Module::rematein ;
6591 my($self,$meth) = @_;
6592 $CPAN::Frontend->myprint(sprintf("Running %s for module %s\n",
6595 my $cpan_file = $self->cpan_file;
6596 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
6597 $CPAN::Frontend->mywarn(sprintf qq{
6598 The module %s isn\'t available on CPAN.
6600 Either the module has not yet been uploaded to CPAN, or it is
6601 temporary unavailable. Please contact the author to find out
6602 more about the status. Try 'i %s'.
6609 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
6610 $pack->called_for($self->id);
6611 $pack->force($meth) if exists $self->{'force_update'};
6612 $pack->notest($meth) if exists $self->{'notest'};
6617 $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
6618 $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
6619 delete $self->{'force_update'};
6620 delete $self->{'notest'};
6626 #-> sub CPAN::Module::perldoc ;
6627 sub perldoc { shift->rematein('perldoc') }
6628 #-> sub CPAN::Module::readme ;
6629 sub readme { shift->rematein('readme') }
6630 #-> sub CPAN::Module::look ;
6631 sub look { shift->rematein('look') }
6632 #-> sub CPAN::Module::cvs_import ;
6633 sub cvs_import { shift->rematein('cvs_import') }
6634 #-> sub CPAN::Module::get ;
6635 sub get { shift->rematein('get',@_) }
6636 #-> sub CPAN::Module::make ;
6637 sub make { shift->rematein('make') }
6638 #-> sub CPAN::Module::test ;
6641 $self->{badtestcnt} ||= 0;
6642 $self->rematein('test',@_);
6644 #-> sub CPAN::Module::uptodate ;
6647 my($latest) = $self->cpan_version;
6649 my($inst_file) = $self->inst_file;
6651 if (defined $inst_file) {
6652 $have = $self->inst_version;
6657 ! CPAN::Version->vgt($latest, $have)
6659 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
6660 "latest[$latest] have[$have]") if $CPAN::DEBUG;
6665 #-> sub CPAN::Module::install ;
6671 not exists $self->{'force_update'}
6673 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
6675 $self->inst_version,
6681 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
6682 $CPAN::Frontend->mywarn(qq{
6683 \n\n\n ***WARNING***
6684 The module $self->{ID} has no active maintainer.\n\n\n
6688 $self->rematein('install') if $doit;
6690 #-> sub CPAN::Module::clean ;
6691 sub clean { shift->rematein('clean') }
6693 #-> sub CPAN::Module::inst_file ;
6697 @packpath = split /::/, $self->{ID};
6698 $packpath[-1] .= ".pm";
6699 foreach $dir (@INC) {
6700 my $pmfile = File::Spec->catfile($dir,@packpath);
6708 #-> sub CPAN::Module::xs_file ;
6712 @packpath = split /::/, $self->{ID};
6713 push @packpath, $packpath[-1];
6714 $packpath[-1] .= "." . $Config::Config{'dlext'};
6715 foreach $dir (@INC) {
6716 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
6724 #-> sub CPAN::Module::inst_version ;
6727 my $parsefile = $self->inst_file or return;
6728 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
6731 $have = MM->parse_version($parsefile) || "undef";
6732 $have =~ s/^ //; # since the %vd hack these two lines here are needed
6733 $have =~ s/ $//; # trailing whitespace happens all the time
6735 # My thoughts about why %vd processing should happen here
6737 # Alt1 maintain it as string with leading v:
6738 # read index files do nothing
6739 # compare it use utility for compare
6740 # print it do nothing
6742 # Alt2 maintain it as what it is
6743 # read index files convert
6744 # compare it use utility because there's still a ">" vs "gt" issue
6745 # print it use CPAN::Version for print
6747 # Seems cleaner to hold it in memory as a string starting with a "v"
6749 # If the author of this module made a mistake and wrote a quoted
6750 # "v1.13" instead of v1.13, we simply leave it at that with the
6751 # effect that *we* will treat it like a v-tring while the rest of
6752 # perl won't. Seems sensible when we consider that any action we
6753 # could take now would just add complexity.
6755 $have = CPAN::Version->readable($have);
6757 $have =~ s/\s*//g; # stringify to float around floating point issues
6758 $have; # no stringify needed, \s* above matches always
6770 CPAN - query, download and build perl modules from CPAN sites
6776 perl -MCPAN -e shell;
6784 $mod = "Acme::Meta";
6786 CPAN::Shell->install($mod); # same thing
6787 CPAN::Shell->expandany($mod)->install; # same thing
6788 CPAN::Shell->expand("Module",$mod)->install; # same thing
6789 CPAN::Shell->expand("Module",$mod)
6790 ->distribution->install; # same thing
6794 $distro = "NWCLARK/Acme-Meta-0.01.tar.gz";
6795 install $distro; # same thing
6796 CPAN::Shell->install($distro); # same thing
6797 CPAN::Shell->expandany($distro)->install; # same thing
6798 CPAN::Shell->expand("Module",$distro)->install; # same thing
6802 This module will eventually be replaced by CPANPLUS. CPANPLUS is kind
6803 of a modern rewrite from ground up with greater extensibility and more
6804 features but no full compatibility. If you're new to CPAN.pm, you
6805 probably should investigate if CPANPLUS is the better choice for you.
6807 If you're already used to CPAN.pm you're welcome to continue using it.
6808 I intend to support it until somebody convinces me that there is a
6809 both superior and sufficiently compatible drop-in replacement.
6811 =head1 COMPATIBILITY
6813 CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
6814 newer versions. It is getting more and more difficult to get the
6815 minimal prerequisites working on older perls. It is close to
6816 impossible to get the whole Bundle::CPAN working there. If you're in
6817 the position to have only these old versions, be advised that CPAN is
6818 designed to work fine without the Bundle::CPAN installed.
6820 To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
6821 compatible with ancient perls and that File::Temp is listed as a
6822 prerequisite but CPAN has reasonable workarounds if it is missing.
6826 The CPAN module is designed to automate the make and install of perl
6827 modules and extensions. It includes some primitive searching
6828 capabilities and knows how to use Net::FTP or LWP (or some external
6829 download clients) to fetch the raw data from the net.
6831 Modules are fetched from one or more of the mirrored CPAN
6832 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
6835 The CPAN module also supports the concept of named and versioned
6836 I<bundles> of modules. Bundles simplify the handling of sets of
6837 related modules. See Bundles below.
6839 The package contains a session manager and a cache manager. There is
6840 no status retained between sessions. The session manager keeps track
6841 of what has been fetched, built and installed in the current
6842 session. The cache manager keeps track of the disk space occupied by
6843 the make processes and deletes excess space according to a simple FIFO
6846 All methods provided are accessible in a programmer style and in an
6847 interactive shell style.
6849 =head2 Interactive Mode
6851 The interactive mode is entered by running
6853 perl -MCPAN -e shell
6855 which puts you into a readline interface. You will have the most fun if
6856 you install Term::ReadKey and Term::ReadLine to enjoy both history and
6859 Once you are on the command line, type 'h' and the rest should be
6862 The function call C<shell> takes two optional arguments, one is the
6863 prompt, the second is the default initial command line (the latter
6864 only works if a real ReadLine interface module is installed).
6866 The most common uses of the interactive modes are
6870 =item Searching for authors, bundles, distribution files and modules
6872 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
6873 for each of the four categories and another, C<i> for any of the
6874 mentioned four. Each of the four entities is implemented as a class
6875 with slightly differing methods for displaying an object.
6877 Arguments you pass to these commands are either strings exactly matching
6878 the identification string of an object or regular expressions that are
6879 then matched case-insensitively against various attributes of the
6880 objects. The parser recognizes a regular expression only if you
6881 enclose it between two slashes.
6883 The principle is that the number of found objects influences how an
6884 item is displayed. If the search finds one item, the result is
6885 displayed with the rather verbose method C<as_string>, but if we find
6886 more than one, we display each object with the terse method
6889 =item make, test, install, clean modules or distributions
6891 These commands take any number of arguments and investigate what is
6892 necessary to perform the action. If the argument is a distribution
6893 file name (recognized by embedded slashes), it is processed. If it is
6894 a module, CPAN determines the distribution file in which this module
6895 is included and processes that, following any dependencies named in
6896 the module's META.yml or Makefile.PL (this behavior is controlled by
6897 the configuration parameter C<prerequisites_policy>.)
6899 Any C<make> or C<test> are run unconditionally. An
6901 install <distribution_file>
6903 also is run unconditionally. But for
6907 CPAN checks if an install is actually needed for it and prints
6908 I<module up to date> in the case that the distribution file containing
6909 the module doesn't need to be updated.
6911 CPAN also keeps track of what it has done within the current session
6912 and doesn't try to build a package a second time regardless if it
6913 succeeded or not. The C<force> pragma may precede another command
6914 (currently: C<make>, C<test>, or C<install>) and executes the
6915 command from scratch and tries to continue in case of some errors.
6919 cpan> install OpenGL
6920 OpenGL is up to date.
6921 cpan> force install OpenGL
6924 OpenGL-0.4/COPYRIGHT
6927 The C<notest> pragma may be set to skip the test part in the build
6932 cpan> notest install Tk
6934 A C<clean> command results in a
6938 being executed within the distribution file's working directory.
6940 =item get, readme, perldoc, look module or distribution
6942 C<get> downloads a distribution file without further action. C<readme>
6943 displays the README file of the associated distribution. C<Look> gets
6944 and untars (if not yet done) the distribution file, changes to the
6945 appropriate directory and opens a subshell process in that directory.
6946 C<perldoc> displays the pod documentation of the module in html or
6951 =item ls globbing_expression
6953 The first form lists all distribution files in and below an author's
6954 CPAN directory as they are stored in the CHECKUMS files distributed on
6955 CPAN. The listing goes recursive into all subdirectories.
6957 The second form allows to limit or expand the output with shell
6958 globbing as in the following examples:
6964 The last example is very slow and outputs extra progress indicators
6965 that break the alignment of the result.
6967 Note that globbing only lists directories explicitly asked for, for
6968 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
6969 regarded as a bug and may be changed in future versions.
6973 The C<failed> command reports all distributions that failed on one of
6974 C<make>, C<test> or C<install> for some reason in the currently
6975 running shell session.
6979 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>
6980 (but the directory can be configured via the C<cpan_home> config
6981 variable). The shell is a bit picky if you try to start another CPAN
6982 session. It dies immediately if there is a lockfile and the lock seems
6983 to belong to a running process. In case you want to run a second shell
6984 session, it is probably safest to maintain another directory, say
6985 C<~/.cpan-for-X/> and a C<~/.cpan-for-X/CPAN/MyConfig.pm> that
6986 contains the configuration options. Then you can start the second
6989 perl -I ~/.cpan-for-X -MCPAN::MyConfig -MCPAN -e shell
6993 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
6994 in the cpan-shell it is intended that you can press C<^C> anytime and
6995 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
6996 to clean up and leave the shell loop. You can emulate the effect of a
6997 SIGTERM by sending two consecutive SIGINTs, which usually means by
6998 pressing C<^C> twice.
7000 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
7001 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
7002 Build.PL> subprocess.
7008 The commands that are available in the shell interface are methods in
7009 the package CPAN::Shell. If you enter the shell command, all your
7010 input is split by the Text::ParseWords::shellwords() routine which
7011 acts like most shells do. The first word is being interpreted as the
7012 method to be called and the rest of the words are treated as arguments
7013 to this method. Continuation lines are supported if a line ends with a
7018 C<autobundle> writes a bundle file into the
7019 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
7020 a list of all modules that are both available from CPAN and currently
7021 installed within @INC. The name of the bundle file is based on the
7022 current date and a counter.
7026 recompile() is a very special command in that it takes no argument and
7027 runs the make/test/install cycle with brute force over all installed
7028 dynamically loadable extensions (aka XS modules) with 'force' in
7029 effect. The primary purpose of this command is to finish a network
7030 installation. Imagine, you have a common source tree for two different
7031 architectures. You decide to do a completely independent fresh
7032 installation. You start on one architecture with the help of a Bundle
7033 file produced earlier. CPAN installs the whole Bundle for you, but
7034 when you try to repeat the job on the second architecture, CPAN
7035 responds with a C<"Foo up to date"> message for all modules. So you
7036 invoke CPAN's recompile on the second architecture and you're done.
7038 Another popular use for C<recompile> is to act as a rescue in case your
7039 perl breaks binary compatibility. If one of the modules that CPAN uses
7040 is in turn depending on binary compatibility (so you cannot run CPAN
7041 commands), then you should try the CPAN::Nox module for recovery.
7045 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
7046 directory so that you can save your own preferences instead of the
7049 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
7051 Although it may be considered internal, the class hierarchy does matter
7052 for both users and programmer. CPAN.pm deals with above mentioned four
7053 classes, and all those classes share a set of methods. A classical
7054 single polymorphism is in effect. A metaclass object registers all
7055 objects of all kinds and indexes them with a string. The strings
7056 referencing objects have a separated namespace (well, not completely
7061 words containing a "/" (slash) Distribution
7062 words starting with Bundle:: Bundle
7063 everything else Module or Author
7065 Modules know their associated Distribution objects. They always refer
7066 to the most recent official release. Developers may mark their releases
7067 as unstable development versions (by inserting an underbar into the
7068 module version number which will also be reflected in the distribution
7069 name when you run 'make dist'), so the really hottest and newest
7070 distribution is not always the default. If a module Foo circulates
7071 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
7072 way to install version 1.23 by saying
7076 This would install the complete distribution file (say
7077 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
7078 like to install version 1.23_90, you need to know where the
7079 distribution file resides on CPAN relative to the authors/id/
7080 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
7081 so you would have to say
7083 install BAR/Foo-1.23_90.tar.gz
7085 The first example will be driven by an object of the class
7086 CPAN::Module, the second by an object of class CPAN::Distribution.
7088 =head2 Programmer's interface
7090 If you do not enter the shell, the available shell commands are both
7091 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
7092 functions in the calling package (C<install(...)>).
7094 There's currently only one class that has a stable interface -
7095 CPAN::Shell. All commands that are available in the CPAN shell are
7096 methods of the class CPAN::Shell. Each of the commands that produce
7097 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
7098 the IDs of all modules within the list.
7102 =item expand($type,@things)
7104 The IDs of all objects available within a program are strings that can
7105 be expanded to the corresponding real objects with the
7106 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
7107 list of CPAN::Module objects according to the C<@things> arguments
7108 given. In scalar context it only returns the first element of the
7111 =item expandany(@things)
7113 Like expand, but returns objects of the appropriate type, i.e.
7114 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
7115 CPAN::Distribution objects for distributions. Note: it does not expand
7116 to CPAN::Author objects.
7118 =item Programming Examples
7120 This enables the programmer to do operations that combine
7121 functionalities that are available in the shell.
7123 # install everything that is outdated on my disk:
7124 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
7126 # install my favorite programs if necessary:
7127 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
7128 my $obj = CPAN::Shell->expand('Module',$mod);
7132 # list all modules on my disk that have no VERSION number
7133 for $mod (CPAN::Shell->expand("Module","/./")){
7134 next unless $mod->inst_file;
7135 # MakeMaker convention for undefined $VERSION:
7136 next unless $mod->inst_version eq "undef";
7137 print "No VERSION in ", $mod->id, "\n";
7140 # find out which distribution on CPAN contains a module:
7141 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
7143 Or if you want to write a cronjob to watch The CPAN, you could list
7144 all modules that need updating. First a quick and dirty way:
7146 perl -e 'use CPAN; CPAN::Shell->r;'
7148 If you don't want to get any output in the case that all modules are
7149 up to date, you can parse the output of above command for the regular
7150 expression //modules are up to date// and decide to mail the output
7151 only if it doesn't match. Ick?
7153 If you prefer to do it more in a programmer style in one single
7154 process, maybe something like this suits you better:
7156 # list all modules on my disk that have newer versions on CPAN
7157 for $mod (CPAN::Shell->expand("Module","/./")){
7158 next unless $mod->inst_file;
7159 next if $mod->uptodate;
7160 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
7161 $mod->id, $mod->inst_version, $mod->cpan_version;
7164 If that gives you too much output every day, you maybe only want to
7165 watch for three modules. You can write
7167 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
7169 as the first line instead. Or you can combine some of the above
7172 # watch only for a new mod_perl module
7173 $mod = CPAN::Shell->expand("Module","mod_perl");
7174 exit if $mod->uptodate;
7175 # new mod_perl arrived, let me know all update recommendations
7180 =head2 Methods in the other Classes
7182 The programming interface for the classes CPAN::Module,
7183 CPAN::Distribution, CPAN::Bundle, and CPAN::Author is still considered
7184 beta and partially even alpha. In the following paragraphs only those
7185 methods are documented that have proven useful over a longer time and
7186 thus are unlikely to change.
7190 =item CPAN::Author::as_glimpse()
7192 Returns a one-line description of the author
7194 =item CPAN::Author::as_string()
7196 Returns a multi-line description of the author
7198 =item CPAN::Author::email()
7200 Returns the author's email address
7202 =item CPAN::Author::fullname()
7204 Returns the author's name
7206 =item CPAN::Author::name()
7208 An alias for fullname
7210 =item CPAN::Bundle::as_glimpse()
7212 Returns a one-line description of the bundle
7214 =item CPAN::Bundle::as_string()
7216 Returns a multi-line description of the bundle
7218 =item CPAN::Bundle::clean()
7220 Recursively runs the C<clean> method on all items contained in the bundle.
7222 =item CPAN::Bundle::contains()
7224 Returns a list of objects' IDs contained in a bundle. The associated
7225 objects may be bundles, modules or distributions.
7227 =item CPAN::Bundle::force($method,@args)
7229 Forces CPAN to perform a task that normally would have failed. Force
7230 takes as arguments a method name to be called and any number of
7231 additional arguments that should be passed to the called method. The
7232 internals of the object get the needed changes so that CPAN.pm does
7233 not refuse to take the action. The C<force> is passed recursively to
7234 all contained objects.
7236 =item CPAN::Bundle::get()
7238 Recursively runs the C<get> method on all items contained in the bundle
7240 =item CPAN::Bundle::inst_file()
7242 Returns the highest installed version of the bundle in either @INC or
7243 C<$CPAN::Config->{cpan_home}>. Note that this is different from
7244 CPAN::Module::inst_file.
7246 =item CPAN::Bundle::inst_version()
7248 Like CPAN::Bundle::inst_file, but returns the $VERSION
7250 =item CPAN::Bundle::uptodate()
7252 Returns 1 if the bundle itself and all its members are uptodate.
7254 =item CPAN::Bundle::install()
7256 Recursively runs the C<install> method on all items contained in the bundle
7258 =item CPAN::Bundle::make()
7260 Recursively runs the C<make> method on all items contained in the bundle
7262 =item CPAN::Bundle::readme()
7264 Recursively runs the C<readme> method on all items contained in the bundle
7266 =item CPAN::Bundle::test()
7268 Recursively runs the C<test> method on all items contained in the bundle
7270 =item CPAN::Distribution::as_glimpse()
7272 Returns a one-line description of the distribution
7274 =item CPAN::Distribution::as_string()
7276 Returns a multi-line description of the distribution
7278 =item CPAN::Distribution::author
7280 Returns the CPAN::Author object of the maintainer who uploaded this
7283 =item CPAN::Distribution::clean()
7285 Changes to the directory where the distribution has been unpacked and
7286 runs C<make clean> there.
7288 =item CPAN::Distribution::containsmods()
7290 Returns a list of IDs of modules contained in a distribution file.
7291 Only works for distributions listed in the 02packages.details.txt.gz
7292 file. This typically means that only the most recent version of a
7293 distribution is covered.
7295 =item CPAN::Distribution::cvs_import()
7297 Changes to the directory where the distribution has been unpacked and
7300 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
7304 =item CPAN::Distribution::dir()
7306 Returns the directory into which this distribution has been unpacked.
7308 =item CPAN::Distribution::force($method,@args)
7310 Forces CPAN to perform a task that normally would have failed. Force
7311 takes as arguments a method name to be called and any number of
7312 additional arguments that should be passed to the called method. The
7313 internals of the object get the needed changes so that CPAN.pm does
7314 not refuse to take the action.
7316 =item CPAN::Distribution::get()
7318 Downloads the distribution from CPAN and unpacks it. Does nothing if
7319 the distribution has already been downloaded and unpacked within the
7322 =item CPAN::Distribution::install()
7324 Changes to the directory where the distribution has been unpacked and
7325 runs the external command C<make install> there. If C<make> has not
7326 yet been run, it will be run first. A C<make test> will be issued in
7327 any case and if this fails, the install will be canceled. The
7328 cancellation can be avoided by letting C<force> run the C<install> for
7331 =item CPAN::Distribution::isa_perl()
7333 Returns 1 if this distribution file seems to be a perl distribution.
7334 Normally this is derived from the file name only, but the index from
7335 CPAN can contain a hint to achieve a return value of true for other
7338 =item CPAN::Distribution::look()
7340 Changes to the directory where the distribution has been unpacked and
7341 opens a subshell there. Exiting the subshell returns.
7343 =item CPAN::Distribution::make()
7345 First runs the C<get> method to make sure the distribution is
7346 downloaded and unpacked. Changes to the directory where the
7347 distribution has been unpacked and runs the external commands C<perl
7348 Makefile.PL> or C<perl Build.PL> and C<make> there.
7350 =item CPAN::Distribution::perldoc()
7352 Downloads the pod documentation of the file associated with a
7353 distribution (in html format) and runs it through the external
7354 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
7355 isn't available, it converts it to plain text with external
7356 command html2text and runs it through the pager specified
7357 in C<$CPAN::Config->{pager}>
7359 =item CPAN::Distribution::prereq_pm()
7361 Returns the hash reference that has been announced by a distribution
7362 as the merge of the C<requires> element and the C<build_requires>
7363 element of the META.yml or the C<PREREQ_PM> hash in the
7364 C<Makefile.PL>. Note: works only after an attempt has been made to
7365 C<make> the distribution. Returns undef otherwise.
7367 =item CPAN::Distribution::readme()
7369 Downloads the README file associated with a distribution and runs it
7370 through the pager specified in C<$CPAN::Config->{pager}>.
7372 =item CPAN::Distribution::read_yaml()
7374 Returns the content of the META.yml of this distro as a hashref. Note:
7375 works only after an attempt has been made to C<make> the distribution.
7376 Returns undef otherwise.
7378 =item CPAN::Distribution::test()
7380 Changes to the directory where the distribution has been unpacked and
7381 runs C<make test> there.
7383 =item CPAN::Distribution::uptodate()
7385 Returns 1 if all the modules contained in the distribution are
7386 uptodate. Relies on containsmods.
7388 =item CPAN::Index::force_reload()
7390 Forces a reload of all indices.
7392 =item CPAN::Index::reload()
7394 Reloads all indices if they have not been read for more than
7395 C<$CPAN::Config->{index_expire}> days.
7397 =item CPAN::InfoObj::dump()
7399 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
7400 inherit this method. It prints the data structure associated with an
7401 object. Useful for debugging. Note: the data structure is considered
7402 internal and thus subject to change without notice.
7404 =item CPAN::Module::as_glimpse()
7406 Returns a one-line description of the module
7408 =item CPAN::Module::as_string()
7410 Returns a multi-line description of the module
7412 =item CPAN::Module::clean()
7414 Runs a clean on the distribution associated with this module.
7416 =item CPAN::Module::cpan_file()
7418 Returns the filename on CPAN that is associated with the module.
7420 =item CPAN::Module::cpan_version()
7422 Returns the latest version of this module available on CPAN.
7424 =item CPAN::Module::cvs_import()
7426 Runs a cvs_import on the distribution associated with this module.
7428 =item CPAN::Module::description()
7430 Returns a 44 character description of this module. Only available for
7431 modules listed in The Module List (CPAN/modules/00modlist.long.html
7432 or 00modlist.long.txt.gz)
7434 =item CPAN::Module::distribution()
7436 Returns the CPAN::Distribution object that contains the current
7437 version of this module.
7439 =item CPAN::Module::dslip_status()
7441 Returns a hash reference. The keys of the hash are the letters C<D>,
7442 C<S>, C<L>, C<I>, and <P>, for development status, support level,
7443 language, interface and public licence respectively. The data for the
7444 DSLIP status are collected by pause.perl.org when authors register
7445 their namespaces. The values of the 5 hash elements are one-character
7446 words whose meaning is described in the table below. There are also 5
7447 hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
7448 verbose value of the 5 status variables.
7450 Where the 'DSLIP' characters have the following meanings:
7452 D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
7453 i - Idea, listed to gain consensus or as a placeholder
7454 c - under construction but pre-alpha (not yet released)
7455 a/b - Alpha/Beta testing
7457 M - Mature (no rigorous definition)
7458 S - Standard, supplied with Perl 5
7463 u - Usenet newsgroup comp.lang.perl.modules
7464 n - None known, try comp.lang.perl.modules
7465 a - abandoned; volunteers welcome to take over maintainance
7468 p - Perl-only, no compiler needed, should be platform independent
7469 c - C and perl, a C compiler will be needed
7470 h - Hybrid, written in perl with optional C code, no compiler needed
7471 + - C++ and perl, a C++ compiler will be needed
7472 o - perl and another language other than C or C++
7475 f - plain Functions, no references used
7476 h - hybrid, object and function interfaces available
7477 n - no interface at all (huh?)
7478 r - some use of unblessed References or ties
7479 O - Object oriented using blessed references and/or inheritance
7482 p - Standard-Perl: user may choose between GPL and Artistic
7483 g - GPL: GNU General Public License
7484 l - LGPL: "GNU Lesser General Public License" (previously known as
7485 "GNU Library General Public License")
7486 b - BSD: The BSD License
7487 a - Artistic license alone
7488 o - open source: appoved by www.opensource.org
7489 d - allows distribution without restrictions
7490 r - restricted distribtion
7491 n - no license at all
7493 =item CPAN::Module::force($method,@args)
7495 Forces CPAN to perform a task that normally would have failed. Force
7496 takes as arguments a method name to be called and any number of
7497 additional arguments that should be passed to the called method. The
7498 internals of the object get the needed changes so that CPAN.pm does
7499 not refuse to take the action.
7501 =item CPAN::Module::get()
7503 Runs a get on the distribution associated with this module.
7505 =item CPAN::Module::inst_file()
7507 Returns the filename of the module found in @INC. The first file found
7508 is reported just like perl itself stops searching @INC when it finds a
7511 =item CPAN::Module::inst_version()
7513 Returns the version number of the module in readable format.
7515 =item CPAN::Module::install()
7517 Runs an C<install> on the distribution associated with this module.
7519 =item CPAN::Module::look()
7521 Changes to the directory where the distribution associated with this
7522 module has been unpacked and opens a subshell there. Exiting the
7525 =item CPAN::Module::make()
7527 Runs a C<make> on the distribution associated with this module.
7529 =item CPAN::Module::manpage_headline()
7531 If module is installed, peeks into the module's manpage, reads the
7532 headline and returns it. Moreover, if the module has been downloaded
7533 within this session, does the equivalent on the downloaded module even
7534 if it is not installed.
7536 =item CPAN::Module::perldoc()
7538 Runs a C<perldoc> on this module.
7540 =item CPAN::Module::readme()
7542 Runs a C<readme> on the distribution associated with this module.
7544 =item CPAN::Module::test()
7546 Runs a C<test> on the distribution associated with this module.
7548 =item CPAN::Module::uptodate()
7550 Returns 1 if the module is installed and up-to-date.
7552 =item CPAN::Module::userid()
7554 Returns the author's ID of the module.
7558 =head2 Cache Manager
7560 Currently the cache manager only keeps track of the build directory
7561 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
7562 deletes complete directories below C<build_dir> as soon as the size of
7563 all directories there gets bigger than $CPAN::Config->{build_cache}
7564 (in MB). The contents of this cache may be used for later
7565 re-installations that you intend to do manually, but will never be
7566 trusted by CPAN itself. This is due to the fact that the user might
7567 use these directories for building modules on different architectures.
7569 There is another directory ($CPAN::Config->{keep_source_where}) where
7570 the original distribution files are kept. This directory is not
7571 covered by the cache manager and must be controlled by the user. If
7572 you choose to have the same directory as build_dir and as
7573 keep_source_where directory, then your sources will be deleted with
7574 the same fifo mechanism.
7578 A bundle is just a perl module in the namespace Bundle:: that does not
7579 define any functions or methods. It usually only contains documentation.
7581 It starts like a perl module with a package declaration and a $VERSION
7582 variable. After that the pod section looks like any other pod with the
7583 only difference being that I<one special pod section> exists starting with
7588 In this pod section each line obeys the format
7590 Module_Name [Version_String] [- optional text]
7592 The only required part is the first field, the name of a module
7593 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
7594 of the line is optional. The comment part is delimited by a dash just
7595 as in the man page header.
7597 The distribution of a bundle should follow the same convention as
7598 other distributions.
7600 Bundles are treated specially in the CPAN package. If you say 'install
7601 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
7602 the modules in the CONTENTS section of the pod. You can install your
7603 own Bundles locally by placing a conformant Bundle file somewhere into
7604 your @INC path. The autobundle() command which is available in the
7605 shell interface does that for you by including all currently installed
7606 modules in a snapshot bundle file.
7608 =head2 Prerequisites
7610 If you have a local mirror of CPAN and can access all files with
7611 "file:" URLs, then you only need a perl better than perl5.003 to run
7612 this module. Otherwise Net::FTP is strongly recommended. LWP may be
7613 required for non-UNIX systems or if your nearest CPAN site is
7614 associated with a URL that is not C<ftp:>.
7616 If you have neither Net::FTP nor LWP, there is a fallback mechanism
7617 implemented for an external ftp command or for an external lynx
7620 =head2 Finding packages and VERSION
7622 This module presumes that all packages on CPAN
7628 declare their $VERSION variable in an easy to parse manner. This
7629 prerequisite can hardly be relaxed because it consumes far too much
7630 memory to load all packages into the running program just to determine
7631 the $VERSION variable. Currently all programs that are dealing with
7632 version use something like this
7634 perl -MExtUtils::MakeMaker -le \
7635 'print MM->parse_version(shift)' filename
7637 If you are author of a package and wonder if your $VERSION can be
7638 parsed, please try the above method.
7642 come as compressed or gzipped tarfiles or as zip files and contain a
7643 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
7644 without much enthusiasm).
7650 The debugging of this module is a bit complex, because we have
7651 interferences of the software producing the indices on CPAN, of the
7652 mirroring process on CPAN, of packaging, of configuration, of
7653 synchronicity, and of bugs within CPAN.pm.
7655 For code debugging in interactive mode you can try "o debug" which
7656 will list options for debugging the various parts of the code. You
7657 should know that "o debug" has built-in completion support.
7659 For data debugging there is the C<dump> command which takes the same
7660 arguments as make/test/install and outputs the object's Data::Dumper
7663 =head2 Floppy, Zip, Offline Mode
7665 CPAN.pm works nicely without network too. If you maintain machines
7666 that are not networked at all, you should consider working with file:
7667 URLs. Of course, you have to collect your modules somewhere first. So
7668 you might use CPAN.pm to put together all you need on a networked
7669 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
7670 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
7671 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
7672 with this floppy. See also below the paragraph about CD-ROM support.
7674 =head1 CONFIGURATION
7676 When the CPAN module is used for the first time, a configuration
7677 dialog tries to determine a couple of site specific options. The
7678 result of the dialog is stored in a hash reference C< $CPAN::Config >
7679 in a file CPAN/Config.pm.
7681 The default values defined in the CPAN/Config.pm file can be
7682 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
7683 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
7684 added to the search path of the CPAN module before the use() or
7685 require() statements.
7687 The configuration dialog can be started any time later again by
7688 issuing the command C< o conf init > in the CPAN shell.
7690 Currently the following keys in the hash reference $CPAN::Config are
7693 build_cache size of cache for directories to build modules
7694 build_dir locally accessible directory to build modules
7695 cache_metadata use serializer to cache metadata
7696 cpan_home local directory reserved for this package
7697 dontload_list arrayref: modules in the list will not be
7698 loaded by the CPAN::has_inst() routine
7700 gzip location of external program gzip
7701 histfile file to maintain history between sessions
7702 histsize maximum number of lines to keep in histfile
7703 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
7704 after this many seconds inactivity. Set to 0 to
7706 index_expire after this many days refetch index files
7707 inhibit_startup_message
7708 if true, does not print the startup message
7709 keep_source_where directory in which to keep the source (if we do)
7710 make location of external make program
7711 make_arg arguments that should always be passed to 'make'
7712 make_install_make_command
7713 the make command for running 'make install', for
7715 make_install_arg same as make_arg for 'make install'
7716 makepl_arg arguments passed to 'perl Makefile.PL'
7717 mbuild_arg arguments passed to './Build'
7718 mbuild_install_arg arguments passed to './Build install'
7719 mbuild_install_build_command
7720 command to use instead of './Build' when we are
7721 in the install stage, for example 'sudo ./Build'
7722 mbuildpl_arg arguments passed to 'perl Build.PL'
7723 pager location of external program more (or any pager)
7724 prefer_installer legal values are MB and EUMM: if a module comes
7725 with both a Makefile.PL and a Build.PL, use the
7726 former (EUMM) or the latter (MB); if the module
7727 comes with only one of the two, that one will be
7729 prerequisites_policy
7730 what to do if you are missing module prerequisites
7731 ('follow' automatically, 'ask' me, or 'ignore')
7732 proxy_user username for accessing an authenticating proxy
7733 proxy_pass password for accessing an authenticating proxy
7734 scan_cache controls scanning of cache ('atstart' or 'never')
7735 tar location of external program tar
7736 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
7737 (and nonsense for characters outside latin range)
7738 unzip location of external program unzip
7739 urllist arrayref to nearby CPAN sites (or equivalent locations)
7740 wait_list arrayref to a wait server to try (See CPAN::WAIT)
7741 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
7742 ftp_proxy, } the three usual variables for configuring
7743 http_proxy, } proxy requests. Both as CPAN::Config variables
7744 no_proxy } and as environment variables configurable.
7746 You can set and query each of these options interactively in the cpan
7747 shell with the command set defined within the C<o conf> command:
7751 =item C<o conf E<lt>scalar optionE<gt>>
7753 prints the current value of the I<scalar option>
7755 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
7757 Sets the value of the I<scalar option> to I<value>
7759 =item C<o conf E<lt>list optionE<gt>>
7761 prints the current value of the I<list option> in MakeMaker's
7764 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
7766 shifts or pops the array in the I<list option> variable
7768 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
7770 works like the corresponding perl commands.
7774 =head2 Not on config variable getcwd
7776 CPAN.pm changes the current working directory often and needs to
7777 determine its own current working directory. Per default it uses
7778 Cwd::cwd but if this doesn't work on your system for some reason,
7779 alternatives can be configured according to the following table:
7783 fastcwd Cwd::fastcwd
7784 backtickcwd external command cwd
7786 =head2 Note on urllist parameter's format
7788 urllist parameters are URLs according to RFC 1738. We do a little
7789 guessing if your URL is not compliant, but if you have problems with
7790 file URLs, please try the correct format. Either:
7792 file://localhost/whatever/ftp/pub/CPAN/
7796 file:///home/ftp/pub/CPAN/
7798 =head2 urllist parameter has CD-ROM support
7800 The C<urllist> parameter of the configuration table contains a list of
7801 URLs that are to be used for downloading. If the list contains any
7802 C<file> URLs, CPAN always tries to get files from there first. This
7803 feature is disabled for index files. So the recommendation for the
7804 owner of a CD-ROM with CPAN contents is: include your local, possibly
7805 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
7807 o conf urllist push file://localhost/CDROM/CPAN
7809 CPAN.pm will then fetch the index files from one of the CPAN sites
7810 that come at the beginning of urllist. It will later check for each
7811 module if there is a local copy of the most recent version.
7813 Another peculiarity of urllist is that the site that we could
7814 successfully fetch the last file from automatically gets a preference
7815 token and is tried as the first site for the next request. So if you
7816 add a new site at runtime it may happen that the previously preferred
7817 site will be tried another time. This means that if you want to disallow
7818 a site for the next transfer, it must be explicitly removed from
7823 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
7824 install foreign, unmasked, unsigned code on your machine. We compare
7825 to a checksum that comes from the net just as the distribution file
7826 itself. But we try to make it easy to add security on demand:
7828 =head2 Cryptographically signed modules
7830 Since release 1.77 CPAN.pm has been able to verify cryptographically
7831 signed module distributions using Module::Signature. The CPAN modules
7832 can be signed by their authors, thus giving more security. The simple
7833 unsigned MD5 checksums that were used before by CPAN protect mainly
7834 against accidental file corruption.
7836 You will need to have Module::Signature installed, which in turn
7837 requires that you have at least one of Crypt::OpenPGP module or the
7838 command-line F<gpg> tool installed.
7840 You will also need to be able to connect over the Internet to the public
7841 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
7845 Most functions in package CPAN are exported per default. The reason
7846 for this is that the primary use is intended for the cpan shell or for
7851 When the CPAN shell enters a subshell via the look command, it sets
7852 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
7855 When the config variable ftp_passive is set, all downloads will be run
7856 with the environment variable FTP_PASSIVE set to this value. This is
7857 in general a good idea as it influences both Net::FTP and LWP based
7858 connections. The same effect can be achieved by starting the cpan
7859 shell with this environment variable set. For Net::FTP alone, one can
7860 also always set passive mode by running libnetcfg.
7862 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
7864 Populating a freshly installed perl with my favorite modules is pretty
7865 easy if you maintain a private bundle definition file. To get a useful
7866 blueprint of a bundle definition file, the command autobundle can be used
7867 on the CPAN shell command line. This command writes a bundle definition
7868 file for all modules that are installed for the currently running perl
7869 interpreter. It's recommended to run this command only once and from then
7870 on maintain the file manually under a private name, say
7871 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
7873 cpan> install Bundle::my_bundle
7875 then answer a few questions and then go out for a coffee.
7877 Maintaining a bundle definition file means keeping track of two
7878 things: dependencies and interactivity. CPAN.pm sometimes fails on
7879 calculating dependencies because not all modules define all MakeMaker
7880 attributes correctly, so a bundle definition file should specify
7881 prerequisites as early as possible. On the other hand, it's a bit
7882 annoying that many distributions need some interactive configuring. So
7883 what I try to accomplish in my private bundle file is to have the
7884 packages that need to be configured early in the file and the gentle
7885 ones later, so I can go out after a few minutes and leave CPAN.pm
7888 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
7890 Thanks to Graham Barr for contributing the following paragraphs about
7891 the interaction between perl, and various firewall configurations. For
7892 further information on firewalls, it is recommended to consult the
7893 documentation that comes with the ncftp program. If you are unable to
7894 go through the firewall with a simple Perl setup, it is very likely
7895 that you can configure ncftp so that it works for your firewall.
7897 =head2 Three basic types of firewalls
7899 Firewalls can be categorized into three basic types.
7905 This is where the firewall machine runs a web server and to access the
7906 outside world you must do it via the web server. If you set environment
7907 variables like http_proxy or ftp_proxy to a values beginning with http://
7908 or in your web browser you have to set proxy information then you know
7909 you are running an http firewall.
7911 To access servers outside these types of firewalls with perl (even for
7912 ftp) you will need to use LWP.
7916 This where the firewall machine runs an ftp server. This kind of
7917 firewall will only let you access ftp servers outside the firewall.
7918 This is usually done by connecting to the firewall with ftp, then
7919 entering a username like "user@outside.host.com"
7921 To access servers outside these type of firewalls with perl you
7922 will need to use Net::FTP.
7924 =item One way visibility
7926 I say one way visibility as these firewalls try to make themselves look
7927 invisible to the users inside the firewall. An FTP data connection is
7928 normally created by sending the remote server your IP address and then
7929 listening for the connection. But the remote server will not be able to
7930 connect to you because of the firewall. So for these types of firewall
7931 FTP connections need to be done in a passive mode.
7933 There are two that I can think off.
7939 If you are using a SOCKS firewall you will need to compile perl and link
7940 it with the SOCKS library, this is what is normally called a 'socksified'
7941 perl. With this executable you will be able to connect to servers outside
7942 the firewall as if it is not there.
7946 This is the firewall implemented in the Linux kernel, it allows you to
7947 hide a complete network behind one IP address. With this firewall no
7948 special compiling is needed as you can access hosts directly.
7950 For accessing ftp servers behind such firewalls you usually need to
7951 set the environment variable C<FTP_PASSIVE> or the config variable
7952 ftp_passive to a true value.
7958 =head2 Configuring lynx or ncftp for going through a firewall
7960 If you can go through your firewall with e.g. lynx, presumably with a
7963 /usr/local/bin/lynx -pscott:tiger
7965 then you would configure CPAN.pm with the command
7967 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
7969 That's all. Similarly for ncftp or ftp, you would configure something
7972 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
7974 Your mileage may vary...
7982 I installed a new version of module X but CPAN keeps saying,
7983 I have the old version installed
7985 Most probably you B<do> have the old version installed. This can
7986 happen if a module installs itself into a different directory in the
7987 @INC path than it was previously installed. This is not really a
7988 CPAN.pm problem, you would have the same problem when installing the
7989 module manually. The easiest way to prevent this behaviour is to add
7990 the argument C<UNINST=1> to the C<make install> call, and that is why
7991 many people add this argument permanently by configuring
7993 o conf make_install_arg UNINST=1
7997 So why is UNINST=1 not the default?
7999 Because there are people who have their precise expectations about who
8000 may install where in the @INC path and who uses which @INC array. In
8001 fine tuned environments C<UNINST=1> can cause damage.
8005 I want to clean up my mess, and install a new perl along with
8006 all modules I have. How do I go about it?
8008 Run the autobundle command for your old perl and optionally rename the
8009 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
8010 with the Configure option prefix, e.g.
8012 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
8014 Install the bundle file you produced in the first step with something like
8016 cpan> install Bundle::mybundle
8022 When I install bundles or multiple modules with one command
8023 there is too much output to keep track of.
8025 You may want to configure something like
8027 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
8028 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
8030 so that STDOUT is captured in a file for later inspection.
8035 I am not root, how can I install a module in a personal directory?
8037 First of all, you will want to use your own configuration, not the one
8038 that your root user installed. If you do not have permission to write
8039 in the cpan directory that root has configured, you will be asked if
8040 you want to create your own config. Answering "yes" will bring you into
8041 CPAN's configuration stage, using the system config for all defaults except
8042 things that have to do with CPAN's work directory, saving your choices to
8043 your MyConfig.pm file.
8045 You can also manually initiate this process with the following command:
8047 % perl -MCPAN -e 'mkmyconfig'
8053 from the CPAN shell.
8055 You will most probably also want to configure something like this:
8057 o conf makepl_arg "LIB=~/myperl/lib \
8058 INSTALLMAN1DIR=~/myperl/man/man1 \
8059 INSTALLMAN3DIR=~/myperl/man/man3"
8061 You can make this setting permanent like all C<o conf> settings with
8064 You will have to add ~/myperl/man to the MANPATH environment variable
8065 and also tell your perl programs to look into ~/myperl/lib, e.g. by
8068 use lib "$ENV{HOME}/myperl/lib";
8070 or setting the PERL5LIB environment variable.
8072 While we're speaking about $ENV{HOME}, it might be worth mentioning,
8073 that for Windows we use the File::HomeDir module that provides an
8074 equivalent to the concept of the home directory on Unix.
8076 Another thing you should bear in mind is that the UNINST parameter can
8077 be dnagerous when you are installing into a private area because you
8078 might accidentally remove modules that other people depend on that are
8079 not using the private area.
8083 How to get a package, unwrap it, and make a change before building it?
8085 look Sybase::Sybperl
8089 I installed a Bundle and had a couple of fails. When I
8090 retried, everything resolved nicely. Can this be fixed to work
8093 The reason for this is that CPAN does not know the dependencies of all
8094 modules when it starts out. To decide about the additional items to
8095 install, it just uses data found in the META.yml file or the generated
8096 Makefile. An undetected missing piece breaks the process. But it may
8097 well be that your Bundle installs some prerequisite later than some
8098 depending item and thus your second try is able to resolve everything.
8099 Please note, CPAN.pm does not know the dependency tree in advance and
8100 cannot sort the queue of things to install in a topologically correct
8101 order. It resolves perfectly well IF all modules declare the
8102 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
8103 the C<requires> stanza of Module::Build. For bundles which fail and
8104 you need to install often, it is recommended to sort the Bundle
8105 definition file manually.
8109 In our intranet we have many modules for internal use. How
8110 can I integrate these modules with CPAN.pm but without uploading
8111 the modules to CPAN?
8113 Have a look at the CPAN::Site module.
8117 When I run CPAN's shell, I get an error message about things in my
8118 /etc/inputrc (or ~/.inputrc) file.
8120 These are readline issues and can only be fixed by studying readline
8121 configuration on your architecture and adjusting the referenced file
8122 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
8123 and edit them. Quite often harmless changes like uppercasing or
8124 lowercasing some arguments solves the problem.
8128 Some authors have strange characters in their names.
8130 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
8131 expecting ISO-8859-1 charset, a converter can be activated by setting
8132 term_is_latin to a true value in your config file. One way of doing so
8135 cpan> o conf term_is_latin 1
8137 If other charset support is needed, please file a bugreport against
8138 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
8139 the support or maybe UTF-8 terminals become widely available.
8143 When an install fails for some reason and then I correct the error
8144 condition and retry, CPAN.pm refuses to install the module, saying
8145 C<Already tried without success>.
8147 Use the force pragma like so
8149 force install Foo::Bar
8151 This does a bit more than really needed because it untars the
8152 distribution again and runs make and test and only then install.
8154 Or, if you find this is too fast and you would prefer to do smaller
8159 first and then continue as always. C<Force get> I<forgets> previous
8166 and then 'make install' directly in the subshell.
8168 Or you leave the CPAN shell and start it again.
8170 For the really curious, by accessing internals directly, you I<could>
8172 !delete CPAN::Shell->expandany("Foo::Bar")->distribution->{install}
8174 but this is neither guaranteed to work in the future nor is it a
8179 How do I install a "DEVELOPER RELEASE" of a module?
8181 By default, CPAN will install the latest non-developer release of a module.
8182 If you want to install a dev release, you have to specify a partial path to
8183 the tarball you wish to install, like so:
8185 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
8189 How do I install a module and all its dependencies from the commandline,
8190 without being prompted for anything, despite my CPAN configuration
8193 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
8194 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
8195 asked any questions at all (assuming the modules you are installing are
8196 nice about obeying that variable as well):
8198 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
8202 I only know the usual options for ExtUtils::MakeMaker(Module::Build),
8203 how do I find out the corresponding options in
8204 Module::Build(ExtUtils::MakeMaker)?
8206 http://search.cpan.org/search?query=Module::Build::Convert
8208 http://accognoscere.org/papers/perl-module-build-convert/module-build-convert.html
8215 Please report bugs via http://rt.cpan.org/
8217 Before submitting a bug, please make sure that the traditional method
8218 of building a Perl module package from a shell by following the
8219 installation instructions of that package still works in your
8224 Andreas Koenig C<< <andk@cpan.org> >>
8228 Kawai,Takanori provides a Japanese translation of this manpage at
8229 http://member.nifty.ne.jp/hippo2000/perltips/CPAN.htm
8233 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)