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";
46 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term
47 $Signal $Suppress_readline $Frontend
48 @Defaultsites $Have_warned $Defaultdocs $Defaultrecent
51 @CPAN::ISA = qw(CPAN::Debug Exporter);
53 # note that these functions live in CPAN::Shell and get executed via
54 # AUTOLOAD when called directly
76 sub soft_chdir_with_alternatives ($);
78 #-> sub CPAN::AUTOLOAD ;
83 @EXPORT{@EXPORT} = '';
84 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
85 if (exists $EXPORT{$l}){
88 die(qq{Unknown CPAN command "$AUTOLOAD". }.
89 qq{Type ? for help.\n});
96 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
97 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
99 my $oprompt = shift || CPAN::Prompt->new;
100 my $prompt = $oprompt;
101 my $commandline = shift || "";
102 $CPAN::CurrentCommandId ||= 1;
105 unless ($Suppress_readline) {
106 require Term::ReadLine;
109 $term->ReadLine eq "Term::ReadLine::Stub"
111 $term = Term::ReadLine->new('CPAN Monitor');
113 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
114 my $attribs = $term->Attribs;
115 $attribs->{attempted_completion_function} = sub {
116 &CPAN::Complete::gnu_cpl;
119 $readline::rl_completion_function =
120 $readline::rl_completion_function = 'CPAN::Complete::cpl';
122 if (my $histfile = $CPAN::Config->{'histfile'}) {{
123 unless ($term->can("AddHistory")) {
124 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
127 my($fh) = FileHandle->new;
128 open $fh, "<$histfile" or last;
132 $term->AddHistory($_);
136 # $term->OUT is autoflushed anyway
137 for ($CPAN::Config->{term_ornaments}) {
138 $term->ornaments($_) if defined;
140 my $odef = select STDERR;
147 # no strict; # I do not recall why no strict was here (2000-09-03)
151 File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
152 File::Spec->rootdir(),
154 my $try_detect_readline;
155 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
156 my $rl_avail = $Suppress_readline ? "suppressed" :
157 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
158 "available (try 'install Bundle::CPAN')";
160 $CPAN::Frontend->myprint(
162 cpan shell -- CPAN exploration and modules installation (v%s)
169 unless $CPAN::Config->{'inhibit_startup_message'} ;
170 my($continuation) = "";
171 SHELLCOMMAND: while () {
172 if ($Suppress_readline) {
174 last SHELLCOMMAND unless defined ($_ = <> );
177 last SHELLCOMMAND unless
178 defined ($_ = $term->readline($prompt, $commandline));
180 $_ = "$continuation$_" if $continuation;
182 next SHELLCOMMAND if /^$/;
183 $_ = 'h' if /^\s*\?/;
184 if (/^(?:q(?:uit)?|bye|exit)$/i) {
195 use vars qw($import_done);
196 CPAN->import(':DEFAULT') unless $import_done++;
197 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
204 if ($] < 5.00322) { # parsewords had a bug until recently
207 eval { @line = Text::ParseWords::shellwords($_) };
208 warn($@), next SHELLCOMMAND if $@;
209 warn("Text::Parsewords could not parse the line [$_]"),
210 next SHELLCOMMAND unless @line;
212 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
213 my $command = shift @line;
214 eval { CPAN::Shell->$command(@line) };
216 if ($command =~ /^(make|test|install|force|notest|clean|upgrade)$/) {
217 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
219 soft_chdir_with_alternatives(\@cwd);
220 $CPAN::Frontend->myprint("\n");
222 $CPAN::CurrentCommandId++;
226 $commandline = ""; # I do want to be able to pass a default to
227 # shell, but on the second command I see no
230 CPAN::Queue->nullify_queue;
231 if ($try_detect_readline) {
232 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
234 $CPAN::META->has_inst("Term::ReadLine::Perl")
236 delete $INC{"Term/ReadLine.pm"};
238 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
239 require Term::ReadLine;
240 $CPAN::Frontend->myprint("\n$redef subroutines in ".
241 "Term::ReadLine redefined\n");
247 soft_chdir_with_alternatives(\@cwd);
250 sub soft_chdir_with_alternatives ($) {
252 while (not chdir $cwd->[0]) {
254 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
255 Trying to chdir to "$cwd->[1]" instead.
259 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
264 package CPAN::CacheMgr;
266 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
271 use vars qw($Ua $Thesite $ThesiteURL $Themethod);
272 @CPAN::FTP::ISA = qw(CPAN::Debug);
274 package CPAN::LWP::UserAgent;
276 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
277 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
279 package CPAN::Complete;
281 @CPAN::Complete::ISA = qw(CPAN::Debug);
282 @CPAN::Complete::COMMANDS = sort qw(
283 ! a b d h i m o q r u
307 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03);
308 @CPAN::Index::ISA = qw(CPAN::Debug);
311 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
314 package CPAN::InfoObj;
316 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
318 package CPAN::Author;
320 @CPAN::Author::ISA = qw(CPAN::InfoObj);
322 package CPAN::Distribution;
324 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
326 package CPAN::Bundle;
328 @CPAN::Bundle::ISA = qw(CPAN::Module);
330 package CPAN::Module;
332 @CPAN::Module::ISA = qw(CPAN::InfoObj);
334 package CPAN::Exception::RecursiveDependency;
336 use overload '""' => "as_string";
343 for my $dep (@$deps) {
345 last if $seen{$dep}++;
347 bless { deps => \@deps }, $class;
352 "\nRecursive dependency detected:\n " .
353 join("\n => ", @{$self->{deps}}) .
354 ".\nCannot continue.\n";
357 package CPAN::Prompt; use overload '""' => "as_string";
358 use vars qw($prompt);
360 $CPAN::CurrentCommandId ||= 0;
365 if ($CPAN::Config->{commandnumber_in_prompt}) {
366 sprintf "cpan[%d]> ", $CPAN::CurrentCommandId;
372 package CPAN::Distrostatus;
373 use overload '""' => "as_string",
376 my($class,$arg) = @_;
379 FAILED => substr($arg,0,2) eq "NO",
380 COMMANDID => $CPAN::CurrentCommandId,
383 sub commandid { shift->{COMMANDID} }
384 sub failed { shift->{FAILED} }
388 $self->{TEXT} = $set;
399 use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY $PRINT_ORNAMENTING);
400 @CPAN::Shell::ISA = qw(CPAN::Debug);
401 $COLOR_REGISTERED ||= 0;
402 $PRINT_ORNAMENTING ||= 0;
404 #-> sub CPAN::Shell::AUTOLOAD ;
406 my($autoload) = $AUTOLOAD;
407 my $class = shift(@_);
408 # warn "autoload[$autoload] class[$class]";
409 $autoload =~ s/.*:://;
410 if ($autoload =~ /^w/) {
411 if ($CPAN::META->has_inst('CPAN::WAIT')) {
412 CPAN::WAIT->$autoload(@_);
414 $CPAN::Frontend->mywarn(qq{
415 Commands starting with "w" require CPAN::WAIT to be installed.
416 Please consider installing CPAN::WAIT to use the fulltext index.
417 For this you just need to type
422 $CPAN::Frontend->mywarn(qq{Unknown shell command '$autoload @_'. }.
431 # One use of the queue is to determine if we should or shouldn't
432 # announce the availability of a new CPAN module
434 # Now we try to use it for dependency tracking. For that to happen
435 # we need to draw a dependency tree and do the leaves first. This can
436 # easily be reached by running CPAN.pm recursively, but we don't want
437 # to waste memory and run into deep recursion. So what we can do is
440 # CPAN::Queue is the package where the queue is maintained. Dependencies
441 # often have high priority and must be brought to the head of the queue,
442 # possibly by jumping the queue if they are already there. My first code
443 # attempt tried to be extremely correct. Whenever a module needed
444 # immediate treatment, I either unshifted it to the front of the queue,
445 # or, if it was already in the queue, I spliced and let it bypass the
446 # others. This became a too correct model that made it impossible to put
447 # an item more than once into the queue. Why would you need that? Well,
448 # you need temporary duplicates as the manager of the queue is a loop
451 # (1) looks at the first item in the queue without shifting it off
453 # (2) cares for the item
455 # (3) removes the item from the queue, *even if its agenda failed and
456 # even if the item isn't the first in the queue anymore* (that way
457 # protecting against never ending queues)
459 # So if an item has prerequisites, the installation fails now, but we
460 # want to retry later. That's easy if we have it twice in the queue.
462 # I also expect insane dependency situations where an item gets more
463 # than two lives in the queue. Simplest example is triggered by 'install
464 # Foo Foo Foo'. People make this kind of mistakes and I don't want to
465 # get in the way. I wanted the queue manager to be a dumb servant, not
466 # one that knows everything.
468 # Who would I tell in this model that the user wants to be asked before
469 # processing? I can't attach that information to the module object,
470 # because not modules are installed but distributions. So I'd have to
471 # tell the distribution object that it should ask the user before
472 # processing. Where would the question be triggered then? Most probably
473 # in CPAN::Distribution::rematein.
474 # Hope that makes sense, my head is a bit off:-) -- AK
481 my $self = bless { qmod => $s }, $class;
486 # CPAN::Queue::first ;
492 # CPAN::Queue::delete_first ;
494 my($class,$what) = @_;
496 for my $i (0..$#All) {
497 if ( $All[$i]->{qmod} eq $what ) {
504 # CPAN::Queue::jumpqueue ;
508 CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
509 join(",",map {$_->{qmod}} @All),
512 WHAT: for my $what (reverse @what) {
514 for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
515 CPAN->debug("i[$All[$i]]what[$what]") if $CPAN::DEBUG;
516 if ($All[$i]->{qmod} eq $what){
518 if ($jumped > 100) { # one's OK if e.g. just
519 # processing now; more are OK if
520 # user typed it several times
521 $CPAN::Frontend->mywarn(
522 qq{Object [$what] queued more than 100 times, ignoring}
528 my $obj = bless { qmod => $what }, $class;
531 CPAN->debug(sprintf("after jumpqueue All[%s] what[%s]",
532 join(",",map {$_->{qmod}} @All),
537 # CPAN::Queue::exists ;
539 my($self,$what) = @_;
540 my @all = map { $_->{qmod} } @All;
541 my $exists = grep { $_->{qmod} eq $what } @All;
542 # warn "in exists what[$what] all[@all] exists[$exists]";
546 # CPAN::Queue::delete ;
549 @All = grep { $_->{qmod} ne $mod } @All;
552 # CPAN::Queue::nullify_queue ;
562 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
564 # from here on only subs.
565 ################################################################################
567 sub suggest_myconfig () {
568 SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
569 $CPAN::Frontend->myprint("You don't seem to have a user ".
570 "configuration (MyConfig.pm) yet.\n");
571 my $new = ExtUtils::MakeMaker::prompt("Do you want to create a ".
572 "user configuration now? (Y/n)",
575 CPAN::Shell->mkmyconfig();
578 $CPAN::Frontend->mydie("OK, giving up.");
583 #-> sub CPAN::all_objects ;
585 my($mgr,$class) = @_;
586 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
587 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
589 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
591 *all = \&all_objects;
593 # Called by shell, not in batch mode. In batch mode I see no risk in
594 # having many processes updating something as installations are
595 # continually checked at runtime. In shell mode I suspect it is
596 # unintentional to open more than one shell at a time
598 #-> sub CPAN::checklock ;
601 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
602 if (-f $lockfile && -M _ > 0) {
603 my $fh = FileHandle->new($lockfile) or
604 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
605 my $otherpid = <$fh>;
606 my $otherhost = <$fh>;
608 if (defined $otherpid && $otherpid) {
611 if (defined $otherhost && $otherhost) {
614 my $thishost = hostname();
615 if (defined $otherhost && defined $thishost &&
616 $otherhost ne '' && $thishost ne '' &&
617 $otherhost ne $thishost) {
618 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
619 "reports other host $otherhost and other ".
620 "process $otherpid.\n".
621 "Cannot proceed.\n"));
623 elsif (defined $otherpid && $otherpid) {
624 return if $$ == $otherpid; # should never happen
625 $CPAN::Frontend->mywarn(
627 There seems to be running another CPAN process (pid $otherpid). Contacting...
629 if (kill 0, $otherpid) {
630 $CPAN::Frontend->mydie(qq{Other job is running.
631 You may want to kill it and delete the lockfile, maybe. On UNIX try:
635 } elsif (-w $lockfile) {
637 ExtUtils::MakeMaker::prompt
638 (qq{Other job not responding. Shall I overwrite }.
639 qq{the lockfile '$lockfile'? (Y/n)},"y");
640 $CPAN::Frontend->myexit("Ok, bye\n")
641 unless $ans =~ /^y/i;
644 qq{Lockfile '$lockfile' not writeable by you. }.
645 qq{Cannot proceed.\n}.
647 qq{ rm '$lockfile'\n}.
648 qq{ and then rerun us.\n}
652 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
653 "reports other process with ID ".
654 "$otherpid. Cannot proceed.\n"));
657 my $dotcpan = $CPAN::Config->{cpan_home};
658 eval { File::Path::mkpath($dotcpan);};
660 # A special case at least for Jarkko.
665 $symlinkcpan = readlink $dotcpan;
666 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
667 eval { File::Path::mkpath($symlinkcpan); };
671 $CPAN::Frontend->mywarn(qq{
672 Working directory $symlinkcpan created.
676 unless (-d $dotcpan) {
678 Your configuration suggests "$dotcpan" as your
679 CPAN.pm working directory. I could not create this directory due
680 to this error: $firsterror\n};
682 As "$dotcpan" is a symlink to "$symlinkcpan",
683 I tried to create that, but I failed with this error: $seconderror
686 Please make sure the directory exists and is writable.
688 $CPAN::Frontend->myprint($mess);
689 return suggest_myconfig;
691 } # $@ after eval mkpath $dotcpan
693 unless ($fh = FileHandle->new(">$lockfile")) {
694 if ($! =~ /Permission/) {
695 $CPAN::Frontend->myprint(qq{
697 Your configuration suggests that CPAN.pm should use a working
699 $CPAN::Config->{cpan_home}
700 Unfortunately we could not create the lock file
702 due to permission problems.
704 Please make sure that the configuration variable
705 \$CPAN::Config->{cpan_home}
706 points to a directory where you can write a .lock file. You can set
707 this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
710 return suggest_myconfig;
713 $fh->print($$, "\n");
714 $fh->print(hostname(), "\n");
715 $self->{LOCK} = $lockfile;
719 $CPAN::Frontend->mydie("Got SIGTERM, leaving");
724 $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
725 print "Caught SIGINT\n";
729 # From: Larry Wall <larry@wall.org>
730 # Subject: Re: deprecating SIGDIE
731 # To: perl5-porters@perl.org
732 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
734 # The original intent of __DIE__ was only to allow you to substitute one
735 # kind of death for another on an application-wide basis without respect
736 # to whether you were in an eval or not. As a global backstop, it should
737 # not be used any more lightly (or any more heavily :-) than class
738 # UNIVERSAL. Any attempt to build a general exception model on it should
739 # be politely squashed. Any bug that causes every eval {} to have to be
740 # modified should be not so politely squashed.
742 # Those are my current opinions. It is also my optinion that polite
743 # arguments degenerate to personal arguments far too frequently, and that
744 # when they do, it's because both people wanted it to, or at least didn't
745 # sufficiently want it not to.
749 # global backstop to cleanup if we should really die
750 $SIG{__DIE__} = \&cleanup;
751 $self->debug("Signal handler set.") if $CPAN::DEBUG;
754 #-> sub CPAN::DESTROY ;
756 &cleanup; # need an eval?
759 #-> sub CPAN::anycwd ;
762 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
767 sub cwd {Cwd::cwd();}
769 #-> sub CPAN::getcwd ;
770 sub getcwd {Cwd::getcwd();}
772 #-> sub CPAN::fastcwd ;
773 sub fastcwd {Cwd::fastcwd();}
775 #-> sub CPAN::backtickcwd ;
776 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
778 #-> sub CPAN::find_perl ;
780 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
781 my $pwd = $CPAN::iCwd = CPAN::anycwd();
782 my $candidate = File::Spec->catfile($pwd,$^X);
783 $perl ||= $candidate if MM->maybe_command($candidate);
786 my ($component,$perl_name);
787 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
788 PATH_COMPONENT: foreach $component (File::Spec->path(),
789 $Config::Config{'binexp'}) {
790 next unless defined($component) && $component;
791 my($abs) = File::Spec->catfile($component,$perl_name);
792 if (MM->maybe_command($abs)) {
804 #-> sub CPAN::exists ;
806 my($mgr,$class,$id) = @_;
807 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
809 ### Carp::croak "exists called without class argument" unless $class;
811 $id =~ s/:+/::/g if $class eq "CPAN::Module";
812 exists $META->{readonly}{$class}{$id} or
813 exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
816 #-> sub CPAN::delete ;
818 my($mgr,$class,$id) = @_;
819 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
820 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
823 #-> sub CPAN::has_usable
824 # has_inst is sometimes too optimistic, we should replace it with this
825 # has_usable whenever a case is given
827 my($self,$mod,$message) = @_;
828 return 1 if $HAS_USABLE->{$mod};
829 my $has_inst = $self->has_inst($mod,$message);
830 return unless $has_inst;
833 LWP => [ # we frequently had "Can't locate object
834 # method "new" via package "LWP::UserAgent" at
835 # (eval 69) line 2006
837 sub {require LWP::UserAgent},
838 sub {require HTTP::Request},
839 sub {require URI::URL},
842 sub {require Net::FTP},
843 sub {require Net::Config},
846 sub {require File::HomeDir;
847 unless (File::HomeDir->VERSION >= 0.52){
848 for ("Will not use File::HomeDir, need 0.52\n") {
849 $CPAN::Frontend->mywarn($_);
856 if ($usable->{$mod}) {
857 for my $c (0..$#{$usable->{$mod}}) {
858 my $code = $usable->{$mod}[$c];
859 my $ret = eval { &$code() };
860 $ret = "" unless defined $ret;
862 # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
867 return $HAS_USABLE->{$mod} = 1;
870 #-> sub CPAN::has_inst
872 my($self,$mod,$message) = @_;
873 Carp::croak("CPAN->has_inst() called without an argument")
875 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
876 keys %{$CPAN::Config->{dontload_hash}||{}},
877 @{$CPAN::Config->{dontload_list}||[]};
878 if (defined $message && $message eq "no" # afair only used by Nox
882 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
890 # checking %INC is wrong, because $INC{LWP} may be true
891 # although $INC{"URI/URL.pm"} may have failed. But as
892 # I really want to say "bla loaded OK", I have to somehow
894 ### warn "$file in %INC"; #debug
896 } elsif (eval { require $file }) {
897 # eval is good: if we haven't yet read the database it's
898 # perfect and if we have installed the module in the meantime,
899 # it tries again. The second require is only a NOOP returning
900 # 1 if we had success, otherwise it's retrying
902 $CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
903 if ($mod eq "CPAN::WAIT") {
904 push @CPAN::Shell::ISA, 'CPAN::WAIT';
907 } elsif ($mod eq "Net::FTP") {
908 $CPAN::Frontend->mywarn(qq{
909 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
911 install Bundle::libnet
913 }) unless $Have_warned->{"Net::FTP"}++;
915 } elsif ($mod eq "Digest::SHA"){
916 if ($Have_warned->{"Digest::SHA"}++) {
917 $CPAN::Frontend->myprint(qq{CPAN: checksum security checks disabled}.
918 qq{because Digest::SHA not installed.\n});
920 $CPAN::Frontend->myprint(qq{
921 CPAN: checksum security checks disabled because Digest::SHA not installed.
922 Please consider installing the Digest::SHA module.
927 } elsif ($mod eq "Module::Signature"){
928 if (not $CPAN::Config->{check_sigs}) {
929 # they do not want us:-(
930 } elsif (not $Have_warned->{"Module::Signature"}++) {
931 # No point in complaining unless the user can
932 # reasonably install and use it.
933 if (eval { require Crypt::OpenPGP; 1 } ||
935 defined $CPAN::Config->{'gpg'}
937 $CPAN::Config->{'gpg'} =~ /\S/
940 $CPAN::Frontend->myprint(qq{
941 CPAN: Module::Signature security checks disabled because Module::Signature
942 not installed. Please consider installing the Module::Signature module.
943 You may also need to be able to connect over the Internet to the public
944 keyservers like pgp.mit.edu (port 11371).
951 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
956 #-> sub CPAN::instance ;
958 my($mgr,$class,$id) = @_;
961 # unsafe meta access, ok?
962 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
963 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
971 #-> sub CPAN::cleanup ;
973 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
974 local $SIG{__DIE__} = '';
979 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
981 $subroutine eq '(eval)';
983 return if $ineval && !$CPAN::End;
984 return unless defined $META->{LOCK};
985 return unless -f $META->{LOCK};
987 unlink $META->{LOCK};
989 # Carp::cluck("DEBUGGING");
990 $CPAN::Frontend->mywarn("Lockfile removed.\n");
993 #-> sub CPAN::savehist
996 my($histfile,$histsize);
997 unless ($histfile = $CPAN::Config->{'histfile'}){
998 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
1001 $histsize = $CPAN::Config->{'histsize'} || 100;
1003 unless ($CPAN::term->can("GetHistory")) {
1004 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
1010 my @h = $CPAN::term->GetHistory;
1011 splice @h, 0, @h-$histsize if @h>$histsize;
1012 my($fh) = FileHandle->new;
1013 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
1014 local $\ = local $, = "\n";
1020 my($self,$what) = @_;
1021 $self->{is_tested}{$what} = 1;
1025 my($self,$what) = @_;
1026 delete $self->{is_tested}{$what};
1031 $self->{is_tested} ||= {};
1032 return unless %{$self->{is_tested}};
1033 my $env = $ENV{PERL5LIB};
1034 $env = $ENV{PERLLIB} unless defined $env;
1036 push @env, $env if defined $env and length $env;
1037 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1038 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1039 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1042 package CPAN::CacheMgr;
1045 #-> sub CPAN::CacheMgr::as_string ;
1047 eval { require Data::Dumper };
1049 return shift->SUPER::as_string;
1051 return Data::Dumper::Dumper(shift);
1055 #-> sub CPAN::CacheMgr::cachesize ;
1060 #-> sub CPAN::CacheMgr::tidyup ;
1063 return unless -d $self->{ID};
1064 while ($self->{DU} > $self->{'MAX'} ) {
1065 my($toremove) = shift @{$self->{FIFO}};
1066 $CPAN::Frontend->myprint(sprintf(
1067 "Deleting from cache".
1068 ": $toremove (%.1f>%.1f MB)\n",
1069 $self->{DU}, $self->{'MAX'})
1071 return if $CPAN::Signal;
1072 $self->force_clean_cache($toremove);
1073 return if $CPAN::Signal;
1077 #-> sub CPAN::CacheMgr::dir ;
1082 #-> sub CPAN::CacheMgr::entries ;
1084 my($self,$dir) = @_;
1085 return unless defined $dir;
1086 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1087 $dir ||= $self->{ID};
1088 my($cwd) = CPAN::anycwd();
1089 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1090 my $dh = DirHandle->new(File::Spec->curdir)
1091 or Carp::croak("Couldn't opendir $dir: $!");
1094 next if $_ eq "." || $_ eq "..";
1096 push @entries, File::Spec->catfile($dir,$_);
1098 push @entries, File::Spec->catdir($dir,$_);
1100 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1103 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1104 sort { -M $b <=> -M $a} @entries;
1107 #-> sub CPAN::CacheMgr::disk_usage ;
1109 my($self,$dir) = @_;
1110 return if exists $self->{SIZE}{$dir};
1111 return if $CPAN::Signal;
1115 unless (chmod 0755, $dir) {
1116 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1117 "permission to change the permission; cannot ".
1118 "estimate disk usage of '$dir'\n");
1119 $CPAN::Frontend->mysleep(5);
1124 $CPAN::Frontend->mywarn("Directory '$dir' has gone. Cannot continue.\n");
1125 $CPAN::Frontend->mysleep(2);
1130 $File::Find::prune++ if $CPAN::Signal;
1132 if ($^O eq 'MacOS') {
1134 my $cat = Mac::Files::FSpGetCatInfo($_);
1135 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1139 unless (chmod 0755, $_) {
1140 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1141 "the permission to change the permission; ".
1142 "can only partially estimate disk usage ".
1155 return if $CPAN::Signal;
1156 $self->{SIZE}{$dir} = $Du/1024/1024;
1157 push @{$self->{FIFO}}, $dir;
1158 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1159 $self->{DU} += $Du/1024/1024;
1163 #-> sub CPAN::CacheMgr::force_clean_cache ;
1164 sub force_clean_cache {
1165 my($self,$dir) = @_;
1166 return unless -e $dir;
1167 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1169 File::Path::rmtree($dir);
1170 $self->{DU} -= $self->{SIZE}{$dir};
1171 delete $self->{SIZE}{$dir};
1174 #-> sub CPAN::CacheMgr::new ;
1181 ID => $CPAN::Config->{'build_dir'},
1182 MAX => $CPAN::Config->{'build_cache'},
1183 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1186 File::Path::mkpath($self->{ID});
1187 my $dh = DirHandle->new($self->{ID});
1188 bless $self, $class;
1191 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1193 CPAN->debug($debug) if $CPAN::DEBUG;
1197 #-> sub CPAN::CacheMgr::scan_cache ;
1200 return if $self->{SCAN} eq 'never';
1201 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1202 unless $self->{SCAN} eq 'atstart';
1203 $CPAN::Frontend->myprint(
1204 sprintf("Scanning cache %s for sizes\n",
1207 for $e ($self->entries($self->{ID})) {
1208 next if $e eq ".." || $e eq ".";
1209 $self->disk_usage($e);
1210 return if $CPAN::Signal;
1215 package CPAN::Shell;
1218 #-> sub CPAN::Shell::h ;
1220 my($class,$about) = @_;
1221 if (defined $about) {
1222 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1224 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1225 $CPAN::Frontend->myprint(qq{
1226 Display Information $filler (ver $CPAN::VERSION)
1227 command argument description
1228 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1229 i WORD or /REGEXP/ about any of the above
1230 ls AUTHOR or GLOB about files in the author's directory
1231 (with WORD being a module, bundle or author name or a distribution
1232 name of the form AUTHOR/DISTRIBUTION)
1234 Download, Test, Make, Install...
1235 get download clean make clean
1236 make make (implies get) look open subshell in dist directory
1237 test make test (implies make) readme display these README files
1238 install make install (implies test) perldoc display POD documentation
1241 force COMMAND unconditionally do command
1242 notest COMMAND skip testing
1245 h,? display this menu ! perl-code eval a perl command
1246 r report module updates upgrade upgrade all modules
1247 o conf [opt] set and query options q quit the cpan shell
1248 reload cpan load CPAN.pm again reload index load newer indices
1249 autobundle Snapshot recent latest CPAN uploads});
1255 #-> sub CPAN::Shell::a ;
1257 my($self,@arg) = @_;
1258 # authors are always UPPERCASE
1260 $_ = uc $_ unless /=/;
1262 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1265 #-> sub CPAN::Shell::globls ;
1267 my($self,$s,$pragmas) = @_;
1268 # ls is really very different, but we had it once as an ordinary
1269 # command in the Shell (upto rev. 321) and we could not handle
1271 my(@accept,@preexpand);
1272 if ($s =~ /[\*\?\/]/) {
1273 if ($CPAN::META->has_inst("Text::Glob")) {
1274 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1275 my $rau = Text::Glob::glob_to_regex(uc $au);
1276 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1278 push @preexpand, map { $_->id . "/" . $pathglob }
1279 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1281 my $rau = Text::Glob::glob_to_regex(uc $s);
1282 push @preexpand, map { $_->id }
1283 CPAN::Shell->expand_by_method('CPAN::Author',
1288 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1291 push @preexpand, uc $s;
1294 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1295 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1300 my $silent = @accept>1;
1301 my $last_alpha = "";
1303 for my $a (@accept){
1304 my($author,$pathglob);
1305 if ($a =~ m|(.*?)/(.*)|) {
1308 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1310 $a2) or die "No author found for $a2";
1312 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1314 $a) or die "No author found for $a";
1317 my $alpha = substr $author->id, 0, 1;
1319 if ($alpha eq $last_alpha) {
1323 $last_alpha = $alpha;
1325 $CPAN::Frontend->myprint($ad);
1327 for my $pragma (@$pragmas) {
1328 if ($author->can($pragma)) {
1332 push @results, $author->ls($pathglob,$silent); # silent if
1335 for my $pragma (@$pragmas) {
1336 my $meth = "un$pragma";
1337 if ($author->can($meth)) {
1345 #-> sub CPAN::Shell::local_bundles ;
1347 my($self,@which) = @_;
1348 my($incdir,$bdir,$dh);
1349 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1350 my @bbase = "Bundle";
1351 while (my $bbase = shift @bbase) {
1352 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1353 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1354 if ($dh = DirHandle->new($bdir)) { # may fail
1356 for $entry ($dh->read) {
1357 next if $entry =~ /^\./;
1358 next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
1359 if (-d File::Spec->catdir($bdir,$entry)){
1360 push @bbase, "$bbase\::$entry";
1362 next unless $entry =~ s/\.pm(?!\n)\Z//;
1363 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1371 #-> sub CPAN::Shell::b ;
1373 my($self,@which) = @_;
1374 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1375 $self->local_bundles;
1376 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1379 #-> sub CPAN::Shell::d ;
1380 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1382 #-> sub CPAN::Shell::m ;
1383 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1385 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1388 #-> sub CPAN::Shell::i ;
1392 @args = '/./' unless @args;
1394 for my $type (qw/Bundle Distribution Module/) {
1395 push @result, $self->expand($type,@args);
1397 # Authors are always uppercase.
1398 push @result, $self->expand("Author", map { uc $_ } @args);
1400 my $result = @result == 1 ?
1401 $result[0]->as_string :
1403 "No objects found of any type for argument @args\n" :
1405 (map {$_->as_glimpse} @result),
1406 scalar @result, " items found\n",
1408 $CPAN::Frontend->myprint($result);
1411 #-> sub CPAN::Shell::o ;
1413 # CPAN::Shell::o and CPAN::Config::edit are closely related. 'o conf'
1414 # should have been called set and 'o debug' maybe 'set debug'
1416 my($self,$o_type,@o_what) = @_;
1419 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1420 if ($o_type eq 'conf') {
1421 if (!@o_what) { # print all things, "o conf"
1423 $CPAN::Frontend->myprint("\$CPAN::Config options from ");
1425 if (exists $INC{'CPAN/Config.pm'}) {
1426 push @from, $INC{'CPAN/Config.pm'};
1428 if (exists $INC{'CPAN/MyConfig.pm'}) {
1429 push @from, $INC{'CPAN/MyConfig.pm'};
1431 $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
1432 $CPAN::Frontend->myprint(":\n");
1433 for $k (sort keys %CPAN::HandleConfig::can) {
1434 $v = $CPAN::HandleConfig::can{$k};
1435 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
1437 $CPAN::Frontend->myprint("\n");
1438 for $k (sort keys %$CPAN::Config) {
1439 CPAN::HandleConfig->prettyprint($k);
1441 $CPAN::Frontend->myprint("\n");
1442 } elsif (!CPAN::HandleConfig->edit(@o_what)) {
1443 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
1446 } elsif ($o_type eq 'debug') {
1448 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1451 my($what) = shift @o_what;
1452 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1453 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1456 if ( exists $CPAN::DEBUG{$what} ) {
1457 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1458 } elsif ($what =~ /^\d/) {
1459 $CPAN::DEBUG = $what;
1460 } elsif (lc $what eq 'all') {
1462 for (values %CPAN::DEBUG) {
1465 $CPAN::DEBUG = $max;
1468 for (keys %CPAN::DEBUG) {
1469 next unless lc($_) eq lc($what);
1470 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1473 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1478 my $raw = "Valid options for debug are ".
1479 join(", ",sort(keys %CPAN::DEBUG), 'all').
1480 qq{ or a number. Completion works on the options. }.
1481 qq{Case is ignored.};
1483 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1484 $CPAN::Frontend->myprint("\n\n");
1487 $CPAN::Frontend->myprint("Options set for debugging:\n");
1489 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1490 $v = $CPAN::DEBUG{$k};
1491 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1492 if $v & $CPAN::DEBUG;
1495 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1498 $CPAN::Frontend->myprint(qq{
1500 conf set or get configuration variables
1501 debug set or get debugging options
1506 sub paintdots_onreload {
1509 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
1513 # $CPAN::Frontend->myprint(".($subr)");
1514 $CPAN::Frontend->myprint(".");
1521 #-> sub CPAN::Shell::reload ;
1523 my($self,$command,@arg) = @_;
1525 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1526 if ($command =~ /cpan/i) {
1528 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
1530 MFILE: for my $f (qw(CPAN.pm CPAN/HandleConfig.pm CPAN/FirstTime.pm CPAN/Tarzip.pm
1531 CPAN/Debug.pm CPAN/Version.pm)) {
1532 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
1533 $self->reload_this($f) or $failed++;
1535 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1536 $failed++ unless $redef;
1538 $CPAN::Frontend->mywarn("\n$failed errors during reload. You better quit ".
1541 } elsif ($command =~ /index/) {
1542 CPAN::Index->force_reload;
1544 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
1545 index re-reads the index files\n});
1551 return 1 unless $INC{$f};
1552 my $pwd = CPAN::anycwd();
1553 CPAN->debug("reloading the whole '$f' from '$INC{$f}' while pwd='$pwd'")
1556 for my $inc (@INC) {
1557 $read = File::Spec->catfile($inc,split /\//, $f);
1564 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
1567 my $fh = FileHandle->new($read) or
1568 $CPAN::Frontend->mydie("Could not open $read: $!");
1572 CPAN->debug(sprintf("evaling [%s...]\n",substr($eval,0,64)))
1582 #-> sub CPAN::Shell::mkmyconfig ;
1584 my($self, $cpanpm, %args) = @_;
1585 require CPAN::FirstTime;
1586 my $home = CPAN::HandleConfig::home;
1587 $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
1588 File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
1589 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
1590 CPAN::HandleConfig::require_myconfig_or_config;
1591 $CPAN::Config ||= {};
1596 keep_source_where => undef,
1599 CPAN::FirstTime::init($cpanpm, %args);
1602 #-> sub CPAN::Shell::_binary_extensions ;
1603 sub _binary_extensions {
1604 my($self) = shift @_;
1605 my(@result,$module,%seen,%need,$headerdone);
1606 for $module ($self->expand('Module','/./')) {
1607 my $file = $module->cpan_file;
1608 next if $file eq "N/A";
1609 next if $file =~ /^Contact Author/;
1610 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
1611 next if $dist->isa_perl;
1612 next unless $module->xs_file;
1614 $CPAN::Frontend->myprint(".");
1615 push @result, $module;
1617 # print join " | ", @result;
1618 $CPAN::Frontend->myprint("\n");
1622 #-> sub CPAN::Shell::recompile ;
1624 my($self) = shift @_;
1625 my($module,@module,$cpan_file,%dist);
1626 @module = $self->_binary_extensions();
1627 for $module (@module){ # we force now and compile later, so we
1629 $cpan_file = $module->cpan_file;
1630 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1632 $dist{$cpan_file}++;
1634 for $cpan_file (sort keys %dist) {
1635 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1636 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1638 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1639 # stop a package from recompiling,
1640 # e.g. IO-1.12 when we have perl5.003_10
1644 #-> sub CPAN::Shell::scripts ;
1646 my($self, $arg) = @_;
1647 $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n");
1649 require HTML::LinkExtor;
1650 require Sort::Versions;
1652 my $p = HTML::LinkExtor->new();
1653 my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html";
1654 unless (-f $indexfile) {
1655 $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n");
1657 $p->parse_file($indexfile);
1660 if ($arg =~ s|^/(.+)/$|$1|) {
1663 for my $l ($p->links) {
1664 my $tag = shift @$l;
1665 next unless $tag eq "a";
1667 my $href = $att{href};
1668 next unless $href =~ s|^\.\./authors/id/./../||;
1671 if ($href =~ $qrarg) {
1675 if ($href =~ /\Q$arg\E/) {
1683 # now filter for the latest version if there is more than one of a name
1689 $stems{$stem} ||= [];
1690 push @{$stems{$stem}}, $href;
1692 for (sort keys %stems) {
1694 if (@{$stems{$_}} > 1) {
1695 $highest = List::Util::reduce {
1696 Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b
1699 $highest = $stems{$_}[0];
1701 $CPAN::Frontend->myprint("$highest\n");
1705 #-> sub CPAN::Shell::upgrade ;
1707 my($self) = shift @_;
1708 $self->install($self->r);
1711 #-> sub CPAN::Shell::_u_r_common ;
1713 my($self) = shift @_;
1714 my($what) = shift @_;
1715 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1716 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
1717 $what && $what =~ /^[aru]$/;
1719 @args = '/./' unless @args;
1720 my(@result,$module,%seen,%need,$headerdone,
1721 $version_undefs,$version_zeroes);
1722 $version_undefs = $version_zeroes = 0;
1723 my $sprintf = "%s%-25s%s %9s %9s %s\n";
1724 my @expand = $self->expand('Module',@args);
1725 my $expand = scalar @expand;
1726 if (0) { # Looks like noise to me, was very useful for debugging
1727 # for metadata cache
1728 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
1730 MODULE: for $module (@expand) {
1731 my $file = $module->cpan_file;
1732 next MODULE unless defined $file; # ??
1733 $file =~ s|^./../||;
1734 my($latest) = $module->cpan_version;
1735 my($inst_file) = $module->inst_file;
1737 return if $CPAN::Signal;
1740 $have = $module->inst_version;
1741 } elsif ($what eq "r") {
1742 $have = $module->inst_version;
1744 if ($have eq "undef"){
1746 } elsif ($have == 0){
1749 next MODULE unless CPAN::Version->vgt($latest, $have);
1750 # to be pedantic we should probably say:
1751 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
1752 # to catch the case where CPAN has a version 0 and we have a version undef
1753 } elsif ($what eq "u") {
1759 } elsif ($what eq "r") {
1761 } elsif ($what eq "u") {
1765 return if $CPAN::Signal; # this is sometimes lengthy
1768 push @result, sprintf "%s %s\n", $module->id, $have;
1769 } elsif ($what eq "r") {
1770 push @result, $module->id;
1771 next MODULE if $seen{$file}++;
1772 } elsif ($what eq "u") {
1773 push @result, $module->id;
1774 next MODULE if $seen{$file}++;
1775 next MODULE if $file =~ /^Contact/;
1777 unless ($headerdone++){
1778 $CPAN::Frontend->myprint("\n");
1779 $CPAN::Frontend->myprint(sprintf(
1782 "Package namespace",
1794 $CPAN::META->has_inst("Term::ANSIColor")
1796 $module->description
1798 $color_on = Term::ANSIColor::color("green");
1799 $color_off = Term::ANSIColor::color("reset");
1801 $CPAN::Frontend->myprint(sprintf $sprintf,
1808 $need{$module->id}++;
1812 $CPAN::Frontend->myprint("No modules found for @args\n");
1813 } elsif ($what eq "r") {
1814 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
1818 if ($version_zeroes) {
1819 my $s_has = $version_zeroes > 1 ? "s have" : " has";
1820 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
1821 qq{a version number of 0\n});
1823 if ($version_undefs) {
1824 my $s_has = $version_undefs > 1 ? "s have" : " has";
1825 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
1826 qq{parseable version number\n});
1832 #-> sub CPAN::Shell::r ;
1834 shift->_u_r_common("r",@_);
1837 #-> sub CPAN::Shell::u ;
1839 shift->_u_r_common("u",@_);
1842 #-> sub CPAN::Shell::failed ;
1844 my($self,$only_id,$silent) = @_;
1846 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
1848 NAY: for my $nosayer (
1856 next unless exists $d->{$nosayer};
1858 $d->{$nosayer}->can("failed") ?
1859 $d->{$nosayer}->failed :
1860 $d->{$nosayer} =~ /^NO/
1862 next NAY if $only_id && $only_id != (
1863 $d->{$nosayer}->can("commandid")
1865 $d->{$nosayer}->commandid
1867 $CPAN::CurrentCommandId
1872 next DIST unless $failed;
1876 # " %-45s: %s %s\n",
1879 $d->{$failed}->can("failed") ?
1881 $d->{$failed}->commandid,
1884 $d->{$failed}->text,
1894 my $scope = $only_id ? "command" : "session";
1896 my $print = join "",
1897 map { sprintf " %-45s: %s %s\n", @$_[1,2,3] }
1898 sort { $a->[0] <=> $b->[0] } @failed;
1899 $CPAN::Frontend->myprint("Failed during this $scope:\n$print");
1900 } elsif (!$only_id || !$silent) {
1901 $CPAN::Frontend->myprint("Nothing failed in this $scope\n");
1905 # XXX intentionally undocumented because completely bogus, unportable,
1908 #-> sub CPAN::Shell::status ;
1911 require Devel::Size;
1912 my $ps = FileHandle->new;
1913 open $ps, "/proc/$$/status";
1916 next unless /VmSize:\s+(\d+)/;
1920 $CPAN::Frontend->mywarn(sprintf(
1921 "%-27s %6d\n%-27s %6d\n",
1925 Devel::Size::total_size($CPAN::META)/1024,
1927 for my $k (sort keys %$CPAN::META) {
1928 next unless substr($k,0,4) eq "read";
1929 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
1930 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
1931 warn sprintf " %-25s %6d %6d\n",
1933 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
1934 scalar keys %{$CPAN::META->{$k}{$k2}};
1939 #-> sub CPAN::Shell::autobundle ;
1942 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
1943 my(@bundle) = $self->_u_r_common("a",@_);
1944 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1945 File::Path::mkpath($todir);
1946 unless (-d $todir) {
1947 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
1950 my($y,$m,$d) = (localtime)[5,4,3];
1954 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
1955 my($to) = File::Spec->catfile($todir,"$me.pm");
1957 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
1958 $to = File::Spec->catfile($todir,"$me.pm");
1960 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
1962 "package Bundle::$me;\n\n",
1963 "\$VERSION = '0.01';\n\n",
1967 "Bundle::$me - Snapshot of installation on ",
1968 $Config::Config{'myhostname'},
1971 "\n\n=head1 SYNOPSIS\n\n",
1972 "perl -MCPAN -e 'install Bundle::$me'\n\n",
1973 "=head1 CONTENTS\n\n",
1974 join("\n", @bundle),
1975 "\n\n=head1 CONFIGURATION\n\n",
1977 "\n\n=head1 AUTHOR\n\n",
1978 "This Bundle has been generated automatically ",
1979 "by the autobundle routine in CPAN.pm.\n",
1982 $CPAN::Frontend->myprint("\nWrote bundle file
1986 #-> sub CPAN::Shell::expandany ;
1989 CPAN->debug("s[$s]") if $CPAN::DEBUG;
1990 if ($s =~ m|/|) { # looks like a file
1991 $s = CPAN::Distribution->normalize($s);
1992 return $CPAN::META->instance('CPAN::Distribution',$s);
1993 # Distributions spring into existence, not expand
1994 } elsif ($s =~ m|^Bundle::|) {
1995 $self->local_bundles; # scanning so late for bundles seems
1996 # both attractive and crumpy: always
1997 # current state but easy to forget
1999 return $self->expand('Bundle',$s);
2001 return $self->expand('Module',$s)
2002 if $CPAN::META->exists('CPAN::Module',$s);
2007 #-> sub CPAN::Shell::expand ;
2010 my($type,@args) = @_;
2011 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
2012 my $class = "CPAN::$type";
2013 my $methods = ['id'];
2014 for my $meth (qw(name)) {
2015 next if $] < 5.00303; # no "can"
2016 next unless $class->can($meth);
2017 push @$methods, $meth;
2019 $self->expand_by_method($class,$methods,@args);
2022 sub expand_by_method {
2024 my($class,$methods,@args) = @_;
2027 my($regex,$command);
2028 if ($arg =~ m|^/(.*)/$|) {
2030 } elsif ($arg =~ m/=/) {
2034 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
2036 defined $regex ? $regex : "UNDEFINED",
2037 defined $command ? $command : "UNDEFINED",
2039 if (defined $regex) {
2041 $CPAN::META->all_objects($class)
2044 # BUG, we got an empty object somewhere
2045 require Data::Dumper;
2046 CPAN->debug(sprintf(
2047 "Bug in CPAN: Empty id on obj[%s][%s]",
2049 Data::Dumper::Dumper($obj)
2053 for my $method (@$methods) {
2054 if ($obj->$method() =~ /$regex/i) {
2060 } elsif ($command) {
2061 die "equal sign in command disabled (immature interface), ".
2063 ! \$CPAN::Shell::ADVANCED_QUERY=1
2064 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
2065 that may go away anytime.\n"
2066 unless $ADVANCED_QUERY;
2067 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
2068 my($matchcrit) = $criterion =~ m/^~(.+)/;
2072 $CPAN::META->all_objects($class)
2074 my $lhs = $self->$method() or next; # () for 5.00503
2076 push @m, $self if $lhs =~ m/$matchcrit/;
2078 push @m, $self if $lhs eq $criterion;
2083 if ( $class eq 'CPAN::Bundle' ) {
2084 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
2085 } elsif ($class eq "CPAN::Distribution") {
2086 $xarg = CPAN::Distribution->normalize($arg);
2090 if ($CPAN::META->exists($class,$xarg)) {
2091 $obj = $CPAN::META->instance($class,$xarg);
2092 } elsif ($CPAN::META->exists($class,$arg)) {
2093 $obj = $CPAN::META->instance($class,$arg);
2100 @m = sort {$a->id cmp $b->id} @m;
2101 if ( $CPAN::DEBUG ) {
2102 my $wantarray = wantarray;
2103 my $join_m = join ",", map {$_->id} @m;
2104 $self->debug("wantarray[$wantarray]join_m[$join_m]");
2106 return wantarray ? @m : $m[0];
2109 #-> sub CPAN::Shell::format_result ;
2112 my($type,@args) = @_;
2113 @args = '/./' unless @args;
2114 my(@result) = $self->expand($type,@args);
2115 my $result = @result == 1 ?
2116 $result[0]->as_string :
2118 "No objects of type $type found for argument @args\n" :
2120 (map {$_->as_glimpse} @result),
2121 scalar @result, " items found\n",
2126 #-> sub CPAN::Shell::report_fh ;
2128 my $installation_report_fh;
2129 my $previously_noticed = 0;
2132 return $installation_report_fh if $installation_report_fh;
2133 if ($CPAN::META->has_inst("File::Temp")) {
2134 $installation_report_fh
2136 template => 'cpan_install_XXXX',
2141 unless ( $installation_report_fh ) {
2142 warn("Couldn't open installation report file; " .
2143 "no report file will be generated."
2144 ) unless $previously_noticed++;
2150 # The only reason for this method is currently to have a reliable
2151 # debugging utility that reveals which output is going through which
2152 # channel. No, I don't like the colors ;-)
2154 #-> sub CPAN::Shell::print_ornameted ;
2155 sub print_ornamented {
2156 my($self,$what,$ornament) = @_;
2158 return unless defined $what;
2160 local $| = 1; # Flush immediately
2161 if ( $CPAN::Be_Silent ) {
2162 print {report_fh()} $what;
2166 if ($CPAN::Config->{term_is_latin}){
2169 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
2171 if ($PRINT_ORNAMENTING) {
2172 unless (defined &color) {
2173 if ($CPAN::META->has_inst("Term::ANSIColor")) {
2174 import Term::ANSIColor "color";
2176 *color = sub { return "" };
2180 for $line (split /\n/, $what) {
2181 $longest = length($line) if length($line) > $longest;
2183 my $sprintf = "%-" . $longest . "s";
2185 $what =~ s/(.*\n?)//m;
2188 my($nl) = chomp $line ? "\n" : "";
2189 # print "line[$line]ornament[$ornament]sprintf[$sprintf]\n";
2190 print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
2194 # $what .= "\n"; # newlines unless $PRINT_ORNAMENTING
2200 my($self,$what) = @_;
2202 $self->print_ornamented($what, 'bold blue on_yellow');
2206 my($self,$what) = @_;
2207 $self->myprint($what);
2212 my($self,$what) = @_;
2213 $self->print_ornamented($what, 'bold red on_yellow');
2217 # my($self,$what) = @_;
2218 # $self->print_ornamented($what, 'bold red on_white');
2219 # Carp::confess "died";
2222 # only to be used for shell commands
2224 my($self,$what) = @_;
2225 $self->print_ornamented($what, 'bold red on_white');
2227 # If it is the shell, we want that the following die to be silent,
2228 # but if it is not the shell, we would need a 'die $what'. We need
2229 # to take care that only shell commands use mydie. Is this
2235 # use this only for unrecoverable errors!
2236 sub unrecoverable_error {
2237 my($self,$what) = @_;
2238 my @lines = split /\n/, $what;
2240 for my $l (@lines) {
2241 $longest = length $l if length $l > $longest;
2243 $longest = 62 if $longest > 62;
2244 for my $l (@lines) {
2250 if (length $l < 66) {
2251 $l = pack "A66 A*", $l, "<==";
2255 unshift @lines, "\n";
2256 $self->mydie(join "", @lines);
2260 my($self, $sleep) = @_;
2265 return if -t STDOUT;
2266 my $odef = select STDERR;
2273 #-> sub CPAN::Shell::rematein ;
2274 # RE-adme||MA-ke||TE-st||IN-stall
2277 my($meth,@some) = @_;
2279 while($meth =~ /^(force|notest)$/) {
2280 push @pragma, $meth;
2281 $meth = shift @some or
2282 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
2286 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
2288 # Here is the place to set "test_count" on all involved parties to
2289 # 0. We then can pass this counter on to the involved
2290 # distributions and those can refuse to test if test_count > X. In
2291 # the first stab at it we could use a 1 for "X".
2293 # But when do I reset the distributions to start with 0 again?
2294 # Jost suggested to have a random or cycling interaction ID that
2295 # we pass through. But the ID is something that is just left lying
2296 # around in addition to the counter, so I'd prefer to set the
2297 # counter to 0 now, and repeat at the end of the loop. But what
2298 # about dependencies? They appear later and are not reset, they
2299 # enter the queue but not its copy. How do they get a sensible
2302 # construct the queue
2304 STHING: foreach $s (@some) {
2307 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
2309 } elsif ($s =~ m|^/|) { # looks like a regexp
2310 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
2314 } elsif ($meth eq "ls") {
2315 $self->globls($s,\@pragma);
2318 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
2319 $obj = CPAN::Shell->expandany($s);
2322 $obj->color_cmd_tmps(0,1);
2323 CPAN::Queue->new($obj->id);
2325 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
2326 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
2327 if ($meth =~ /^(dump|ls)$/) {
2330 $CPAN::Frontend->myprint(
2332 "Don't be silly, you can't $meth ",
2340 ->myprint(qq{Warning: Cannot $meth $s, }.
2341 qq{don\'t know what it is.
2346 to find objects with matching identifiers.
2352 # queuerunner (please be warned: when I started to change the
2353 # queue to hold objects instead of names, I made one or two
2354 # mistakes and never found which. I reverted back instead)
2355 while ($s = CPAN::Queue->first) {
2358 $obj = $s; # I do not believe, we would survive if this happened
2360 $obj = CPAN::Shell->expandany($s);
2362 for my $pragma (@pragma) {
2365 ($] < 5.00303 || $obj->can($pragma))){
2366 ### compatibility with 5.003
2367 $obj->$pragma($meth); # the pragma "force" in
2368 # "CPAN::Distribution" must know
2369 # what we are intending
2372 if ($]>=5.00303 && $obj->can('called_for')) {
2373 $obj->called_for($s);
2376 qq{pragma[@pragma]meth[$meth]obj[$obj]as_string[$obj->{ID}]}
2380 CPAN::Queue->delete($s);
2382 CPAN->debug("failed");
2386 CPAN::Queue->delete_first($s);
2388 for my $obj (@qcopy) {
2389 $obj->color_cmd_tmps(0,0);
2390 delete $obj->{incommandcolor};
2394 #-> sub CPAN::Shell::recent ;
2398 CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
2403 # set up the dispatching methods
2405 for my $command (qw(
2420 *$command = sub { shift->rematein($command, @_); };
2424 package CPAN::LWP::UserAgent;
2428 return if $SETUPDONE;
2429 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2430 require LWP::UserAgent;
2431 @ISA = qw(Exporter LWP::UserAgent);
2434 $CPAN::Frontend->mywarn("LWP::UserAgent not available\n");
2438 sub get_basic_credentials {
2439 my($self, $realm, $uri, $proxy) = @_;
2440 if ($USER && $PASSWD) {
2441 return ($USER, $PASSWD);
2444 ($USER,$PASSWD) = $self->get_proxy_credentials();
2446 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
2448 return($USER,$PASSWD);
2451 sub get_proxy_credentials {
2453 my ($user, $password);
2454 if ( defined $CPAN::Config->{proxy_user} &&
2455 defined $CPAN::Config->{proxy_pass}) {
2456 $user = $CPAN::Config->{proxy_user};
2457 $password = $CPAN::Config->{proxy_pass};
2458 return ($user, $password);
2460 my $username_prompt = "\nProxy authentication needed!
2461 (Note: to permanently configure username and password run
2462 o conf proxy_user your_username
2463 o conf proxy_pass your_password
2465 ($user, $password) =
2466 _get_username_and_password_from_user($username_prompt);
2467 return ($user,$password);
2470 sub get_non_proxy_credentials {
2472 my ($user,$password);
2473 if ( defined $CPAN::Config->{username} &&
2474 defined $CPAN::Config->{password}) {
2475 $user = $CPAN::Config->{username};
2476 $password = $CPAN::Config->{password};
2477 return ($user, $password);
2479 my $username_prompt = "\nAuthentication needed!
2480 (Note: to permanently configure username and password run
2481 o conf username your_username
2482 o conf password your_password
2485 ($user, $password) =
2486 _get_username_and_password_from_user($username_prompt);
2487 return ($user,$password);
2490 sub _get_username_and_password_from_user {
2492 my $username_message = shift;
2493 my ($username,$password);
2495 ExtUtils::MakeMaker->import(qw(prompt));
2496 $username = prompt($username_message);
2497 if ($CPAN::META->has_inst("Term::ReadKey")) {
2498 Term::ReadKey::ReadMode("noecho");
2501 $CPAN::Frontend->mywarn(
2502 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
2505 $password = prompt("Password:");
2507 if ($CPAN::META->has_inst("Term::ReadKey")) {
2508 Term::ReadKey::ReadMode("restore");
2510 $CPAN::Frontend->myprint("\n\n");
2511 return ($username,$password);
2514 # mirror(): Its purpose is to deal with proxy authentication. When we
2515 # call SUPER::mirror, we relly call the mirror method in
2516 # LWP::UserAgent. LWP::UserAgent will then call
2517 # $self->get_basic_credentials or some equivalent and this will be
2518 # $self->dispatched to our own get_basic_credentials method.
2520 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2522 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2523 # although we have gone through our get_basic_credentials, the proxy
2524 # server refuses to connect. This could be a case where the username or
2525 # password has changed in the meantime, so I'm trying once again without
2526 # $USER and $PASSWD to give the get_basic_credentials routine another
2527 # chance to set $USER and $PASSWD.
2529 # mirror(): Its purpose is to deal with proxy authentication. When we
2530 # call SUPER::mirror, we relly call the mirror method in
2531 # LWP::UserAgent. LWP::UserAgent will then call
2532 # $self->get_basic_credentials or some equivalent and this will be
2533 # $self->dispatched to our own get_basic_credentials method.
2535 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2537 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2538 # although we have gone through our get_basic_credentials, the proxy
2539 # server refuses to connect. This could be a case where the username or
2540 # password has changed in the meantime, so I'm trying once again without
2541 # $USER and $PASSWD to give the get_basic_credentials routine another
2542 # chance to set $USER and $PASSWD.
2545 my($self,$url,$aslocal) = @_;
2546 my $result = $self->SUPER::mirror($url,$aslocal);
2547 if ($result->code == 407) {
2550 $result = $self->SUPER::mirror($url,$aslocal);
2558 #-> sub CPAN::FTP::ftp_get ;
2560 my($class,$host,$dir,$file,$target) = @_;
2562 qq[Going to fetch file [$file] from dir [$dir]
2563 on host [$host] as local [$target]\n]
2565 my $ftp = Net::FTP->new($host);
2567 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
2570 return 0 unless defined $ftp;
2571 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
2572 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
2573 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
2574 my $msg = $ftp->message;
2575 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
2578 unless ( $ftp->cwd($dir) ){
2579 my $msg = $ftp->message;
2580 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
2584 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
2585 unless ( $ftp->get($file,$target) ){
2586 my $msg = $ftp->message;
2587 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
2590 $ftp->quit; # it's ok if this fails
2594 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
2596 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
2597 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
2599 # > *** 1562,1567 ****
2600 # > --- 1562,1580 ----
2601 # > return 1 if substr($url,0,4) eq "file";
2602 # > return 1 unless $url =~ m|://([^/]+)|;
2604 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
2606 # > + $proxy =~ m|://([^/:]+)|;
2608 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
2609 # > + if ($noproxy) {
2610 # > + if ($host !~ /$noproxy$/) {
2611 # > + $host = $proxy;
2614 # > + $host = $proxy;
2617 # > require Net::Ping;
2618 # > return 1 unless $Net::Ping::VERSION >= 2;
2622 #-> sub CPAN::FTP::localize ;
2624 my($self,$file,$aslocal,$force) = @_;
2626 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
2627 unless defined $aslocal;
2628 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
2631 if ($^O eq 'MacOS') {
2632 # Comment by AK on 2000-09-03: Uniq short filenames would be
2633 # available in CHECKSUMS file
2634 my($name, $path) = File::Basename::fileparse($aslocal, '');
2635 if (length($name) > 31) {
2646 my $size = 31 - length($suf);
2647 while (length($name) > $size) {
2651 $aslocal = File::Spec->catfile($path, $name);
2655 if (-f $aslocal && -r _ && !($force & 1)){
2657 if ($size = -s $aslocal) {
2658 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
2661 # empty file from a previous unsuccessful attempt to download it
2663 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
2664 "could not remove.");
2669 rename $aslocal, "$aslocal.bak";
2673 my($aslocal_dir) = File::Basename::dirname($aslocal);
2674 File::Path::mkpath($aslocal_dir);
2675 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
2676 qq{directory "$aslocal_dir".
2677 I\'ll continue, but if you encounter problems, they may be due
2678 to insufficient permissions.\n}) unless -w $aslocal_dir;
2680 # Inheritance is not easier to manage than a few if/else branches
2681 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2683 CPAN::LWP::UserAgent->config;
2684 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
2686 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
2690 $Ua->proxy('ftp', $var)
2691 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
2692 $Ua->proxy('http', $var)
2693 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
2696 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
2698 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
2699 # > use ones that require basic autorization.
2701 # > Example of when I use it manually in my own stuff:
2703 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
2704 # > $req->proxy_authorization_basic("username","password");
2705 # > $res = $ua->request($req);
2709 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
2713 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
2714 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
2717 # Try the list of urls for each single object. We keep a record
2718 # where we did get a file from
2719 my(@reordered,$last);
2720 $CPAN::Config->{urllist} ||= [];
2721 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
2722 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
2723 $CPAN::Config->{urllist} = [];
2725 $last = $#{$CPAN::Config->{urllist}};
2726 if ($force & 2) { # local cpans probably out of date, don't reorder
2727 @reordered = (0..$last);
2731 (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
2733 (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
2735 defined($ThesiteURL)
2737 ($CPAN::Config->{urllist}[$b] eq $ThesiteURL)
2739 ($CPAN::Config->{urllist}[$a] eq $ThesiteURL)
2744 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
2746 @levels = qw/easy hard hardest/;
2748 @levels = qw/easy/ if $^O eq 'MacOS';
2750 local $ENV{FTP_PASSIVE} =
2751 exists $CPAN::Config->{ftp_passive} ?
2752 $CPAN::Config->{ftp_passive} : 1;
2753 for $levelno (0..$#levels) {
2754 my $level = $levels[$levelno];
2755 my $method = "host$level";
2756 my @host_seq = $level eq "easy" ?
2757 @reordered : 0..$last; # reordered has CDROM up front
2758 my @urllist = map { $CPAN::Config->{urllist}[$_] } @host_seq;
2759 for my $u (@urllist) {
2760 $u .= "/" unless substr($u,-1) eq "/";
2762 for my $u (@CPAN::Defaultsites) {
2763 push @urllist, $u unless grep { $_ eq $u } @urllist;
2765 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
2766 my $ret = $self->$method(\@urllist,$file,$aslocal);
2768 $Themethod = $level;
2770 # utime $now, $now, $aslocal; # too bad, if we do that, we
2771 # might alter a local mirror
2772 $self->debug("level[$level]") if $CPAN::DEBUG;
2776 last if $CPAN::Signal; # need to cleanup
2779 unless ($CPAN::Signal) {
2782 qq{Please check, if the URLs I found in your configuration file \(}.
2783 join(", ", @{$CPAN::Config->{urllist}}).
2784 qq{\) are valid. The urllist can be edited.},
2785 qq{E.g. with 'o conf urllist push ftp://myurl/'};
2786 $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
2788 $CPAN::Frontend->myprint("Could not fetch $file\n");
2791 rename "$aslocal.bak", $aslocal;
2792 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
2793 $self->ls($aslocal));
2799 # package CPAN::FTP;
2801 my($self,$host_seq,$file,$aslocal) = @_;
2803 HOSTEASY: for $ro_url (@$host_seq) {
2804 my $url .= "$ro_url$file";
2805 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
2806 if ($url =~ /^file:/) {
2808 if ($CPAN::META->has_inst('URI::URL')) {
2809 my $u = URI::URL->new($url);
2811 } else { # works only on Unix, is poorly constructed, but
2812 # hopefully better than nothing.
2813 # RFC 1738 says fileurl BNF is
2814 # fileurl = "file://" [ host | "localhost" ] "/" fpath
2815 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
2817 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
2818 $l =~ s|^file:||; # assume they
2822 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
2824 $self->debug("local file[$l]") if $CPAN::DEBUG;
2825 if ( -f $l && -r _) {
2826 $ThesiteURL = $ro_url;
2829 if ($l =~ /(.+)\.gz$/) {
2831 if ( -f $ungz && -r _) {
2832 $ThesiteURL = $ro_url;
2836 # Maybe mirror has compressed it?
2838 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
2839 CPAN::Tarzip->new("$l.gz")->gunzip($aslocal);
2841 $ThesiteURL = $ro_url;
2846 if ($CPAN::META->has_usable('LWP')) {
2847 $CPAN::Frontend->myprint("Fetching with LWP:
2851 CPAN::LWP::UserAgent->config;
2852 eval { $Ua = CPAN::LWP::UserAgent->new; };
2854 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
2857 my $res = $Ua->mirror($url, $aslocal);
2858 if ($res->is_success) {
2859 $ThesiteURL = $ro_url;
2861 utime $now, $now, $aslocal; # download time is more
2862 # important than upload time
2864 } elsif ($url !~ /\.gz(?!\n)\Z/) {
2865 my $gzurl = "$url.gz";
2866 $CPAN::Frontend->myprint("Fetching with LWP:
2869 $res = $Ua->mirror($gzurl, "$aslocal.gz");
2870 if ($res->is_success &&
2871 CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)
2873 $ThesiteURL = $ro_url;
2877 $CPAN::Frontend->myprint(sprintf(
2878 "LWP failed with code[%s] message[%s]\n",
2882 # Alan Burlison informed me that in firewall environments
2883 # Net::FTP can still succeed where LWP fails. So we do not
2884 # skip Net::FTP anymore when LWP is available.
2887 $CPAN::Frontend->myprint("LWP not available\n");
2889 return if $CPAN::Signal;
2890 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2891 # that's the nice and easy way thanks to Graham
2892 my($host,$dir,$getfile) = ($1,$2,$3);
2893 if ($CPAN::META->has_usable('Net::FTP')) {
2895 $CPAN::Frontend->myprint("Fetching with Net::FTP:
2898 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
2899 "aslocal[$aslocal]") if $CPAN::DEBUG;
2900 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
2901 $ThesiteURL = $ro_url;
2904 if ($aslocal !~ /\.gz(?!\n)\Z/) {
2905 my $gz = "$aslocal.gz";
2906 $CPAN::Frontend->myprint("Fetching with Net::FTP
2909 if (CPAN::FTP->ftp_get($host,
2913 CPAN::Tarzip->new($gz)->gunzip($aslocal)
2915 $ThesiteURL = $ro_url;
2922 return if $CPAN::Signal;
2926 # package CPAN::FTP;
2928 my($self,$host_seq,$file,$aslocal) = @_;
2930 # Came back if Net::FTP couldn't establish connection (or
2931 # failed otherwise) Maybe they are behind a firewall, but they
2932 # gave us a socksified (or other) ftp program...
2935 my($devnull) = $CPAN::Config->{devnull} || "";
2937 my($aslocal_dir) = File::Basename::dirname($aslocal);
2938 File::Path::mkpath($aslocal_dir);
2939 HOSTHARD: for $ro_url (@$host_seq) {
2940 my $url = "$ro_url$file";
2941 my($proto,$host,$dir,$getfile);
2943 # Courtesy Mark Conty mark_conty@cargill.com change from
2944 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2946 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
2947 # proto not yet used
2948 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
2950 next HOSTHARD; # who said, we could ftp anything except ftp?
2952 next HOSTHARD if $proto eq "file"; # file URLs would have had
2953 # success above. Likely a bogus URL
2955 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
2957 # Try the most capable first and leave ncftp* for last as it only
2959 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
2960 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
2961 next unless defined $funkyftp;
2962 next if $funkyftp =~ /^\s*$/;
2964 my($asl_ungz, $asl_gz);
2965 ($asl_ungz = $aslocal) =~ s/\.gz//;
2966 $asl_gz = "$asl_ungz.gz";
2968 my($src_switch) = "";
2970 my($stdout_redir) = " > $asl_ungz";
2972 $src_switch = " -source";
2973 } elsif ($f eq "ncftp"){
2974 $src_switch = " -c";
2975 } elsif ($f eq "wget"){
2976 $src_switch = " -O $asl_ungz";
2978 } elsif ($f eq 'curl'){
2979 $src_switch = ' -L -f -s -S --netrc-optional';
2982 if ($f eq "ncftpget"){
2983 $chdir = "cd $aslocal_dir && ";
2986 $CPAN::Frontend->myprint(
2988 Trying with "$funkyftp$src_switch" to get
2992 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
2993 $self->debug("system[$system]") if $CPAN::DEBUG;
2994 my($wstatus) = system($system);
2996 # lynx returns 0 when it fails somewhere
2998 my $content = do { local *FH; open FH, $asl_ungz or die; local $/; <FH> };
2999 if ($content =~ /^<.*<title>[45]/si) {
3000 $CPAN::Frontend->myprint(qq{
3001 No success, the file that lynx has has downloaded looks like an error message:
3004 $CPAN::Frontend->mysleep(1);
3008 $CPAN::Frontend->myprint(qq{
3009 No success, the file that lynx has has downloaded is an empty file.
3014 if ($wstatus == 0) {
3017 } elsif ($asl_ungz ne $aslocal) {
3018 # test gzip integrity
3019 if (CPAN::Tarzip->new($asl_ungz)->gtest) {
3020 # e.g. foo.tar is gzipped --> foo.tar.gz
3021 rename $asl_ungz, $aslocal;
3023 CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz);
3026 $ThesiteURL = $ro_url;
3028 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3030 -f $asl_ungz && -s _ == 0;
3031 my $gz = "$aslocal.gz";
3032 my $gzurl = "$url.gz";
3033 $CPAN::Frontend->myprint(
3035 Trying with "$funkyftp$src_switch" to get
3038 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
3039 $self->debug("system[$system]") if $CPAN::DEBUG;
3041 if (($wstatus = system($system)) == 0
3045 # test gzip integrity
3046 my $ct = CPAN::Tarzip->new($asl_gz);
3048 $ct->gunzip($aslocal);
3050 # somebody uncompressed file for us?
3051 rename $asl_ungz, $aslocal;
3053 $ThesiteURL = $ro_url;
3056 unlink $asl_gz if -f $asl_gz;
3059 my $estatus = $wstatus >> 8;
3060 my $size = -f $aslocal ?
3061 ", left\n$aslocal with size ".-s _ :
3062 "\nWarning: expected file [$aslocal] doesn't exist";
3063 $CPAN::Frontend->myprint(qq{
3064 System call "$system"
3065 returned status $estatus (wstat $wstatus)$size
3068 return if $CPAN::Signal;
3069 } # transfer programs
3073 # package CPAN::FTP;
3075 my($self,$host_seq,$file,$aslocal) = @_;
3078 my($aslocal_dir) = File::Basename::dirname($aslocal);
3079 File::Path::mkpath($aslocal_dir);
3080 my $ftpbin = $CPAN::Config->{ftp};
3081 unless (length $ftpbin && MM->maybe_command($ftpbin)) {
3082 $CPAN::Frontend->myprint("No external ftp command available\n\n");
3085 $CPAN::Frontend->myprint(qq{
3086 As a last ressort we now switch to the external ftp command '$ftpbin'
3089 Doing so often leads to problems that are hard to diagnose, even endless
3090 loops may be encountered.
3092 If you're victim of such problems, please consider unsetting the ftp
3093 config variable with
3099 $CPAN::Frontend->mysleep(4);
3100 HOSTHARDEST: for $ro_url (@$host_seq) {
3101 my $url = "$ro_url$file";
3102 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
3103 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3106 my($host,$dir,$getfile) = ($1,$2,$3);
3108 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
3109 $ctime,$blksize,$blocks) = stat($aslocal);
3110 $timestamp = $mtime ||= 0;
3111 my($netrc) = CPAN::FTP::netrc->new;
3112 my($netrcfile) = $netrc->netrc;
3113 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
3114 my $targetfile = File::Basename::basename($aslocal);
3120 map("cd $_", split /\//, $dir), # RFC 1738
3122 "get $getfile $targetfile",
3126 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
3127 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
3128 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
3130 $netrc->contains($host))) if $CPAN::DEBUG;
3131 if ($netrc->protected) {
3132 my $dialog = join "", map { " $_\n" } @dialog;
3134 if ($netrc->contains($host)) {
3135 $netrc_explain = "Relying that your .netrc entry for '$host' ".
3136 "manages the login";
3138 $netrc_explain = "Relying that your default .netrc entry ".
3139 "manages the login";
3141 $CPAN::Frontend->myprint(qq{
3142 Trying with external ftp to get
3145 Going to send the dialog
3149 $self->talk_ftp("$ftpbin$verbose $host",
3151 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3152 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3154 if ($mtime > $timestamp) {
3155 $CPAN::Frontend->myprint("GOT $aslocal\n");
3156 $ThesiteURL = $ro_url;
3159 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
3161 return if $CPAN::Signal;
3163 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
3164 qq{correctly protected.\n});
3167 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
3168 nor does it have a default entry\n");
3171 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
3172 # then and login manually to host, using e-mail as
3174 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
3178 "user anonymous $Config::Config{'cf_email'}"
3180 my $dialog = join "", map { " $_\n" } @dialog;
3181 $CPAN::Frontend->myprint(qq{
3182 Trying with external ftp to get
3184 Going to send the dialog
3188 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
3189 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3190 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3192 if ($mtime > $timestamp) {
3193 $CPAN::Frontend->myprint("GOT $aslocal\n");
3194 $ThesiteURL = $ro_url;
3197 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
3199 return if $CPAN::Signal;
3200 $CPAN::Frontend->myprint("Can't access URL $url.\n\n");
3205 # package CPAN::FTP;
3207 my($self,$command,@dialog) = @_;
3208 my $fh = FileHandle->new;
3209 $fh->open("|$command") or die "Couldn't open ftp: $!";
3210 foreach (@dialog) { $fh->print("$_\n") }
3211 $fh->close; # Wait for process to complete
3213 my $estatus = $wstatus >> 8;
3214 $CPAN::Frontend->myprint(qq{
3215 Subprocess "|$command"
3216 returned status $estatus (wstat $wstatus)
3220 # find2perl needs modularization, too, all the following is stolen
3224 my($self,$name) = @_;
3225 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
3226 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
3228 my($perms,%user,%group);
3232 $blocks = int(($blocks + 1) / 2);
3235 $blocks = int(($sizemm + 1023) / 1024);
3238 if (-f _) { $perms = '-'; }
3239 elsif (-d _) { $perms = 'd'; }
3240 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
3241 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
3242 elsif (-p _) { $perms = 'p'; }
3243 elsif (-S _) { $perms = 's'; }
3244 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
3246 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
3247 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
3248 my $tmpmode = $mode;
3249 my $tmp = $rwx[$tmpmode & 7];
3251 $tmp = $rwx[$tmpmode & 7] . $tmp;
3253 $tmp = $rwx[$tmpmode & 7] . $tmp;
3254 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
3255 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
3256 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
3259 my $user = $user{$uid} || $uid; # too lazy to implement lookup
3260 my $group = $group{$gid} || $gid;
3262 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
3264 my($moname) = $moname[$mon];
3265 if (-M _ > 365.25 / 2) {
3266 $timeyear = $year + 1900;
3269 $timeyear = sprintf("%02d:%02d", $hour, $min);
3272 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
3286 package CPAN::FTP::netrc;
3289 # package CPAN::FTP::netrc;
3292 my $home = CPAN::HandleConfig::home;
3293 my $file = File::Spec->catfile($home,".netrc");
3295 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3296 $atime,$mtime,$ctime,$blksize,$blocks)
3301 my($fh,@machines,$hasdefault);
3303 $fh = FileHandle->new or die "Could not create a filehandle";
3305 if($fh->open($file)){
3306 $protected = ($mode & 077) == 0;
3308 NETRC: while (<$fh>) {
3309 my(@tokens) = split " ", $_;
3310 TOKEN: while (@tokens) {
3311 my($t) = shift @tokens;
3312 if ($t eq "default"){
3316 last TOKEN if $t eq "macdef";
3317 if ($t eq "machine") {
3318 push @machines, shift @tokens;
3323 $file = $hasdefault = $protected = "";
3327 'mach' => [@machines],
3329 'hasdefault' => $hasdefault,
3330 'protected' => $protected,
3334 # CPAN::FTP::netrc::hasdefault;
3335 sub hasdefault { shift->{'hasdefault'} }
3336 sub netrc { shift->{'netrc'} }
3337 sub protected { shift->{'protected'} }
3339 my($self,$mach) = @_;
3340 for ( @{$self->{'mach'}} ) {
3341 return 1 if $_ eq $mach;
3346 package CPAN::Complete;
3350 my($text, $line, $start, $end) = @_;
3351 my(@perlret) = cpl($text, $line, $start);
3352 # find longest common match. Can anybody show me how to peruse
3353 # T::R::Gnu to have this done automatically? Seems expensive.
3354 return () unless @perlret;
3355 my($newtext) = $text;
3356 for (my $i = length($text)+1;;$i++) {
3357 last unless length($perlret[0]) && length($perlret[0]) >= $i;
3358 my $try = substr($perlret[0],0,$i);
3359 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
3360 # warn "try[$try]tries[@tries]";
3361 if (@tries == @perlret) {
3367 ($newtext,@perlret);
3370 #-> sub CPAN::Complete::cpl ;
3372 my($word,$line,$pos) = @_;
3376 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3378 if ($line =~ s/^(force\s*)//) {
3383 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
3384 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
3386 } elsif ($line =~ /^(a|ls)\s/) {
3387 @return = cplx('CPAN::Author',uc($word));
3388 } elsif ($line =~ /^b\s/) {
3389 CPAN::Shell->local_bundles;
3390 @return = cplx('CPAN::Bundle',$word);
3391 } elsif ($line =~ /^d\s/) {
3392 @return = cplx('CPAN::Distribution',$word);
3393 } elsif ($line =~ m/^(
3394 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
3396 if ($word =~ /^Bundle::/) {
3397 CPAN::Shell->local_bundles;
3399 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3400 } elsif ($line =~ /^i\s/) {
3401 @return = cpl_any($word);
3402 } elsif ($line =~ /^reload\s/) {
3403 @return = cpl_reload($word,$line,$pos);
3404 } elsif ($line =~ /^o\s/) {
3405 @return = cpl_option($word,$line,$pos);
3406 } elsif ($line =~ m/^\S+\s/ ) {
3407 # fallback for future commands and what we have forgotten above
3408 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3415 #-> sub CPAN::Complete::cplx ;
3417 my($class, $word) = @_;
3418 # I believed for many years that this was sorted, today I
3419 # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
3420 # make it sorted again. Maybe sort was dropped when GNU-readline
3421 # support came in? The RCS file is difficult to read on that:-(
3422 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
3425 #-> sub CPAN::Complete::cpl_any ;
3429 cplx('CPAN::Author',$word),
3430 cplx('CPAN::Bundle',$word),
3431 cplx('CPAN::Distribution',$word),
3432 cplx('CPAN::Module',$word),
3436 #-> sub CPAN::Complete::cpl_reload ;
3438 my($word,$line,$pos) = @_;
3440 my(@words) = split " ", $line;
3441 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3442 my(@ok) = qw(cpan index);
3443 return @ok if @words == 1;
3444 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
3447 #-> sub CPAN::Complete::cpl_option ;
3449 my($word,$line,$pos) = @_;
3451 my(@words) = split " ", $line;
3452 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3453 my(@ok) = qw(conf debug);
3454 return @ok if @words == 1;
3455 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
3457 } elsif ($words[1] eq 'index') {
3459 } elsif ($words[1] eq 'conf') {
3460 return CPAN::HandleConfig::cpl(@_);
3461 } elsif ($words[1] eq 'debug') {
3462 return sort grep /^\Q$word\E/i,
3463 sort keys %CPAN::DEBUG, 'all';
3467 package CPAN::Index;
3470 #-> sub CPAN::Index::force_reload ;
3473 $CPAN::Index::LAST_TIME = 0;
3477 #-> sub CPAN::Index::reload ;
3479 my($cl,$force) = @_;
3482 # XXX check if a newer one is available. (We currently read it
3483 # from time to time)
3484 for ($CPAN::Config->{index_expire}) {
3485 $_ = 0.001 unless $_ && $_ > 0.001;
3487 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
3488 # debug here when CPAN doesn't seem to read the Metadata
3490 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
3492 unless ($CPAN::META->{PROTOCOL}) {
3493 $cl->read_metadata_cache;
3494 $CPAN::META->{PROTOCOL} ||= "1.0";
3496 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
3497 # warn "Setting last_time to 0";
3498 $LAST_TIME = 0; # No warning necessary
3500 return if $LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
3503 # IFF we are developing, it helps to wipe out the memory
3504 # between reloads, otherwise it is not what a user expects.
3505 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
3506 $CPAN::META = CPAN->new;
3510 local $LAST_TIME = $time;
3511 local $CPAN::META->{PROTOCOL} = PROTOCOL;
3513 my $needshort = $^O eq "dos";
3515 $cl->rd_authindex($cl
3517 "authors/01mailrc.txt.gz",
3519 File::Spec->catfile('authors', '01mailrc.gz') :
3520 File::Spec->catfile('authors', '01mailrc.txt.gz'),
3523 $debug = "timing reading 01[".($t2 - $time)."]";
3525 return if $CPAN::Signal; # this is sometimes lengthy
3526 $cl->rd_modpacks($cl
3528 "modules/02packages.details.txt.gz",
3530 File::Spec->catfile('modules', '02packag.gz') :
3531 File::Spec->catfile('modules', '02packages.details.txt.gz'),
3534 $debug .= "02[".($t2 - $time)."]";
3536 return if $CPAN::Signal; # this is sometimes lengthy
3539 "modules/03modlist.data.gz",
3541 File::Spec->catfile('modules', '03mlist.gz') :
3542 File::Spec->catfile('modules', '03modlist.data.gz'),
3544 $cl->write_metadata_cache;
3546 $debug .= "03[".($t2 - $time)."]";
3548 CPAN->debug($debug) if $CPAN::DEBUG;
3551 $CPAN::META->{PROTOCOL} = PROTOCOL;
3554 #-> sub CPAN::Index::reload_x ;
3556 my($cl,$wanted,$localname,$force) = @_;
3557 $force |= 2; # means we're dealing with an index here
3558 CPAN::HandleConfig->load; # we should guarantee loading wherever we rely
3560 $localname ||= $wanted;
3561 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
3565 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
3568 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
3569 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
3570 qq{day$s. I\'ll use that.});
3573 $force |= 1; # means we're quite serious about it.
3575 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
3578 #-> sub CPAN::Index::rd_authindex ;
3580 my($cl, $index_target) = @_;
3582 return unless defined $index_target;
3583 $CPAN::Frontend->myprint("Going to read $index_target\n");
3585 tie *FH, 'CPAN::Tarzip', $index_target;
3588 push @lines, split /\012/ while <FH>;
3590 my($userid,$fullname,$email) =
3591 m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
3592 next unless $userid && $fullname && $email;
3594 # instantiate an author object
3595 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
3596 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
3597 return if $CPAN::Signal;
3602 my($self,$dist) = @_;
3603 $dist = $self->{'id'} unless defined $dist;
3604 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
3608 #-> sub CPAN::Index::rd_modpacks ;
3610 my($self, $index_target) = @_;
3612 return unless defined $index_target;
3613 $CPAN::Frontend->myprint("Going to read $index_target\n");
3614 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3617 while ($_ = $fh->READLINE) {
3619 my @ls = map {"$_\n"} split /\n/, $_;
3620 unshift @ls, "\n" x length($1) if /^(\n+)/;
3624 my($line_count,$last_updated);
3626 my $shift = shift(@lines);
3627 last if $shift =~ /^\s*$/;
3628 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
3629 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
3631 if (not defined $line_count) {
3633 warn qq{Warning: Your $index_target does not contain a Line-Count header.
3634 Please check the validity of the index file by comparing it to more
3635 than one CPAN mirror. I'll continue but problems seem likely to
3640 } elsif ($line_count != scalar @lines) {
3642 warn sprintf qq{Warning: Your %s
3643 contains a Line-Count header of %d but I see %d lines there. Please
3644 check the validity of the index file by comparing it to more than one
3645 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
3646 $index_target, $line_count, scalar(@lines);
3649 if (not defined $last_updated) {
3651 warn qq{Warning: Your $index_target does not contain a Last-Updated header.
3652 Please check the validity of the index file by comparing it to more
3653 than one CPAN mirror. I'll continue but problems seem likely to
3661 ->myprint(sprintf qq{ Database was generated on %s\n},
3663 $DATE_OF_02 = $last_updated;
3666 if ($CPAN::META->has_inst('HTTP::Date')) {
3668 $age -= HTTP::Date::str2time($last_updated);
3670 $CPAN::Frontend->myprint(" HTTP::Date not available\n");
3671 require Time::Local;
3672 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
3673 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
3674 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
3681 qq{Warning: This index file is %d days old.
3682 Please check the host you chose as your CPAN mirror for staleness.
3683 I'll continue but problems seem likely to happen.\a\n},
3686 } elsif ($age < -1) {
3690 qq{Warning: Your system date is %d days behind this index file!
3692 Timestamp index file: %s
3693 Please fix your system time, problems with the make command expected.\n},
3703 # A necessity since we have metadata_cache: delete what isn't
3705 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
3706 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
3710 # before 1.56 we split into 3 and discarded the rest. From
3711 # 1.57 we assign remaining text to $comment thus allowing to
3712 # influence isa_perl
3713 my($mod,$version,$dist,$comment) = split " ", $_, 4;
3714 my($bundle,$id,$userid);
3716 if ($mod eq 'CPAN' &&
3718 CPAN::Queue->exists('Bundle::CPAN') ||
3719 CPAN::Queue->exists('CPAN')
3723 if ($version > $CPAN::VERSION){
3724 $CPAN::Frontend->myprint(qq{
3725 New CPAN.pm version (v$version) available.
3726 [Currently running version is v$CPAN::VERSION]
3727 You might want to try
3730 to both upgrade CPAN.pm and run the new version without leaving
3731 the current session.
3735 $CPAN::Frontend->myprint(qq{\n});
3737 last if $CPAN::Signal;
3738 } elsif ($mod =~ /^Bundle::(.*)/) {
3743 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
3744 # Let's make it a module too, because bundles have so much
3745 # in common with modules.
3747 # Changed in 1.57_63: seems like memory bloat now without
3748 # any value, so commented out
3750 # $CPAN::META->instance('CPAN::Module',$mod);
3754 # instantiate a module object
3755 $id = $CPAN::META->instance('CPAN::Module',$mod);
3759 # Although CPAN prohibits same name with different version the
3760 # indexer may have changed the version for the same distro
3761 # since the last time ("Force Reindexing" feature)
3762 if ($id->cpan_file ne $dist
3764 $id->cpan_version ne $version
3766 $userid = $id->userid || $self->userid($dist);
3768 'CPAN_USERID' => $userid,
3769 'CPAN_VERSION' => $version,
3770 'CPAN_FILE' => $dist,
3774 # instantiate a distribution object
3775 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
3776 # we do not need CONTAINSMODS unless we do something with
3777 # this dist, so we better produce it on demand.
3779 ## my $obj = $CPAN::META->instance(
3780 ## 'CPAN::Distribution' => $dist
3782 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
3784 $CPAN::META->instance(
3785 'CPAN::Distribution' => $dist
3787 'CPAN_USERID' => $userid,
3788 'CPAN_COMMENT' => $comment,
3792 for my $name ($mod,$dist) {
3793 CPAN->debug("exists name[$name]") if $CPAN::DEBUG;
3794 $exists{$name} = undef;
3797 return if $CPAN::Signal;
3801 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
3802 for my $o ($CPAN::META->all_objects($class)) {
3803 next if exists $exists{$o->{ID}};
3804 $CPAN::META->delete($class,$o->{ID});
3805 CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
3812 #-> sub CPAN::Index::rd_modlist ;
3814 my($cl,$index_target) = @_;
3815 return unless defined $index_target;
3816 $CPAN::Frontend->myprint("Going to read $index_target\n");
3817 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3821 while ($_ = $fh->READLINE) {
3823 my @ls = map {"$_\n"} split /\n/, $_;
3824 unshift @ls, "\n" x length($1) if /^(\n+)/;
3828 my $shift = shift(@eval);
3829 if ($shift =~ /^Date:\s+(.*)/){
3830 return if $DATE_OF_03 eq $1;
3833 last if $shift =~ /^\s*$/;
3836 push @eval, q{CPAN::Modulelist->data;};
3838 my($comp) = Safe->new("CPAN::Safe1");
3839 my($eval) = join("", @eval);
3840 my $ret = $comp->reval($eval);
3841 Carp::confess($@) if $@;
3842 return if $CPAN::Signal;
3844 my $obj = $CPAN::META->instance("CPAN::Module",$_);
3845 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
3846 $obj->set(%{$ret->{$_}});
3847 return if $CPAN::Signal;
3851 #-> sub CPAN::Index::write_metadata_cache ;
3852 sub write_metadata_cache {
3854 return unless $CPAN::Config->{'cache_metadata'};
3855 return unless $CPAN::META->has_usable("Storable");
3857 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
3858 CPAN::Distribution)) {
3859 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
3861 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
3862 $cache->{last_time} = $LAST_TIME;
3863 $cache->{DATE_OF_02} = $DATE_OF_02;
3864 $cache->{PROTOCOL} = PROTOCOL;
3865 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
3866 eval { Storable::nstore($cache, $metadata_file) };
3867 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
3870 #-> sub CPAN::Index::read_metadata_cache ;
3871 sub read_metadata_cache {
3873 return unless $CPAN::Config->{'cache_metadata'};
3874 return unless $CPAN::META->has_usable("Storable");
3875 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
3876 return unless -r $metadata_file and -f $metadata_file;
3877 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
3879 eval { $cache = Storable::retrieve($metadata_file) };
3880 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
3881 if (!$cache || ref $cache ne 'HASH'){
3885 if (exists $cache->{PROTOCOL}) {
3886 if (PROTOCOL > $cache->{PROTOCOL}) {
3887 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
3888 "with protocol v%s, requiring v%s\n",
3895 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
3896 "with protocol v1.0\n");
3901 while(my($class,$v) = each %$cache) {
3902 next unless $class =~ /^CPAN::/;
3903 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
3904 while (my($id,$ro) = each %$v) {
3905 $CPAN::META->{readwrite}{$class}{$id} ||=
3906 $class->new(ID=>$id, RO=>$ro);
3911 unless ($clcnt) { # sanity check
3912 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
3915 if ($idcnt < 1000) {
3916 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
3917 "in $metadata_file\n");
3920 $CPAN::META->{PROTOCOL} ||=
3921 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
3922 # does initialize to some protocol
3923 $LAST_TIME = $cache->{last_time};
3924 $DATE_OF_02 = $cache->{DATE_OF_02};
3925 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
3926 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
3930 package CPAN::InfoObj;
3935 exists $self->{RO} and return $self->{RO};
3940 my $ro = $self->ro or return "N/A"; # N/A for bundles found locally
3941 return $ro->{CPAN_USERID} || "N/A";
3944 sub id { shift->{ID}; }
3946 #-> sub CPAN::InfoObj::new ;
3948 my $this = bless {}, shift;
3953 # The set method may only be used by code that reads index data or
3954 # otherwise "objective" data from the outside world. All session
3955 # related material may do anything else with instance variables but
3956 # must not touch the hash under the RO attribute. The reason is that
3957 # the RO hash gets written to Metadata file and is thus persistent.
3959 #-> sub CPAN::InfoObj::safe_chdir ;
3961 my($self,$todir) = @_;
3962 # we die if we cannot chdir and we are debuggable
3963 Carp::confess("safe_chdir called without todir argument")
3964 unless defined $todir and length $todir;
3966 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
3970 unless (-x $todir) {
3971 unless (chmod 0755, $todir) {
3972 my $cwd = CPAN::anycwd();
3973 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
3974 "permission to change the permission; cannot ".
3975 "chdir to '$todir'\n");
3976 $CPAN::Frontend->mysleep(5);
3977 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
3978 qq{to todir[$todir]: $!});
3982 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
3985 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
3988 my $cwd = CPAN::anycwd();
3989 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
3990 qq{to todir[$todir] (a chmod has been issued): $!});
3995 #-> sub CPAN::InfoObj::set ;
3997 my($self,%att) = @_;
3998 my $class = ref $self;
4000 # This must be ||=, not ||, because only if we write an empty
4001 # reference, only then the set method will write into the readonly
4002 # area. But for Distributions that spring into existence, maybe
4003 # because of a typo, we do not like it that they are written into
4004 # the readonly area and made permanent (at least for a while) and
4005 # that is why we do not "allow" other places to call ->set.
4006 unless ($self->id) {
4007 CPAN->debug("Bug? Empty ID, rejecting");
4010 my $ro = $self->{RO} =
4011 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
4013 while (my($k,$v) = each %att) {
4018 #-> sub CPAN::InfoObj::as_glimpse ;
4022 my $class = ref($self);
4023 $class =~ s/^CPAN:://;
4024 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
4028 #-> sub CPAN::InfoObj::as_string ;
4032 my $class = ref($self);
4033 $class =~ s/^CPAN:://;
4034 push @m, $class, " id = $self->{ID}\n";
4036 unless ($ro = $self->ro) {
4037 $CPAN::Frontend->mydie("Unknown object $self->{ID}");
4039 for (sort keys %$ro) {
4040 # next if m/^(ID|RO)$/;
4042 if ($_ eq "CPAN_USERID") {
4044 $extra .= $self->fullname;
4045 my $email; # old perls!
4046 if ($email = $CPAN::META->instance("CPAN::Author",
4049 $extra .= " <$email>";
4051 $extra .= " <no email>";
4054 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
4055 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
4058 next unless defined $ro->{$_};
4059 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
4061 for (sort keys %$self) {
4062 next if m/^(ID|RO)$/;
4063 if (ref($self->{$_}) eq "ARRAY") {
4064 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
4065 } elsif (ref($self->{$_}) eq "HASH") {
4069 join(" ",sort keys %{$self->{$_}}),
4072 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
4078 #-> sub CPAN::InfoObj::fullname ;
4081 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
4084 #-> sub CPAN::InfoObj::dump ;
4087 unless ($CPAN::META->has_inst("Data::Dumper")) {
4088 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
4090 local $Data::Dumper::Sortkeys;
4091 $Data::Dumper::Sortkeys = 1;
4092 print Data::Dumper::Dumper($self);
4095 package CPAN::Author;
4098 #-> sub CPAN::Author::force
4104 #-> sub CPAN::Author::force
4107 delete $self->{force};
4110 #-> sub CPAN::Author::id
4113 my $id = $self->{ID};
4114 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
4118 #-> sub CPAN::Author::as_glimpse ;
4122 my $class = ref($self);
4123 $class =~ s/^CPAN:://;
4124 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
4132 #-> sub CPAN::Author::fullname ;
4134 shift->ro->{FULLNAME};
4138 #-> sub CPAN::Author::email ;
4139 sub email { shift->ro->{EMAIL}; }
4141 #-> sub CPAN::Author::ls ;
4144 my $glob = shift || "";
4145 my $silent = shift || 0;
4148 # adapted from CPAN::Distribution::verifyCHECKSUM ;
4149 my(@csf); # chksumfile
4150 @csf = $self->id =~ /(.)(.)(.*)/;
4151 $csf[1] = join "", @csf[0,1];
4152 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
4154 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
4155 unless (grep {$_->[2] eq $csf[1]} @dl) {
4156 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
4159 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
4160 unless (grep {$_->[2] eq $csf[2]} @dl) {
4161 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
4164 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
4166 if ($CPAN::META->has_inst("Text::Glob")) {
4167 my $rglob = Text::Glob::glob_to_regex($glob);
4168 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
4170 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
4173 $CPAN::Frontend->myprint(join "", map {
4174 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
4175 } sort { $a->[2] cmp $b->[2] } @dl);
4179 # returns an array of arrays, the latter contain (size,mtime,filename)
4180 #-> sub CPAN::Author::dir_listing ;
4183 my $chksumfile = shift;
4184 my $recursive = shift;
4185 my $may_ftp = shift;
4188 File::Spec->catfile($CPAN::Config->{keep_source_where},
4189 "authors", "id", @$chksumfile);
4193 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
4194 # hazard. (Without GPG installed they are not that much better,
4196 $fh = FileHandle->new;
4197 if (open($fh, $lc_want)) {
4198 my $line = <$fh>; close $fh;
4199 unlink($lc_want) unless $line =~ /PGP/;
4203 # connect "force" argument with "index_expire".
4204 my $force = $self->{force};
4205 if (my @stat = stat $lc_want) {
4206 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
4210 $lc_file = CPAN::FTP->localize(
4211 "authors/id/@$chksumfile",
4216 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
4217 $chksumfile->[-1] .= ".gz";
4218 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
4221 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
4222 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
4228 $lc_file = $lc_want;
4229 # we *could* second-guess and if the user has a file: URL,
4230 # then we could look there. But on the other hand, if they do
4231 # have a file: URL, wy did they choose to set
4232 # $CPAN::Config->{show_upload_date} to false?
4235 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
4236 $fh = FileHandle->new;
4238 if (open $fh, $lc_file){
4241 $eval =~ s/\015?\012/\n/g;
4243 my($comp) = Safe->new();
4244 $cksum = $comp->reval($eval);
4246 rename $lc_file, "$lc_file.bad";
4247 Carp::confess($@) if $@;
4249 } elsif ($may_ftp) {
4250 Carp::carp "Could not open '$lc_file' for reading.";
4252 # Maybe should warn: "You may want to set show_upload_date to a true value"
4256 for $f (sort keys %$cksum) {
4257 if (exists $cksum->{$f}{isdir}) {
4259 my(@dir) = @$chksumfile;
4261 push @dir, $f, "CHECKSUMS";
4263 [$_->[0], $_->[1], "$f/$_->[2]"]
4264 } $self->dir_listing(\@dir,1,$may_ftp);
4266 push @result, [ 0, "-", $f ];
4270 ($cksum->{$f}{"size"}||0),
4271 $cksum->{$f}{"mtime"}||"---",
4279 package CPAN::Distribution;
4285 my $ro = $self->ro or return;
4289 # CPAN::Distribution::undelay
4292 delete $self->{later};
4295 # add the A/AN/ stuff
4296 # CPAN::Distribution::normalize
4299 $s = $self->id unless defined $s;
4303 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
4305 return $s if $s =~ m:^N/A|^Contact Author: ;
4306 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
4307 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
4308 CPAN->debug("s[$s]") if $CPAN::DEBUG;
4313 #-> sub CPAN::Distribution::author ;
4316 my($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
4317 CPAN::Shell->expand("Author",$authorid);
4320 # tries to get the yaml from CPAN instead of the distro itself:
4321 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
4324 my $meta = $self->pretty_id;
4325 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
4326 my(@ls) = CPAN::Shell->globls($meta);
4327 my $norm = $self->normalize($meta);
4331 File::Spec->catfile(
4332 $CPAN::Config->{keep_source_where},
4337 $self->debug("Doing localize") if $CPAN::DEBUG;
4338 unless ($local_file =
4339 CPAN::FTP->localize("authors/id/$norm",
4341 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
4343 if ($CPAN::META->has_inst("YAML")) {
4344 my $yaml = YAML::LoadFile($local_file);
4347 $CPAN::Frontend->mydie("Yaml not installed, cannot parse '$local_file'\n");
4354 return $id unless $id =~ m|^./../|;
4358 # mark as dirty/clean
4359 #-> sub CPAN::Distribution::color_cmd_tmps ;
4360 sub color_cmd_tmps {
4362 my($depth) = shift || 0;
4363 my($color) = shift || 0;
4364 my($ancestors) = shift || [];
4365 # a distribution needs to recurse into its prereq_pms
4367 return if exists $self->{incommandcolor}
4368 && $self->{incommandcolor}==$color;
4370 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
4372 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
4373 my $prereq_pm = $self->prereq_pm;
4374 if (defined $prereq_pm) {
4375 PREREQ: for my $pre (keys %$prereq_pm) {
4377 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
4378 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
4379 $CPAN::Frontend->mysleep(2);
4382 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
4386 delete $self->{sponsored_mods};
4387 delete $self->{badtestcnt};
4389 $self->{incommandcolor} = $color;
4392 #-> sub CPAN::Distribution::as_string ;
4395 $self->containsmods;
4397 $self->SUPER::as_string(@_);
4400 #-> sub CPAN::Distribution::containsmods ;
4403 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
4404 my $dist_id = $self->{ID};
4405 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
4406 my $mod_file = $mod->cpan_file or next;
4407 my $mod_id = $mod->{ID} or next;
4408 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
4410 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
4412 keys %{$self->{CONTAINSMODS}};
4415 #-> sub CPAN::Distribution::upload_date ;
4418 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
4419 my(@local_wanted) = split(/\//,$self->id);
4420 my $filename = pop @local_wanted;
4421 push @local_wanted, "CHECKSUMS";
4422 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
4423 return unless $author;
4424 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
4426 my($dirent) = grep { $_->[2] eq $filename } @dl;
4427 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
4428 return unless $dirent->[1];
4429 return $self->{UPLOAD_DATE} = $dirent->[1];
4432 #-> sub CPAN::Distribution::uptodate ;
4436 foreach $c ($self->containsmods) {
4437 my $obj = CPAN::Shell->expandany($c);
4438 return 0 unless $obj->uptodate;
4443 #-> sub CPAN::Distribution::called_for ;
4446 $self->{CALLED_FOR} = $id if defined $id;
4447 return $self->{CALLED_FOR};
4450 #-> sub CPAN::Distribution::get ;
4455 exists $self->{'build_dir'} and push @e,
4456 "Is already unwrapped into directory $self->{'build_dir'}";
4457 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4459 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
4462 # Get the file on local disk
4467 File::Spec->catfile(
4468 $CPAN::Config->{keep_source_where},
4471 split(/\//,$self->id)
4474 $self->debug("Doing localize") if $CPAN::DEBUG;
4475 unless ($local_file =
4476 CPAN::FTP->localize("authors/id/$self->{ID}",
4479 if ($CPAN::Index::DATE_OF_02) {
4480 $note = "Note: Current database in memory was generated ".
4481 "on $CPAN::Index::DATE_OF_02\n";
4483 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
4485 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4486 $self->{localfile} = $local_file;
4487 return if $CPAN::Signal;
4492 if ($CPAN::META->has_inst("Digest::SHA")) {
4493 $self->debug("Digest::SHA is installed, verifying");
4494 $self->verifyCHECKSUM;
4496 $self->debug("Digest::SHA is NOT installed");
4498 return if $CPAN::Signal;
4501 # Create a clean room and go there
4503 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
4504 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
4505 $self->safe_chdir($builddir);
4506 $self->debug("Removing tmp") if $CPAN::DEBUG;
4507 File::Path::rmtree("tmp");
4508 unless (mkdir "tmp", 0755) {
4509 $CPAN::Frontend->unrecoverable_error(<<EOF);
4510 Couldn't mkdir '$builddir/tmp': $!
4512 Cannot continue: Please find the reason why I cannot make the
4515 and fix the problem, then retry.
4520 $self->safe_chdir($sub_wd);
4523 $self->safe_chdir("tmp");
4528 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4529 my $ct = CPAN::Tarzip->new($local_file);
4530 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
4531 $self->{was_uncompressed}++ unless $ct->gtest();
4532 $self->untar_me($ct);
4533 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
4534 $self->unzip_me($ct);
4536 $self->{was_uncompressed}++ unless $ct->gtest();
4537 $self->debug("calling pm2dir for local_file[$local_file]")
4539 $local_file = $self->handle_singlefile($local_file);
4541 # $self->{archived} = "NO";
4542 # $self->safe_chdir($sub_wd);
4546 # we are still in the tmp directory!
4547 # Let's check if the package has its own directory.
4548 my $dh = DirHandle->new(File::Spec->curdir)
4549 or Carp::croak("Couldn't opendir .: $!");
4550 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
4552 my ($distdir,$packagedir);
4553 if (@readdir == 1 && -d $readdir[0]) {
4554 $distdir = $readdir[0];
4555 $packagedir = File::Spec->catdir($builddir,$distdir);
4556 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
4558 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
4560 File::Path::rmtree($packagedir);
4561 unless (File::Copy::move($distdir,$packagedir)) {
4562 $CPAN::Frontend->unrecoverable_error(<<EOF);
4563 Couldn't move '$distdir' to '$packagedir': $!
4565 Cannot continue: Please find the reason why I cannot move
4566 $builddir/tmp/$distdir
4569 and fix the problem, then retry
4573 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
4580 my $userid = $self->cpan_userid;
4582 CPAN->debug("no userid? self[$self]");
4585 my $pragmatic_dir = $userid . '000';
4586 $pragmatic_dir =~ s/\W_//g;
4587 $pragmatic_dir++ while -d "../$pragmatic_dir";
4588 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
4589 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
4590 File::Path::mkpath($packagedir);
4592 for $f (@readdir) { # is already without "." and ".."
4593 my $to = File::Spec->catdir($packagedir,$f);
4594 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
4598 $self->safe_chdir($sub_wd);
4602 $self->{'build_dir'} = $packagedir;
4603 $self->safe_chdir($builddir);
4604 File::Path::rmtree("tmp");
4606 $self->safe_chdir($packagedir);
4607 if ($CPAN::Config->{check_sigs}) {
4608 if ($CPAN::META->has_inst("Module::Signature")) {
4609 if (-f "SIGNATURE") {
4610 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
4611 my $rv = Module::Signature::verify();
4612 if ($rv != Module::Signature::SIGNATURE_OK() and
4613 $rv != Module::Signature::SIGNATURE_MISSING()) {
4614 $CPAN::Frontend->myprint(
4615 qq{\nSignature invalid for }.
4616 qq{distribution file. }.
4617 qq{Please investigate.\n\n}.
4619 $CPAN::META->instance(
4626 sprintf(qq{I'd recommend removing %s. Its signature
4627 is invalid. Maybe you have configured your 'urllist' with
4628 a bad URL. Please check this array with 'o conf urllist', and
4629 retry. For more information, try opening a subshell with
4637 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
4638 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
4639 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
4641 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
4642 $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
4645 $CPAN::Frontend->myprint(qq{Package came without SIGNATURE\n\n});
4648 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
4651 $self->safe_chdir($builddir);
4652 return if $CPAN::Signal;
4655 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
4656 my($mpl_exists) = -f $mpl;
4657 unless ($mpl_exists) {
4658 # NFS has been reported to have racing problems after the
4659 # renaming of a directory in some environments.
4662 my $mpldh = DirHandle->new($packagedir)
4663 or Carp::croak("Couldn't opendir $packagedir: $!");
4664 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
4667 my $prefer_installer = "eumm"; # eumm|mb
4668 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
4669 if ($mpl_exists) { # they *can* choose
4670 if ($CPAN::META->has_inst("Module::Build")) {
4671 $prefer_installer = $CPAN::Config->{prefer_installer};
4674 $prefer_installer = "mb";
4677 if (lc($prefer_installer) eq "mb") {
4678 $self->{modulebuild} = 1;
4679 } elsif (! $mpl_exists) {
4680 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
4684 my($configure) = File::Spec->catfile($packagedir,"Configure");
4685 if (-f $configure) {
4686 # do we have anything to do?
4687 $self->{'configure'} = $configure;
4688 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
4689 $CPAN::Frontend->myprint(qq{
4690 Package comes with a Makefile and without a Makefile.PL.
4691 We\'ll try to build it with that Makefile then.
4693 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
4696 my $cf = $self->called_for || "unknown";
4701 $cf =~ s|[/\\:]||g; # risk of filesystem damage
4702 $cf = "unknown" unless length($cf);
4703 $CPAN::Frontend->myprint(qq{Package seems to come without Makefile.PL.
4704 (The test -f "$mpl" returned false.)
4705 Writing one on our own (setting NAME to $cf)\a\n});
4706 $self->{had_no_makefile_pl}++;
4709 # Writing our own Makefile.PL
4712 if ($self->{archived} eq "maybe_pl"){
4713 my $fh = FileHandle->new;
4714 my $script_file = File::Spec->catfile($packagedir,$local_file);
4715 $fh->open($script_file)
4716 or Carp::croak("Could not open $script_file: $!");
4718 # name parsen und prereq
4719 my($state) = "poddir";
4720 my($name, $prereq) = ("", "");
4722 if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
4725 } elsif ($1 eq 'PREREQUISITES') {
4728 } elsif ($state =~ m{^(name|prereq)$}) {
4733 } elsif ($state eq "name") {
4738 } elsif ($state eq "prereq") {
4741 } elsif (/^=cut\b/) {
4748 s{.*<}{}; # strip X<...>
4752 $prereq = join " ", split /\s+/, $prereq;
4753 my($PREREQ_PM) = join("\n", map {
4754 s{.*<}{}; # strip X<...>
4756 if (/[\s\'\"]/) { # prose?
4758 s/[^\w:]$//; # period?
4759 " "x28 . "'$_' => 0,";
4761 } split /\s*,\s*/, $prereq);
4764 EXE_FILES => ['$name'],
4770 my $to_file = File::Spec->catfile($packagedir, $name);
4771 rename $script_file, $to_file
4772 or die "Can't rename $script_file to $to_file: $!";
4775 my $fh = FileHandle->new;
4777 or Carp::croak("Could not open >$mpl: $!");
4779 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
4780 # because there was no Makefile.PL supplied.
4781 # Autogenerated on: }.scalar localtime().qq{
4783 use ExtUtils::MakeMaker;
4785 NAME => q[$cf],$script
4795 # CPAN::Distribution::untar_me ;
4798 $self->{archived} = "tar";
4800 $self->{unwrapped} = "YES";
4802 $self->{unwrapped} = "NO";
4806 # CPAN::Distribution::unzip_me ;
4809 $self->{archived} = "zip";
4811 $self->{unwrapped} = "YES";
4813 $self->{unwrapped} = "NO";
4818 sub handle_singlefile {
4819 my($self,$local_file) = @_;
4821 if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ){
4822 $self->{archived} = "pm";
4824 $self->{archived} = "maybe_pl";
4827 my $to = File::Basename::basename($local_file);
4828 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
4829 if (CPAN::Tarzip->new($local_file)->gunzip($to)) {
4830 $self->{unwrapped} = "YES";
4832 $self->{unwrapped} = "NO";
4835 File::Copy::cp($local_file,".");
4836 $self->{unwrapped} = "YES";
4841 #-> sub CPAN::Distribution::new ;
4843 my($class,%att) = @_;
4845 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
4847 my $this = { %att };
4848 return bless $this, $class;
4851 #-> sub CPAN::Distribution::look ;
4855 if ($^O eq 'MacOS') {
4856 $self->Mac::BuildTools::look;
4860 if ( $CPAN::Config->{'shell'} ) {
4861 $CPAN::Frontend->myprint(qq{
4862 Trying to open a subshell in the build directory...
4865 $CPAN::Frontend->myprint(qq{
4866 Your configuration does not define a value for subshells.
4867 Please define it with "o conf shell <your shell>"
4871 my $dist = $self->id;
4873 unless ($dir = $self->dir) {
4876 unless ($dir ||= $self->dir) {
4877 $CPAN::Frontend->mywarn(qq{
4878 Could not determine which directory to use for looking at $dist.
4882 my $pwd = CPAN::anycwd();
4883 $self->safe_chdir($dir);
4884 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
4886 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
4887 $ENV{CPAN_SHELL_LEVEL} += 1;
4888 my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
4889 unless (system($shell) == 0) {
4891 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
4894 $self->safe_chdir($pwd);
4897 # CPAN::Distribution::cvs_import ;
4901 my $dir = $self->dir;
4903 my $package = $self->called_for;
4904 my $module = $CPAN::META->instance('CPAN::Module', $package);
4905 my $version = $module->cpan_version;
4907 my $userid = $self->cpan_userid;
4909 my $cvs_dir = (split /\//, $dir)[-1];
4910 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
4912 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
4914 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
4915 if ($cvs_site_perl) {
4916 $cvs_dir = "$cvs_site_perl/$cvs_dir";
4918 my $cvs_log = qq{"imported $package $version sources"};
4919 $version =~ s/\./_/g;
4921 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
4922 "$cvs_dir", $userid, "v$version");
4924 my $pwd = CPAN::anycwd();
4925 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
4927 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
4929 $CPAN::Frontend->myprint(qq{@cmd\n});
4930 system(@cmd) == 0 or
4932 $CPAN::Frontend->mydie("cvs import failed");
4933 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
4936 #-> sub CPAN::Distribution::readme ;
4939 my($dist) = $self->id;
4940 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
4941 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
4944 File::Spec->catfile(
4945 $CPAN::Config->{keep_source_where},
4948 split(/\//,"$sans.readme"),
4950 $self->debug("Doing localize") if $CPAN::DEBUG;
4951 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
4953 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
4955 if ($^O eq 'MacOS') {
4956 Mac::BuildTools::launch_file($local_file);
4960 my $fh_pager = FileHandle->new;
4961 local($SIG{PIPE}) = "IGNORE";
4962 my $pager = $CPAN::Config->{'pager'} || "cat";
4963 $fh_pager->open("|$pager")
4964 or die "Could not open pager $pager\: $!";
4965 my $fh_readme = FileHandle->new;
4966 $fh_readme->open($local_file)
4967 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
4968 $CPAN::Frontend->myprint(qq{
4974 $fh_pager->print(<$fh_readme>);
4978 #-> sub CPAN::Distribution::verifyCHECKSUM ;
4979 sub verifyCHECKSUM {
4983 $self->{CHECKSUM_STATUS} ||= "";
4984 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
4985 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4987 my($lc_want,$lc_file,@local,$basename);
4988 @local = split(/\//,$self->id);
4990 push @local, "CHECKSUMS";
4992 File::Spec->catfile($CPAN::Config->{keep_source_where},
4993 "authors", "id", @local);
4995 if (my $size = -s $lc_want) {
4996 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
4997 if ($self->CHECKSUM_check_file($lc_want,1)) {
4998 return $self->{CHECKSUM_STATUS} = "OK";
5001 $lc_file = CPAN::FTP->localize("authors/id/@local",
5004 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
5005 $local[-1] .= ".gz";
5006 $lc_file = CPAN::FTP->localize("authors/id/@local",
5009 $lc_file =~ s/\.gz(?!\n)\Z//;
5010 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
5015 if ($self->CHECKSUM_check_file($lc_file)) {
5016 return $self->{CHECKSUM_STATUS} = "OK";
5020 #-> sub CPAN::Distribution::SIG_check_file ;
5021 sub SIG_check_file {
5022 my($self,$chk_file) = @_;
5023 my $rv = eval { Module::Signature::_verify($chk_file) };
5025 if ($rv == Module::Signature::SIGNATURE_OK()) {
5026 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
5027 return $self->{SIG_STATUS} = "OK";
5029 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
5030 qq{distribution file. }.
5031 qq{Please investigate.\n\n}.
5033 $CPAN::META->instance(
5038 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
5039 is invalid. Maybe you have configured your 'urllist' with
5040 a bad URL. Please check this array with 'o conf urllist', and
5043 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
5047 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
5049 # sloppy is 1 when we have an old checksums file that maybe is good
5052 sub CHECKSUM_check_file {
5053 my($self,$chk_file,$sloppy) = @_;
5054 my($cksum,$file,$basename);
5057 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
5058 if ($CPAN::Config->{check_sigs}) {
5059 if ($CPAN::META->has_inst("Module::Signature") and Module::Signature->VERSION >= 0.26) {
5060 $self->debug("Module::Signature is installed, verifying");
5061 $self->SIG_check_file($chk_file);
5063 $self->debug("Module::Signature is NOT installed");
5067 $file = $self->{localfile};
5068 $basename = File::Basename::basename($file);
5069 my $fh = FileHandle->new;
5070 if (open $fh, $chk_file){
5073 $eval =~ s/\015?\012/\n/g;
5075 my($comp) = Safe->new();
5076 $cksum = $comp->reval($eval);
5078 rename $chk_file, "$chk_file.bad";
5079 Carp::confess($@) if $@;
5082 Carp::carp "Could not open $chk_file for reading";
5085 if (! ref $cksum or ref $cksum ne "HASH") {
5086 $CPAN::Frontend->mywarn(qq{
5087 Warning: checksum file '$chk_file' broken.
5089 When trying to read that file I expected to get a hash reference
5090 for further processing, but got garbage instead.
5092 my $answer = ExtUtils::MakeMaker::prompt("Proceed nonetheless?", "no");
5093 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
5094 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
5096 } elsif (exists $cksum->{$basename}{sha256}) {
5097 $self->debug("Found checksum for $basename:" .
5098 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
5102 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
5104 $fh = CPAN::Tarzip->TIEHANDLE($file);
5107 my $dg = Digest::SHA->new(256);
5110 while ($fh->READ($ref, 4096) > 0){
5113 my $hexdigest = $dg->hexdigest;
5114 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
5118 $CPAN::Frontend->myprint("Checksum for $file ok\n");
5119 return $self->{CHECKSUM_STATUS} = "OK";
5121 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
5122 qq{distribution file. }.
5123 qq{Please investigate.\n\n}.
5125 $CPAN::META->instance(
5130 my $wrap = qq{I\'d recommend removing $file. Its
5131 checksum is incorrect. Maybe you have configured your 'urllist' with
5132 a bad URL. Please check this array with 'o conf urllist', and
5135 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
5137 # former versions just returned here but this seems a
5138 # serious threat that deserves a die
5140 # $CPAN::Frontend->myprint("\n\n");
5144 # close $fh if fileno($fh);
5147 unless ($self->{CHECKSUM_STATUS}) {
5148 $CPAN::Frontend->mywarn(qq{
5149 Warning: No checksum for $basename in $chk_file.
5151 The cause for this may be that the file is very new and the checksum
5152 has not yet been calculated, but it may also be that something is
5153 going awry right now.
5155 my $answer = ExtUtils::MakeMaker::prompt("Proceed?", "yes");
5156 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
5158 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
5163 #-> sub CPAN::Distribution::eq_CHECKSUM ;
5165 my($self,$fh,$expect) = @_;
5166 if ($CPAN::META->has_inst("Digest::SHA")) {
5167 my $dg = Digest::SHA->new(256);
5169 while (read($fh, $data, 4096)){
5172 my $hexdigest = $dg->hexdigest;
5173 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
5174 return $hexdigest eq $expect;
5179 #-> sub CPAN::Distribution::force ;
5181 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
5182 # effect by autoinspection, not by inspecting a global variable. One
5183 # of the reason why this was chosen to work that way was the treatment
5184 # of dependencies. They should not automatically inherit the force
5185 # status. But this has the downside that ^C and die() will return to
5186 # the prompt but will not be able to reset the force_update
5187 # attributes. We try to correct for it currently in the read_metadata
5188 # routine, and immediately before we check for a Signal. I hope this
5189 # works out in one of v1.57_53ff
5191 # "Force get forgets previous error conditions"
5193 #-> sub CPAN::Distribution::force ;
5195 my($self, $method) = @_;
5197 CHECKSUM_STATUS archived build_dir localfile make install unwrapped
5198 writemakefile modulebuild make_test
5200 delete $self->{$att};
5202 if ($method && $method =~ /make|test|install/) {
5203 $self->{"force_update"}++; # name should probably have been force_install
5208 my($self, $method) = @_;
5209 # warn "XDEBUG: set notest for $self $method";
5210 $self->{"notest"}++; # name should probably have been force_install
5215 # warn "XDEBUG: deleting notest";
5216 delete $self->{'notest'};
5219 #-> sub CPAN::Distribution::unforce ;
5222 delete $self->{'force_update'};
5225 #-> sub CPAN::Distribution::isa_perl ;
5228 my $file = File::Basename::basename($self->id);
5229 if ($file =~ m{ ^ perl
5242 } elsif ($self->cpan_comment
5244 $self->cpan_comment =~ /isa_perl\(.+?\)/){
5250 #-> sub CPAN::Distribution::perl ;
5255 carp __PACKAGE__ . "::perl was called without parameters.";
5257 return CPAN::HandleConfig->safe_quote($CPAN::Perl);
5261 #-> sub CPAN::Distribution::make ;
5264 my $make = $self->{modulebuild} ? "Build" : "make";
5265 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
5266 # Emergency brake if they said install Pippi and get newest perl
5267 if ($self->isa_perl) {
5269 $self->called_for ne $self->id &&
5270 ! $self->{force_update}
5272 # if we die here, we break bundles
5273 $CPAN::Frontend->mywarn(sprintf qq{
5274 The most recent version "%s" of the module "%s"
5275 comes with the current version of perl (%s).
5276 I\'ll build that only if you ask for something like
5281 $CPAN::META->instance(
5289 $self->{make} = CPAN::Distrostatus->new("NO isa perl");
5296 delete $self->{force_update};
5301 !$self->{archived} || $self->{archived} eq "NO" and push @e,
5302 "Is neither a tar nor a zip archive.";
5304 !$self->{unwrapped} || $self->{unwrapped} eq "NO" and push @e,
5305 "Had problems unarchiving. Please build manually";
5307 unless ($self->{force_update}) {
5308 exists $self->{signature_verify} and (
5309 $self->{signature_verify}->can("failed") ?
5310 $self->{signature_verify}->failed :
5311 $self->{signature_verify} =~ /^NO/
5313 and push @e, "Did not pass the signature test.";
5316 if (exists $self->{writemakefile} &&
5318 $self->{writemakefile}->can("failed") ?
5319 $self->{writemakefile}->failed :
5320 $self->{writemakefile} =~ /^NO/
5322 # XXX maybe a retry would be in order?
5323 my $err = $self->{writemakefile}->can("text") ?
5324 $self->{writemakefile}->text :
5325 $self->{writemakefile};
5327 $err ||= "Had some problem writing Makefile";
5328 $err .= ", won't make";
5332 defined $self->{make} and push @e,
5333 "Has already been processed within this session";
5335 if (exists $self->{later} and length($self->{later})) {
5336 if ($self->unsat_prereq) {
5337 push @e, $self->{later};
5338 # RT ticket 18438 raises doubts if the deletion of {later} is valid.
5339 # YAML-0.53 triggered the later hodge-podge here, but my margin notes
5340 # are not sufficient to be sure if we really must/may do the delete
5341 # here. SO I accept the suggested patch for now. If we trigger a bug
5342 # again, I must go into deep contemplation about the {later} flag.
5345 # delete $self->{later};
5349 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5352 delete $self->{force_update};
5355 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
5356 my $builddir = $self->dir or
5357 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
5358 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
5359 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
5361 if ($^O eq 'MacOS') {
5362 Mac::BuildTools::make($self);
5367 if ($self->{'configure'}) {
5368 $system = $self->{'configure'};
5369 } elsif ($self->{modulebuild}) {
5370 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5371 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
5373 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5375 # This needs a handler that can be turned on or off:
5376 # $switch = "-MExtUtils::MakeMaker ".
5377 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
5379 $system = sprintf("%s%s Makefile.PL%s",
5381 $switch ? " $switch" : "",
5382 $CPAN::Config->{makepl_arg} ? " $CPAN::Config->{makepl_arg}" : "",
5385 unless (exists $self->{writemakefile}) {
5386 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
5389 if ($CPAN::Config->{inactivity_timeout}) {
5391 alarm $CPAN::Config->{inactivity_timeout};
5392 local $SIG{CHLD}; # = sub { wait };
5393 if (defined($pid = fork)) {
5398 # note, this exec isn't necessary if
5399 # inactivity_timeout is 0. On the Mac I'd
5400 # suggest, we set it always to 0.
5404 $CPAN::Frontend->myprint("Cannot fork: $!");
5412 $CPAN::Frontend->myprint($@);
5413 $self->{writemakefile} = CPAN::Distrostatus->new("NO $@");
5418 $ret = system($system);
5420 $self->{writemakefile} = CPAN::Distrostatus
5421 ->new("NO '$system' returned status $ret");
5425 if (-f "Makefile" || -f "Build") {
5426 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
5427 delete $self->{make_clean}; # if cleaned before, enable next
5429 $self->{writemakefile} = CPAN::Distrostatus
5430 ->new(qq{NO -- Unknown reason.});
5434 delete $self->{force_update};
5437 if (my @prereq = $self->unsat_prereq){
5438 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5440 # XXX modulebuild / make
5441 if ($self->{modulebuild}) {
5442 $system = sprintf "%s %s", $self->_build_command(), $CPAN::Config->{mbuild_arg};
5444 $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
5446 if (system($system) == 0) {
5447 $CPAN::Frontend->myprint(" $system -- OK\n");
5448 $self->{make} = CPAN::Distrostatus->new("YES");
5450 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
5451 $self->{make} = CPAN::Distrostatus->new("NO");
5452 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5462 $CPAN::Config->{make} || $Config::Config{make} || 'make'
5465 # Old style call, without object. Deprecated
5466 Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
5468 safe_quote(undef, $CPAN::Config->{make} || $Config::Config{make} || 'make');
5472 #-> sub CPAN::Distribution::follow_prereqs ;
5473 sub follow_prereqs {
5475 my(@prereq) = grep {$_ ne "perl"} @_;
5476 return unless @prereq;
5478 $CPAN::Frontend->myprint("---- Unsatisfied dependencies detected ".
5479 "during [$id] -----\n");
5481 for my $p (@prereq) {
5482 $CPAN::Frontend->myprint(" $p\n");
5485 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
5487 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
5488 my $answer = ExtUtils::MakeMaker::prompt(
5489 "Shall I follow them and prepend them to the queue
5490 of modules we are processing right now?", "yes");
5491 $follow = $answer =~ /^\s*y/i;
5495 myprint(" Ignoring dependencies on modules @prereq\n");
5498 # color them as dirty
5499 for my $p (@prereq) {
5500 # warn "calling color_cmd_tmps(0,1)";
5501 CPAN::Shell->expandany($p)->color_cmd_tmps(0,1);
5503 CPAN::Queue->jumpqueue(@prereq,$id); # queue them and requeue yourself
5504 $self->{later} = "Delayed until after prerequisites";
5505 return 1; # signal success to the queuerunner
5509 #-> sub CPAN::Distribution::unsat_prereq ;
5512 my $prereq_pm = $self->prereq_pm or return;
5514 NEED: while (my($need_module, $need_version) = each %$prereq_pm) {
5515 my $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
5516 # we were too demanding:
5517 next if $nmo->uptodate;
5519 # if they have not specified a version, we accept any installed one
5520 if (not defined $need_version or
5521 $need_version eq "0" or
5522 $need_version eq "undef") {
5523 next if defined $nmo->inst_file;
5526 # We only want to install prereqs if either they're not installed
5527 # or if the installed version is too old. We cannot omit this
5528 # check, because if 'force' is in effect, nobody else will check.
5529 if (defined $nmo->inst_file) {
5530 my(@all_requirements) = split /\s*,\s*/, $need_version;
5533 RQ: for my $rq (@all_requirements) {
5534 if ($rq =~ s|>=\s*||) {
5535 } elsif ($rq =~ s|>\s*||) {
5537 if (CPAN::Version->vgt($nmo->inst_version,$rq)){
5541 } elsif ($rq =~ s|!=\s*||) {
5543 if (CPAN::Version->vcmp($nmo->inst_version,$rq)){
5549 } elsif ($rq =~ m|<=?\s*|) {
5551 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])");
5555 if (! CPAN::Version->vgt($rq, $nmo->inst_version)){
5558 CPAN->debug(sprintf "id[%s]inst_file[%s]inst_version[%s]rq[%s]ok[%d]",
5562 CPAN::Version->readable($rq),
5566 next NEED if $ok == @all_requirements;
5569 if ($self->{sponsored_mods}{$need_module}++){
5570 # We have already sponsored it and for some reason it's still
5571 # not available. So we do nothing. Or what should we do?
5572 # if we push it again, we have a potential infinite loop
5575 push @need, $need_module;
5580 #-> sub CPAN::Distribution::read_yaml ;
5583 return $self->{yaml_content} if exists $self->{yaml_content};
5584 my $build_dir = $self->{build_dir};
5585 my $yaml = File::Spec->catfile($build_dir,"META.yml");
5586 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
5587 return unless -f $yaml;
5588 if ($CPAN::META->has_inst("YAML")) {
5589 eval { $self->{yaml_content} = YAML::LoadFile($yaml); };
5591 $CPAN::Frontend->mywarn("Error while parsing META.yml: $@");
5594 if (not exists $self->{yaml_content}{dynamic_config}
5595 or $self->{yaml_content}{dynamic_config}
5597 $self->{yaml_content} = undef;
5600 $self->debug("yaml_content[$self->{yaml_content}]") if $CPAN::DEBUG;
5601 return $self->{yaml_content};
5604 #-> sub CPAN::Distribution::prereq_pm ;
5607 return $self->{prereq_pm} if
5608 exists $self->{prereq_pm_detected} && $self->{prereq_pm_detected};
5609 return unless $self->{writemakefile} # no need to have succeeded
5610 # but we must have run it
5611 || $self->{modulebuild};
5613 if (my $yaml = $self->read_yaml) {
5614 $req = $yaml->{requires};
5615 undef $req unless ref $req eq "HASH" && %$req;
5617 if ($yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
5618 my $eummv = do { local $^W = 0; $1+0; };
5619 if ($eummv < 6.2501) {
5620 # thanks to Slaven for digging that out: MM before
5621 # that could be wrong because it could reflect a
5628 while (my($k,$v) = each %{$req||{}}) {
5631 } elsif ($k =~ /[A-Za-z]/ &&
5633 $CPAN::META->exists("Module",$v)
5635 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
5636 "requires hash: $k => $v; I'll take both ".
5637 "key and value as a module name\n");
5644 $req = $areq if $do_replace;
5646 if ($yaml->{build_requires}
5647 && ref $yaml->{build_requires}
5648 && ref $yaml->{build_requires} eq "HASH") {
5649 while (my($k,$v) = each %{$yaml->{build_requires}}) {
5651 # merging of two "requires"-type values--what should we do?
5658 delete $req->{perl};
5662 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
5663 my $makefile = File::Spec->catfile($build_dir,"Makefile");
5667 $fh = FileHandle->new("<$makefile\0")) {
5670 last if /MakeMaker post_initialize section/;
5672 \s+PREREQ_PM\s+=>\s+(.+)
5675 # warn "Found prereq expr[$p]";
5677 # Regexp modified by A.Speer to remember actual version of file
5678 # PREREQ_PM hash key wants, then add to
5679 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){
5680 # In case a prereq is mentioned twice, complain.
5681 if ( defined $req->{$1} ) {
5682 warn "Warning: PREREQ_PM mentions $1 more than once, ".
5683 "last mention wins";
5689 } elsif (-f "Build") {
5690 if ($CPAN::META->has_inst("Module::Build")) {
5691 my $requires = Module::Build->current->requires();
5692 my $brequires = Module::Build->current->build_requires();
5693 $req = { %$requires, %$brequires };
5697 if (-f "Build.PL" && ! -f "Makefile.PL" && ! exists $req->{"Module::Build"}) {
5698 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
5699 "undeclared prerequisite.\n".
5700 " Adding it now as a prerequisite.\n"
5702 $CPAN::Frontend->mysleep(5);
5703 $req->{"Module::Build"} = 0;
5704 delete $self->{writemakefile};
5706 $self->{prereq_pm_detected}++;
5707 return $self->{prereq_pm} = $req;
5710 #-> sub CPAN::Distribution::test ;
5715 delete $self->{force_update};
5718 # warn "XDEBUG: checking for notest: $self->{notest} $self";
5719 if ($self->{notest}) {
5720 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
5724 my $make = $self->{modulebuild} ? "Build" : "make";
5725 $CPAN::Frontend->myprint("Running $make test\n");
5726 if (my @prereq = $self->unsat_prereq){
5727 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5731 unless (exists $self->{make} or exists $self->{later}) {
5733 "Make had some problems, won't test";
5736 exists $self->{make} and
5738 $self->{make}->can("failed") ?
5739 $self->{make}->failed :
5740 $self->{make} =~ /^NO/
5741 ) and push @e, "Can't test without successful make";
5743 exists $self->{build_dir} or push @e, "Has no own directory";
5744 $self->{badtestcnt} ||= 0;
5745 $self->{badtestcnt} > 0 and
5746 push @e, "Won't repeat unsuccessful test during this command";
5748 exists $self->{later} and length($self->{later}) and
5749 push @e, $self->{later};
5751 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5753 chdir $self->{'build_dir'} or
5754 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5755 $self->debug("Changed directory to $self->{'build_dir'}")
5758 if ($^O eq 'MacOS') {
5759 Mac::BuildTools::make_test($self);
5763 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
5765 : ($ENV{PERLLIB} || "");
5767 $CPAN::META->set_perl5lib;
5768 local $ENV{MAKEFLAGS}; # protect us from outer make calls
5771 if ($self->{modulebuild}) {
5772 $system = sprintf "%s test", $self->_build_command();
5774 $system = join " ", $self->_make_command(), "test";
5776 if (system($system) == 0) {
5777 $CPAN::Frontend->myprint(" $system -- OK\n");
5778 $CPAN::META->is_tested($self->{'build_dir'});
5779 $self->{make_test} = CPAN::Distrostatus->new("YES");
5781 $self->{make_test} = CPAN::Distrostatus->new("NO");
5782 $self->{badtestcnt}++;
5783 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5787 #-> sub CPAN::Distribution::clean ;
5790 my $make = $self->{modulebuild} ? "Build" : "make";
5791 $CPAN::Frontend->myprint("Running $make clean\n");
5792 unless (exists $self->{archived}) {
5793 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
5794 "/untarred, nothing done\n");
5797 unless (exists $self->{build_dir}) {
5798 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
5803 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
5804 push @e, "make clean already called once";
5805 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5807 chdir $self->{'build_dir'} or
5808 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5809 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
5811 if ($^O eq 'MacOS') {
5812 Mac::BuildTools::make_clean($self);
5817 if ($self->{modulebuild}) {
5818 $system = sprintf "%s clean", $self->_build_command();
5820 $system = join " ", $self->_make_command(), "clean";
5822 if (system($system) == 0) {
5823 $CPAN::Frontend->myprint(" $system -- OK\n");
5827 # Jost Krieger pointed out that this "force" was wrong because
5828 # it has the effect that the next "install" on this distribution
5829 # will untar everything again. Instead we should bring the
5830 # object's state back to where it is after untarring.
5841 $self->{make_clean} = CPAN::Distrostatus->new("YES");
5844 # Hmmm, what to do if make clean failed?
5846 $self->{make_clean} = CPAN::Distrostatus->new("NO");
5847 $CPAN::Frontend->myprint(qq{ $system -- NOT OK\n});
5849 # 2006-02-27: seems silly to me to force a make now
5850 # $self->force("make"); # so that this directory won't be used again
5855 #-> sub CPAN::Distribution::install ;
5860 delete $self->{force_update};
5863 my $make = $self->{modulebuild} ? "Build" : "make";
5864 $CPAN::Frontend->myprint("Running $make install\n");
5867 exists $self->{build_dir} or push @e, "Has no own directory";
5869 unless (exists $self->{make} or exists $self->{later}) {
5871 "Make had some problems, won't install";
5874 exists $self->{make} and
5876 $self->{make}->can("failed") ?
5877 $self->{make}->failed :
5878 $self->{make} =~ /^NO/
5880 push @e, "make had returned bad status, install seems impossible";
5882 if (exists $self->{make_test} and
5884 $self->{make_test}->can("failed") ?
5885 $self->{make_test}->failed :
5886 $self->{make_test} =~ /^NO/
5888 if ($self->{force_update}) {
5889 $self->{make_test}->text("FAILED but failure ignored because ".
5890 "'force' in effect");
5892 push @e, "make test had returned bad status, ".
5893 "won't install without force"
5896 if (exists $self->{'install'}) {
5897 if ($self->{'install'}->can("text") ?
5898 $self->{'install'}->text eq "YES" :
5899 $self->{'install'} =~ /^YES/
5901 push @e, "Already done";
5903 # comment in Todo on 2006-02-11; maybe retry?
5904 push @e, "Already tried without success";
5908 exists $self->{later} and length($self->{later}) and
5909 push @e, $self->{later};
5911 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5913 chdir $self->{'build_dir'} or
5914 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5915 $self->debug("Changed directory to $self->{'build_dir'}")
5918 if ($^O eq 'MacOS') {
5919 Mac::BuildTools::make_install($self);
5924 if ($self->{modulebuild}) {
5925 my($mbuild_install_build_command) =
5926 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
5927 $CPAN::Config->{mbuild_install_build_command} ?
5928 $CPAN::Config->{mbuild_install_build_command} :
5929 $self->_build_command();
5930 $system = sprintf("%s install %s",
5931 $mbuild_install_build_command,
5932 $CPAN::Config->{mbuild_install_arg},
5935 my($make_install_make_command) = $CPAN::Config->{make_install_make_command} ||
5936 $self->_make_command();
5937 $system = sprintf("%s install %s",
5938 $make_install_make_command,
5939 $CPAN::Config->{make_install_arg},
5943 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
5944 my($pipe) = FileHandle->new("$system $stderr |");
5947 $CPAN::Frontend->myprint($_);
5952 $CPAN::Frontend->myprint(" $system -- OK\n");
5953 $CPAN::META->is_installed($self->{build_dir});
5954 return $self->{install} = CPAN::Distrostatus->new("YES");
5956 $self->{install} = CPAN::Distrostatus->new("NO");
5957 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5959 $makeout =~ /permission/s
5962 ! $CPAN::Config->{make_install_make_command}
5963 || $CPAN::Config->{make_install_make_command} eq $CPAN::Config->{make}
5966 $CPAN::Frontend->myprint(
5968 qq{ You may have to su }.
5969 qq{to root to install the package\n}.
5970 qq{ (Or you may want to run something like\n}.
5971 qq{ o conf make_install_make_command 'sudo make'\n}.
5972 qq{ to raise your permissions.}
5976 delete $self->{force_update};
5979 #-> sub CPAN::Distribution::dir ;
5981 shift->{'build_dir'};
5984 #-> sub CPAN::Distribution::perldoc ;
5988 my($dist) = $self->id;
5989 my $package = $self->called_for;
5991 $self->_display_url( $CPAN::Defaultdocs . $package );
5994 #-> sub CPAN::Distribution::_check_binary ;
5996 my ($dist,$shell,$binary) = @_;
5999 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
6003 $pid = open README, "which $binary|"
6004 or $CPAN::Frontend->mydie(qq{Could not fork 'which $binary': $!});
6008 close README or die "Could not run 'which $binary': $!";
6010 $CPAN::Frontend->myprint(qq{ + $out \n})
6011 if $CPAN::DEBUG && $out;
6016 #-> sub CPAN::Distribution::_display_url ;
6018 my($self,$url) = @_;
6019 my($res,$saved_file,$pid,$out);
6021 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
6024 # should we define it in the config instead?
6025 my $html_converter = "html2text";
6027 my $web_browser = $CPAN::Config->{'lynx'} || undef;
6028 my $web_browser_out = $web_browser
6029 ? CPAN::Distribution->_check_binary($self,$web_browser)
6032 if ($web_browser_out) {
6033 # web browser found, run the action
6034 my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
6035 $CPAN::Frontend->myprint(qq{system[$browser $url]})
6037 $CPAN::Frontend->myprint(qq{
6040 with browser $browser
6043 system("$browser $url");
6044 if ($saved_file) { 1 while unlink($saved_file) }
6046 # web browser not found, let's try text only
6047 my $html_converter_out =
6048 CPAN::Distribution->_check_binary($self,$html_converter);
6049 $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
6051 if ($html_converter_out ) {
6052 # html2text found, run it
6053 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
6054 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
6055 unless defined($saved_file);
6058 $pid = open README, "$html_converter $saved_file |"
6059 or $CPAN::Frontend->mydie(qq{
6060 Could not fork '$html_converter $saved_file': $!});
6062 if ($CPAN::META->has_inst("File::Temp")) {
6063 $fh = File::Temp->new(
6064 template => 'cpan_htmlconvert_XXXX',
6068 $filename = $fh->filename;
6070 $filename = "cpan_htmlconvert_$$.txt";
6071 $fh = FileHandle->new();
6072 open $fh, ">$filename" or die;
6078 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
6079 my $tmpin = $fh->filename;
6080 $CPAN::Frontend->myprint(sprintf(qq{
6082 saved output to %s\n},
6090 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
6091 my $fh_pager = FileHandle->new;
6092 local($SIG{PIPE}) = "IGNORE";
6093 my $pager = $CPAN::Config->{'pager'} || "cat";
6094 $fh_pager->open("|pager")
6095 or $CPAN::Frontend->mydie(qq{
6096 Could not open pager $pager\: $!});
6097 $CPAN::Frontend->myprint(qq{
6103 $fh_pager->print(<FH>);
6106 # coldn't find the web browser or html converter
6107 $CPAN::Frontend->myprint(qq{
6108 You need to install lynx or $html_converter to use this feature.});
6113 #-> sub CPAN::Distribution::_getsave_url ;
6115 my($dist, $shell, $url) = @_;
6117 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
6121 if ($CPAN::META->has_inst("File::Temp")) {
6122 $fh = File::Temp->new(
6123 template => "cpan_getsave_url_XXXX",
6127 $filename = $fh->filename;
6129 $fh = FileHandle->new;
6130 $filename = "cpan_getsave_url_$$.html";
6132 my $tmpin = $filename;
6133 if ($CPAN::META->has_usable('LWP')) {
6134 $CPAN::Frontend->myprint("Fetching with LWP:
6138 CPAN::LWP::UserAgent->config;
6139 eval { $Ua = CPAN::LWP::UserAgent->new; };
6141 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
6145 $Ua->proxy('http', $var)
6146 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
6148 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
6151 my $req = HTTP::Request->new(GET => $url);
6152 $req->header('Accept' => 'text/html');
6153 my $res = $Ua->request($req);
6154 if ($res->is_success) {
6155 $CPAN::Frontend->myprint(" + request successful.\n")
6157 print $fh $res->content;
6159 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
6163 $CPAN::Frontend->myprint(sprintf(
6164 "LWP failed with code[%s], message[%s]\n",
6171 $CPAN::Frontend->myprint("LWP not available\n");
6176 # sub CPAN::Distribution::_build_command
6177 sub _build_command {
6179 if ($^O eq "MSWin32") { # special code needed at least up to
6180 # Module::Build 0.2611 and 0.2706; a fix
6181 # in M:B has been promised 2006-01-30
6183 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
6184 return "$perl ./Build";
6189 package CPAN::Bundle;
6194 $CPAN::Frontend->myprint($self->as_string);
6199 delete $self->{later};
6200 for my $c ( $self->contains ) {
6201 my $obj = CPAN::Shell->expandany($c) or next;
6206 # mark as dirty/clean
6207 #-> sub CPAN::Bundle::color_cmd_tmps ;
6208 sub color_cmd_tmps {
6210 my($depth) = shift || 0;
6211 my($color) = shift || 0;
6212 my($ancestors) = shift || [];
6213 # a module needs to recurse to its cpan_file, a distribution needs
6214 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
6216 return if exists $self->{incommandcolor}
6217 && $self->{incommandcolor}==$color;
6219 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
6221 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
6223 for my $c ( $self->contains ) {
6224 my $obj = CPAN::Shell->expandany($c) or next;
6225 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
6226 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
6229 delete $self->{badtestcnt};
6231 $self->{incommandcolor} = $color;
6234 #-> sub CPAN::Bundle::as_string ;
6238 # following line must be "=", not "||=" because we have a moving target
6239 $self->{INST_VERSION} = $self->inst_version;
6240 return $self->SUPER::as_string;
6243 #-> sub CPAN::Bundle::contains ;
6246 my($inst_file) = $self->inst_file || "";
6247 my($id) = $self->id;
6248 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
6249 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
6252 unless ($inst_file) {
6253 # Try to get at it in the cpan directory
6254 $self->debug("no inst_file") if $CPAN::DEBUG;
6256 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
6257 $cpan_file = $self->cpan_file;
6258 if ($cpan_file eq "N/A") {
6259 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
6260 Maybe stale symlink? Maybe removed during session? Giving up.\n");
6262 my $dist = $CPAN::META->instance('CPAN::Distribution',
6265 $self->debug("id[$dist->{ID}]") if $CPAN::DEBUG;
6266 my($todir) = $CPAN::Config->{'cpan_home'};
6267 my(@me,$from,$to,$me);
6268 @me = split /::/, $self->id;
6270 $me = File::Spec->catfile(@me);
6271 $from = $self->find_bundle_file($dist->{'build_dir'},join('/',@me));
6272 $to = File::Spec->catfile($todir,$me);
6273 File::Path::mkpath(File::Basename::dirname($to));
6274 File::Copy::copy($from, $to)
6275 or Carp::confess("Couldn't copy $from to $to: $!");
6279 my $fh = FileHandle->new;
6281 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
6283 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
6285 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
6286 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
6287 next unless $in_cont;
6292 push @result, (split " ", $_, 2)[0];
6295 delete $self->{STATUS};
6296 $self->{CONTAINS} = \@result;
6297 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
6299 $CPAN::Frontend->mywarn(qq{
6300 The bundle file "$inst_file" may be a broken
6301 bundlefile. It seems not to contain any bundle definition.
6302 Please check the file and if it is bogus, please delete it.
6303 Sorry for the inconvenience.
6309 #-> sub CPAN::Bundle::find_bundle_file
6310 # $where is in local format, $what is in unix format
6311 sub find_bundle_file {
6312 my($self,$where,$what) = @_;
6313 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
6314 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
6315 ### my $bu = File::Spec->catfile($where,$what);
6316 ### return $bu if -f $bu;
6317 my $manifest = File::Spec->catfile($where,"MANIFEST");
6318 unless (-f $manifest) {
6319 require ExtUtils::Manifest;
6320 my $cwd = CPAN::anycwd();
6321 $self->safe_chdir($where);
6322 ExtUtils::Manifest::mkmanifest();
6323 $self->safe_chdir($cwd);
6325 my $fh = FileHandle->new($manifest)
6326 or Carp::croak("Couldn't open $manifest: $!");
6328 my $bundle_filename = $what;
6329 $bundle_filename =~ s|Bundle.*/||;
6330 my $bundle_unixpath;
6333 my($file) = /(\S+)/;
6334 if ($file =~ m|\Q$what\E$|) {
6335 $bundle_unixpath = $file;
6336 # return File::Spec->catfile($where,$bundle_unixpath); # bad
6339 # retry if she managed to have no Bundle directory
6340 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
6342 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
6343 if $bundle_unixpath;
6344 Carp::croak("Couldn't find a Bundle file in $where");
6347 # needs to work quite differently from Module::inst_file because of
6348 # cpan_home/Bundle/ directory and the possibility that we have
6349 # shadowing effect. As it makes no sense to take the first in @INC for
6350 # Bundles, we parse them all for $VERSION and take the newest.
6352 #-> sub CPAN::Bundle::inst_file ;
6357 @me = split /::/, $self->id;
6360 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
6361 my $bfile = File::Spec->catfile($incdir, @me);
6362 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
6363 next unless -f $bfile;
6364 my $foundv = MM->parse_version($bfile);
6365 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
6366 $self->{INST_FILE} = $bfile;
6367 $self->{INST_VERSION} = $bestv = $foundv;
6373 #-> sub CPAN::Bundle::inst_version ;
6376 $self->inst_file; # finds INST_VERSION as side effect
6377 $self->{INST_VERSION};
6380 #-> sub CPAN::Bundle::rematein ;
6382 my($self,$meth) = @_;
6383 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
6384 my($id) = $self->id;
6385 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
6386 unless $self->inst_file || $self->cpan_file;
6388 for $s ($self->contains) {
6389 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
6390 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
6391 if ($type eq 'CPAN::Distribution') {
6392 $CPAN::Frontend->mywarn(qq{
6393 The Bundle }.$self->id.qq{ contains
6394 explicitly a file $s.
6398 # possibly noisy action:
6399 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
6400 my $obj = $CPAN::META->instance($type,$s);
6402 if ($obj->isa('CPAN::Bundle')
6404 exists $obj->{install_failed}
6406 ref($obj->{install_failed}) eq "HASH"
6408 for (keys %{$obj->{install_failed}}) {
6409 $self->{install_failed}{$_} = undef; # propagate faiure up
6412 $fail{$s} = 1; # the bundle itself may have succeeded but
6417 $success = $obj->can("uptodate") ? $obj->uptodate : 0;
6418 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
6420 delete $self->{install_failed}{$s};
6427 # recap with less noise
6428 if ( $meth eq "install" ) {
6431 my $raw = sprintf(qq{Bundle summary:
6432 The following items in bundle %s had installation problems:},
6435 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
6436 $CPAN::Frontend->myprint("\n");
6439 for $s ($self->contains) {
6441 $paragraph .= "$s ";
6442 $self->{install_failed}{$s} = undef;
6443 $reported{$s} = undef;
6446 my $report_propagated;
6447 for $s (sort keys %{$self->{install_failed}}) {
6448 next if exists $reported{$s};
6449 $paragraph .= "and the following items had problems
6450 during recursive bundle calls: " unless $report_propagated++;
6451 $paragraph .= "$s ";
6453 $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
6454 $CPAN::Frontend->myprint("\n");
6456 $self->{'install'} = 'YES';
6461 # If a bundle contains another that contains an xs_file we have here,
6462 # we just don't bother I suppose
6463 #-> sub CPAN::Bundle::xs_file
6468 #-> sub CPAN::Bundle::force ;
6469 sub force { shift->rematein('force',@_); }
6470 #-> sub CPAN::Bundle::notest ;
6471 sub notest { shift->rematein('notest',@_); }
6472 #-> sub CPAN::Bundle::get ;
6473 sub get { shift->rematein('get',@_); }
6474 #-> sub CPAN::Bundle::make ;
6475 sub make { shift->rematein('make',@_); }
6476 #-> sub CPAN::Bundle::test ;
6479 $self->{badtestcnt} ||= 0;
6480 $self->rematein('test',@_);
6482 #-> sub CPAN::Bundle::install ;
6485 $self->rematein('install',@_);
6487 #-> sub CPAN::Bundle::clean ;
6488 sub clean { shift->rematein('clean',@_); }
6490 #-> sub CPAN::Bundle::uptodate ;
6493 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
6495 foreach $c ($self->contains) {
6496 my $obj = CPAN::Shell->expandany($c);
6497 return 0 unless $obj->uptodate;
6502 #-> sub CPAN::Bundle::readme ;
6505 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
6506 No File found for bundle } . $self->id . qq{\n}), return;
6507 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
6508 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
6511 package CPAN::Module;
6515 # sub CPAN::Module::userid
6520 return $ro->{userid} || $ro->{CPAN_USERID};
6522 # sub CPAN::Module::description
6525 my $ro = $self->ro or return "";
6531 CPAN::Shell->expand("Distribution",$self->cpan_file);
6534 # sub CPAN::Module::undelay
6537 delete $self->{later};
6538 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
6543 # mark as dirty/clean
6544 #-> sub CPAN::Module::color_cmd_tmps ;
6545 sub color_cmd_tmps {
6547 my($depth) = shift || 0;
6548 my($color) = shift || 0;
6549 my($ancestors) = shift || [];
6550 # a module needs to recurse to its cpan_file
6552 return if exists $self->{incommandcolor}
6553 && $self->{incommandcolor}==$color;
6554 return if $depth>=1 && $self->uptodate;
6556 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
6558 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
6560 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
6561 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
6564 delete $self->{badtestcnt};
6566 $self->{incommandcolor} = $color;
6569 #-> sub CPAN::Module::as_glimpse ;
6573 my $class = ref($self);
6574 $class =~ s/^CPAN:://;
6578 $CPAN::Shell::COLOR_REGISTERED
6580 $CPAN::META->has_inst("Term::ANSIColor")
6584 $color_on = Term::ANSIColor::color("green");
6585 $color_off = Term::ANSIColor::color("reset");
6587 my $uptodateness = " ";
6588 if ($class eq "Bundle") {
6589 } elsif ($self->uptodate) {
6590 $uptodateness = "=";
6591 } elsif ($self->inst_version) {
6592 $uptodateness = "<";
6594 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
6600 ($self->distribution ?
6601 $self->distribution->pretty_id :
6608 #-> sub CPAN::Module::dslip_status
6612 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
6613 pre-alpha alpha beta released
6615 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
6616 developer comp.lang.perl.*
6618 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
6619 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
6621 object-oriented pragma
6623 @{$stat->{P}}{qw,p g l b a o d r n,} = qw,Standard-Perl
6627 distribution_allowed
6628 restricted_distribution
6630 for my $x (qw(d s l i p)) {
6631 $stat->{$x}{' '} = 'unknown';
6632 $stat->{$x}{'?'} = 'unknown';
6635 return +{} unless $ro && $ro->{statd};
6642 DV => $stat->{D}{$ro->{statd}},
6643 SV => $stat->{S}{$ro->{stats}},
6644 LV => $stat->{L}{$ro->{statl}},
6645 IV => $stat->{I}{$ro->{stati}},
6646 PV => $stat->{P}{$ro->{statp}},
6650 #-> sub CPAN::Module::as_string ;
6654 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
6655 my $class = ref($self);
6656 $class =~ s/^CPAN:://;
6658 push @m, $class, " id = $self->{ID}\n";
6659 my $sprintf = " %-12s %s\n";
6660 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
6661 if $self->description;
6662 my $sprintf2 = " %-12s %s (%s)\n";
6664 $userid = $self->userid;
6667 if ($author = CPAN::Shell->expand('Author',$userid)) {
6670 if ($m = $author->email) {
6677 $author->fullname . $email
6681 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
6682 if $self->cpan_version;
6683 if (my $cpan_file = $self->cpan_file){
6684 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
6685 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
6686 my $upload_date = $dist->upload_date;
6688 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
6692 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
6693 my $dslip = $self->dslip_status;
6697 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
6699 my $local_file = $self->inst_file;
6700 unless ($self->{MANPAGE}) {
6703 $manpage = $self->manpage_headline($local_file);
6705 # If we have already untarred it, we should look there
6706 my $dist = $CPAN::META->instance('CPAN::Distribution',
6708 # warn "dist[$dist]";
6709 # mff=manifest file; mfh=manifest handle
6714 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
6716 $mfh = FileHandle->new($mff)
6718 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
6719 my $lfre = $self->id; # local file RE
6722 my($lfl); # local file file
6724 my(@mflines) = <$mfh>;
6729 while (length($lfre)>5 and !$lfl) {
6730 ($lfl) = grep /$lfre/, @mflines;
6731 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
6734 $lfl =~ s/\s.*//; # remove comments
6735 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
6736 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
6737 # warn "lfl_abs[$lfl_abs]";
6739 $manpage = $self->manpage_headline($lfl_abs);
6743 $self->{MANPAGE} = $manpage if $manpage;
6746 for $item (qw/MANPAGE/) {
6747 push @m, sprintf($sprintf, $item, $self->{$item})
6748 if exists $self->{$item};
6750 for $item (qw/CONTAINS/) {
6751 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
6752 if exists $self->{$item} && @{$self->{$item}};
6754 push @m, sprintf($sprintf, 'INST_FILE',
6755 $local_file || "(not installed)");
6756 push @m, sprintf($sprintf, 'INST_VERSION',
6757 $self->inst_version) if $local_file;
6761 sub manpage_headline {
6762 my($self,$local_file) = @_;
6763 my(@local_file) = $local_file;
6764 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
6765 push @local_file, $local_file;
6767 for $locf (@local_file) {
6768 next unless -f $locf;
6769 my $fh = FileHandle->new($locf)
6770 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
6774 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
6775 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
6792 #-> sub CPAN::Module::cpan_file ;
6793 # Note: also inherited by CPAN::Bundle
6796 CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
6797 unless ($self->ro) {
6798 CPAN::Index->reload;
6801 if ($ro && defined $ro->{CPAN_FILE}){
6802 return $ro->{CPAN_FILE};
6804 my $userid = $self->userid;
6806 if ($CPAN::META->exists("CPAN::Author",$userid)) {
6807 my $author = $CPAN::META->instance("CPAN::Author",
6809 my $fullname = $author->fullname;
6810 my $email = $author->email;
6811 unless (defined $fullname && defined $email) {
6812 return sprintf("Contact Author %s",
6816 return "Contact Author $fullname <$email>";
6818 return "Contact Author $userid (Email address not available)";
6826 #-> sub CPAN::Module::cpan_version ;
6832 # Can happen with modules that are not on CPAN
6835 $ro->{CPAN_VERSION} = 'undef'
6836 unless defined $ro->{CPAN_VERSION};
6837 $ro->{CPAN_VERSION};
6840 #-> sub CPAN::Module::force ;
6843 $self->{'force_update'}++;
6848 # warn "XDEBUG: set notest for Module";
6849 $self->{'notest'}++;
6852 #-> sub CPAN::Module::rematein ;
6854 my($self,$meth) = @_;
6855 $CPAN::Frontend->myprint(sprintf("Running %s for module %s\n",
6858 my $cpan_file = $self->cpan_file;
6859 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
6860 $CPAN::Frontend->mywarn(sprintf qq{
6861 The module %s isn\'t available on CPAN.
6863 Either the module has not yet been uploaded to CPAN, or it is
6864 temporary unavailable. Please contact the author to find out
6865 more about the status. Try 'i %s'.
6872 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
6873 $pack->called_for($self->id);
6874 $pack->force($meth) if exists $self->{'force_update'};
6875 $pack->notest($meth) if exists $self->{'notest'};
6880 $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
6881 $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
6882 delete $self->{'force_update'};
6883 delete $self->{'notest'};
6889 #-> sub CPAN::Module::perldoc ;
6890 sub perldoc { shift->rematein('perldoc') }
6891 #-> sub CPAN::Module::readme ;
6892 sub readme { shift->rematein('readme') }
6893 #-> sub CPAN::Module::look ;
6894 sub look { shift->rematein('look') }
6895 #-> sub CPAN::Module::cvs_import ;
6896 sub cvs_import { shift->rematein('cvs_import') }
6897 #-> sub CPAN::Module::get ;
6898 sub get { shift->rematein('get',@_) }
6899 #-> sub CPAN::Module::make ;
6900 sub make { shift->rematein('make') }
6901 #-> sub CPAN::Module::test ;
6904 $self->{badtestcnt} ||= 0;
6905 $self->rematein('test',@_);
6907 #-> sub CPAN::Module::uptodate ;
6910 my($latest) = $self->cpan_version;
6912 my($inst_file) = $self->inst_file;
6914 if (defined $inst_file) {
6915 $have = $self->inst_version;
6920 ! CPAN::Version->vgt($latest, $have)
6922 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
6923 "latest[$latest] have[$have]") if $CPAN::DEBUG;
6928 #-> sub CPAN::Module::install ;
6934 not exists $self->{'force_update'}
6936 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
6938 $self->inst_version,
6944 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
6945 $CPAN::Frontend->mywarn(qq{
6946 \n\n\n ***WARNING***
6947 The module $self->{ID} has no active maintainer.\n\n\n
6951 $self->rematein('install') if $doit;
6953 #-> sub CPAN::Module::clean ;
6954 sub clean { shift->rematein('clean') }
6956 #-> sub CPAN::Module::inst_file ;
6960 @packpath = split /::/, $self->{ID};
6961 $packpath[-1] .= ".pm";
6962 foreach $dir (@INC) {
6963 my $pmfile = File::Spec->catfile($dir,@packpath);
6971 #-> sub CPAN::Module::xs_file ;
6975 @packpath = split /::/, $self->{ID};
6976 push @packpath, $packpath[-1];
6977 $packpath[-1] .= "." . $Config::Config{'dlext'};
6978 foreach $dir (@INC) {
6979 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
6987 #-> sub CPAN::Module::inst_version ;
6990 my $parsefile = $self->inst_file or return;
6991 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
6994 $have = MM->parse_version($parsefile) || "undef";
6995 $have =~ s/^ //; # since the %vd hack these two lines here are needed
6996 $have =~ s/ $//; # trailing whitespace happens all the time
6998 # My thoughts about why %vd processing should happen here
7000 # Alt1 maintain it as string with leading v:
7001 # read index files do nothing
7002 # compare it use utility for compare
7003 # print it do nothing
7005 # Alt2 maintain it as what it is
7006 # read index files convert
7007 # compare it use utility because there's still a ">" vs "gt" issue
7008 # print it use CPAN::Version for print
7010 # Seems cleaner to hold it in memory as a string starting with a "v"
7012 # If the author of this module made a mistake and wrote a quoted
7013 # "v1.13" instead of v1.13, we simply leave it at that with the
7014 # effect that *we* will treat it like a v-tring while the rest of
7015 # perl won't. Seems sensible when we consider that any action we
7016 # could take now would just add complexity.
7018 $have = CPAN::Version->readable($have);
7020 $have =~ s/\s*//g; # stringify to float around floating point issues
7021 $have; # no stringify needed, \s* above matches always
7034 CPAN - query, download and build perl modules from CPAN sites
7040 perl -MCPAN -e shell;
7048 $mod = "Acme::Meta";
7050 CPAN::Shell->install($mod); # same thing
7051 CPAN::Shell->expandany($mod)->install; # same thing
7052 CPAN::Shell->expand("Module",$mod)->install; # same thing
7053 CPAN::Shell->expand("Module",$mod)
7054 ->distribution->install; # same thing
7058 $distro = "NWCLARK/Acme-Meta-0.01.tar.gz";
7059 install $distro; # same thing
7060 CPAN::Shell->install($distro); # same thing
7061 CPAN::Shell->expandany($distro)->install; # same thing
7062 CPAN::Shell->expand("Module",$distro)->install; # same thing
7066 This module will eventually be replaced by CPANPLUS. CPANPLUS is kind
7067 of a modern rewrite from ground up with greater extensibility and more
7068 features but no full compatibility. If you're new to CPAN.pm, you
7069 probably should investigate if CPANPLUS is the better choice for you.
7071 If you're already used to CPAN.pm you're welcome to continue using it.
7072 I intend to support it until somebody convinces me that there is a
7073 both superior and sufficiently compatible drop-in replacement.
7075 =head1 COMPATIBILITY
7077 CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
7078 newer versions. It is getting more and more difficult to get the
7079 minimal prerequisites working on older perls. It is close to
7080 impossible to get the whole Bundle::CPAN working there. If you're in
7081 the position to have only these old versions, be advised that CPAN is
7082 designed to work fine without the Bundle::CPAN installed.
7084 To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
7085 compatible with ancient perls and that File::Temp is listed as a
7086 prerequisite but CPAN has reasonable workarounds if it is missing.
7090 The CPAN module is designed to automate the make and install of perl
7091 modules and extensions. It includes some primitive searching
7092 capabilities and knows how to use Net::FTP or LWP (or some external
7093 download clients) to fetch the raw data from the net.
7095 Modules are fetched from one or more of the mirrored CPAN
7096 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
7099 The CPAN module also supports the concept of named and versioned
7100 I<bundles> of modules. Bundles simplify the handling of sets of
7101 related modules. See Bundles below.
7103 The package contains a session manager and a cache manager. There is
7104 no status retained between sessions. The session manager keeps track
7105 of what has been fetched, built and installed in the current
7106 session. The cache manager keeps track of the disk space occupied by
7107 the make processes and deletes excess space according to a simple FIFO
7110 All methods provided are accessible in a programmer style and in an
7111 interactive shell style.
7113 =head2 Interactive Mode
7115 The interactive mode is entered by running
7117 perl -MCPAN -e shell
7119 which puts you into a readline interface. You will have the most fun if
7120 you install Term::ReadKey and Term::ReadLine to enjoy both history and
7123 Once you are on the command line, type 'h' and the rest should be
7126 The function call C<shell> takes two optional arguments, one is the
7127 prompt, the second is the default initial command line (the latter
7128 only works if a real ReadLine interface module is installed).
7130 The most common uses of the interactive modes are
7134 =item Searching for authors, bundles, distribution files and modules
7136 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
7137 for each of the four categories and another, C<i> for any of the
7138 mentioned four. Each of the four entities is implemented as a class
7139 with slightly differing methods for displaying an object.
7141 Arguments you pass to these commands are either strings exactly matching
7142 the identification string of an object or regular expressions that are
7143 then matched case-insensitively against various attributes of the
7144 objects. The parser recognizes a regular expression only if you
7145 enclose it between two slashes.
7147 The principle is that the number of found objects influences how an
7148 item is displayed. If the search finds one item, the result is
7149 displayed with the rather verbose method C<as_string>, but if we find
7150 more than one, we display each object with the terse method
7153 =item make, test, install, clean modules or distributions
7155 These commands take any number of arguments and investigate what is
7156 necessary to perform the action. If the argument is a distribution
7157 file name (recognized by embedded slashes), it is processed. If it is
7158 a module, CPAN determines the distribution file in which this module
7159 is included and processes that, following any dependencies named in
7160 the module's META.yml or Makefile.PL (this behavior is controlled by
7161 the configuration parameter C<prerequisites_policy>.)
7163 Any C<make> or C<test> are run unconditionally. An
7165 install <distribution_file>
7167 also is run unconditionally. But for
7171 CPAN checks if an install is actually needed for it and prints
7172 I<module up to date> in the case that the distribution file containing
7173 the module doesn't need to be updated.
7175 CPAN also keeps track of what it has done within the current session
7176 and doesn't try to build a package a second time regardless if it
7177 succeeded or not. The C<force> pragma may precede another command
7178 (currently: C<make>, C<test>, or C<install>) and executes the
7179 command from scratch and tries to continue in case of some errors.
7183 cpan> install OpenGL
7184 OpenGL is up to date.
7185 cpan> force install OpenGL
7188 OpenGL-0.4/COPYRIGHT
7191 The C<notest> pragma may be set to skip the test part in the build
7196 cpan> notest install Tk
7198 A C<clean> command results in a
7202 being executed within the distribution file's working directory.
7204 =item get, readme, perldoc, look module or distribution
7206 C<get> downloads a distribution file without further action. C<readme>
7207 displays the README file of the associated distribution. C<Look> gets
7208 and untars (if not yet done) the distribution file, changes to the
7209 appropriate directory and opens a subshell process in that directory.
7210 C<perldoc> displays the pod documentation of the module in html or
7215 =item ls globbing_expression
7217 The first form lists all distribution files in and below an author's
7218 CPAN directory as they are stored in the CHECKUMS files distributed on
7219 CPAN. The listing goes recursive into all subdirectories.
7221 The second form allows to limit or expand the output with shell
7222 globbing as in the following examples:
7228 The last example is very slow and outputs extra progress indicators
7229 that break the alignment of the result.
7231 Note that globbing only lists directories explicitly asked for, for
7232 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
7233 regarded as a bug and may be changed in future versions.
7237 The C<failed> command reports all distributions that failed on one of
7238 C<make>, C<test> or C<install> for some reason in the currently
7239 running shell session.
7243 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>
7244 (but the directory can be configured via the C<cpan_home> config
7245 variable). The shell is a bit picky if you try to start another CPAN
7246 session. It dies immediately if there is a lockfile and the lock seems
7247 to belong to a running process. In case you want to run a second shell
7248 session, it is probably safest to maintain another directory, say
7249 C<~/.cpan-for-X/> and a C<~/.cpan-for-X/CPAN/MyConfig.pm> that
7250 contains the configuration options. Then you can start the second
7253 perl -I ~/.cpan-for-X -MCPAN::MyConfig -MCPAN -e shell
7257 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
7258 in the cpan-shell it is intended that you can press C<^C> anytime and
7259 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
7260 to clean up and leave the shell loop. You can emulate the effect of a
7261 SIGTERM by sending two consecutive SIGINTs, which usually means by
7262 pressing C<^C> twice.
7264 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
7265 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
7266 Build.PL> subprocess.
7272 The commands that are available in the shell interface are methods in
7273 the package CPAN::Shell. If you enter the shell command, all your
7274 input is split by the Text::ParseWords::shellwords() routine which
7275 acts like most shells do. The first word is being interpreted as the
7276 method to be called and the rest of the words are treated as arguments
7277 to this method. Continuation lines are supported if a line ends with a
7282 C<autobundle> writes a bundle file into the
7283 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
7284 a list of all modules that are both available from CPAN and currently
7285 installed within @INC. The name of the bundle file is based on the
7286 current date and a counter.
7290 recompile() is a very special command in that it takes no argument and
7291 runs the make/test/install cycle with brute force over all installed
7292 dynamically loadable extensions (aka XS modules) with 'force' in
7293 effect. The primary purpose of this command is to finish a network
7294 installation. Imagine, you have a common source tree for two different
7295 architectures. You decide to do a completely independent fresh
7296 installation. You start on one architecture with the help of a Bundle
7297 file produced earlier. CPAN installs the whole Bundle for you, but
7298 when you try to repeat the job on the second architecture, CPAN
7299 responds with a C<"Foo up to date"> message for all modules. So you
7300 invoke CPAN's recompile on the second architecture and you're done.
7302 Another popular use for C<recompile> is to act as a rescue in case your
7303 perl breaks binary compatibility. If one of the modules that CPAN uses
7304 is in turn depending on binary compatibility (so you cannot run CPAN
7305 commands), then you should try the CPAN::Nox module for recovery.
7309 The C<upgrade> command first runs an C<r> command and then installs
7310 the newest versions of all modules that were listed by that.
7314 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
7315 directory so that you can save your own preferences instead of the
7318 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
7320 Although it may be considered internal, the class hierarchy does matter
7321 for both users and programmer. CPAN.pm deals with above mentioned four
7322 classes, and all those classes share a set of methods. A classical
7323 single polymorphism is in effect. A metaclass object registers all
7324 objects of all kinds and indexes them with a string. The strings
7325 referencing objects have a separated namespace (well, not completely
7330 words containing a "/" (slash) Distribution
7331 words starting with Bundle:: Bundle
7332 everything else Module or Author
7334 Modules know their associated Distribution objects. They always refer
7335 to the most recent official release. Developers may mark their releases
7336 as unstable development versions (by inserting an underbar into the
7337 module version number which will also be reflected in the distribution
7338 name when you run 'make dist'), so the really hottest and newest
7339 distribution is not always the default. If a module Foo circulates
7340 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
7341 way to install version 1.23 by saying
7345 This would install the complete distribution file (say
7346 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
7347 like to install version 1.23_90, you need to know where the
7348 distribution file resides on CPAN relative to the authors/id/
7349 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
7350 so you would have to say
7352 install BAR/Foo-1.23_90.tar.gz
7354 The first example will be driven by an object of the class
7355 CPAN::Module, the second by an object of class CPAN::Distribution.
7357 =head2 Programmer's interface
7359 If you do not enter the shell, the available shell commands are both
7360 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
7361 functions in the calling package (C<install(...)>).
7363 There's currently only one class that has a stable interface -
7364 CPAN::Shell. All commands that are available in the CPAN shell are
7365 methods of the class CPAN::Shell. Each of the commands that produce
7366 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
7367 the IDs of all modules within the list.
7371 =item expand($type,@things)
7373 The IDs of all objects available within a program are strings that can
7374 be expanded to the corresponding real objects with the
7375 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
7376 list of CPAN::Module objects according to the C<@things> arguments
7377 given. In scalar context it only returns the first element of the
7380 =item expandany(@things)
7382 Like expand, but returns objects of the appropriate type, i.e.
7383 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
7384 CPAN::Distribution objects for distributions. Note: it does not expand
7385 to CPAN::Author objects.
7387 =item Programming Examples
7389 This enables the programmer to do operations that combine
7390 functionalities that are available in the shell.
7392 # install everything that is outdated on my disk:
7393 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
7395 # install my favorite programs if necessary:
7396 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
7397 my $obj = CPAN::Shell->expand('Module',$mod);
7401 # list all modules on my disk that have no VERSION number
7402 for $mod (CPAN::Shell->expand("Module","/./")){
7403 next unless $mod->inst_file;
7404 # MakeMaker convention for undefined $VERSION:
7405 next unless $mod->inst_version eq "undef";
7406 print "No VERSION in ", $mod->id, "\n";
7409 # find out which distribution on CPAN contains a module:
7410 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
7412 Or if you want to write a cronjob to watch The CPAN, you could list
7413 all modules that need updating. First a quick and dirty way:
7415 perl -e 'use CPAN; CPAN::Shell->r;'
7417 If you don't want to get any output in the case that all modules are
7418 up to date, you can parse the output of above command for the regular
7419 expression //modules are up to date// and decide to mail the output
7420 only if it doesn't match. Ick?
7422 If you prefer to do it more in a programmer style in one single
7423 process, maybe something like this suits you better:
7425 # list all modules on my disk that have newer versions on CPAN
7426 for $mod (CPAN::Shell->expand("Module","/./")){
7427 next unless $mod->inst_file;
7428 next if $mod->uptodate;
7429 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
7430 $mod->id, $mod->inst_version, $mod->cpan_version;
7433 If that gives you too much output every day, you maybe only want to
7434 watch for three modules. You can write
7436 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
7438 as the first line instead. Or you can combine some of the above
7441 # watch only for a new mod_perl module
7442 $mod = CPAN::Shell->expand("Module","mod_perl");
7443 exit if $mod->uptodate;
7444 # new mod_perl arrived, let me know all update recommendations
7449 =head2 Methods in the other Classes
7451 The programming interface for the classes CPAN::Module,
7452 CPAN::Distribution, CPAN::Bundle, and CPAN::Author is still considered
7453 beta and partially even alpha. In the following paragraphs only those
7454 methods are documented that have proven useful over a longer time and
7455 thus are unlikely to change.
7459 =item CPAN::Author::as_glimpse()
7461 Returns a one-line description of the author
7463 =item CPAN::Author::as_string()
7465 Returns a multi-line description of the author
7467 =item CPAN::Author::email()
7469 Returns the author's email address
7471 =item CPAN::Author::fullname()
7473 Returns the author's name
7475 =item CPAN::Author::name()
7477 An alias for fullname
7479 =item CPAN::Bundle::as_glimpse()
7481 Returns a one-line description of the bundle
7483 =item CPAN::Bundle::as_string()
7485 Returns a multi-line description of the bundle
7487 =item CPAN::Bundle::clean()
7489 Recursively runs the C<clean> method on all items contained in the bundle.
7491 =item CPAN::Bundle::contains()
7493 Returns a list of objects' IDs contained in a bundle. The associated
7494 objects may be bundles, modules or distributions.
7496 =item CPAN::Bundle::force($method,@args)
7498 Forces CPAN to perform a task that normally would have failed. Force
7499 takes as arguments a method name to be called and any number of
7500 additional arguments that should be passed to the called method. The
7501 internals of the object get the needed changes so that CPAN.pm does
7502 not refuse to take the action. The C<force> is passed recursively to
7503 all contained objects.
7505 =item CPAN::Bundle::get()
7507 Recursively runs the C<get> method on all items contained in the bundle
7509 =item CPAN::Bundle::inst_file()
7511 Returns the highest installed version of the bundle in either @INC or
7512 C<$CPAN::Config->{cpan_home}>. Note that this is different from
7513 CPAN::Module::inst_file.
7515 =item CPAN::Bundle::inst_version()
7517 Like CPAN::Bundle::inst_file, but returns the $VERSION
7519 =item CPAN::Bundle::uptodate()
7521 Returns 1 if the bundle itself and all its members are uptodate.
7523 =item CPAN::Bundle::install()
7525 Recursively runs the C<install> method on all items contained in the bundle
7527 =item CPAN::Bundle::make()
7529 Recursively runs the C<make> method on all items contained in the bundle
7531 =item CPAN::Bundle::readme()
7533 Recursively runs the C<readme> method on all items contained in the bundle
7535 =item CPAN::Bundle::test()
7537 Recursively runs the C<test> method on all items contained in the bundle
7539 =item CPAN::Distribution::as_glimpse()
7541 Returns a one-line description of the distribution
7543 =item CPAN::Distribution::as_string()
7545 Returns a multi-line description of the distribution
7547 =item CPAN::Distribution::author
7549 Returns the CPAN::Author object of the maintainer who uploaded this
7552 =item CPAN::Distribution::clean()
7554 Changes to the directory where the distribution has been unpacked and
7555 runs C<make clean> there.
7557 =item CPAN::Distribution::containsmods()
7559 Returns a list of IDs of modules contained in a distribution file.
7560 Only works for distributions listed in the 02packages.details.txt.gz
7561 file. This typically means that only the most recent version of a
7562 distribution is covered.
7564 =item CPAN::Distribution::cvs_import()
7566 Changes to the directory where the distribution has been unpacked and
7569 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
7573 =item CPAN::Distribution::dir()
7575 Returns the directory into which this distribution has been unpacked.
7577 =item CPAN::Distribution::force($method,@args)
7579 Forces CPAN to perform a task that normally would have failed. Force
7580 takes as arguments a method name to be called and any number of
7581 additional arguments that should be passed to the called method. The
7582 internals of the object get the needed changes so that CPAN.pm does
7583 not refuse to take the action.
7585 =item CPAN::Distribution::get()
7587 Downloads the distribution from CPAN and unpacks it. Does nothing if
7588 the distribution has already been downloaded and unpacked within the
7591 =item CPAN::Distribution::install()
7593 Changes to the directory where the distribution has been unpacked and
7594 runs the external command C<make install> there. If C<make> has not
7595 yet been run, it will be run first. A C<make test> will be issued in
7596 any case and if this fails, the install will be canceled. The
7597 cancellation can be avoided by letting C<force> run the C<install> for
7600 =item CPAN::Distribution::isa_perl()
7602 Returns 1 if this distribution file seems to be a perl distribution.
7603 Normally this is derived from the file name only, but the index from
7604 CPAN can contain a hint to achieve a return value of true for other
7607 =item CPAN::Distribution::look()
7609 Changes to the directory where the distribution has been unpacked and
7610 opens a subshell there. Exiting the subshell returns.
7612 =item CPAN::Distribution::make()
7614 First runs the C<get> method to make sure the distribution is
7615 downloaded and unpacked. Changes to the directory where the
7616 distribution has been unpacked and runs the external commands C<perl
7617 Makefile.PL> or C<perl Build.PL> and C<make> there.
7619 =item CPAN::Distribution::perldoc()
7621 Downloads the pod documentation of the file associated with a
7622 distribution (in html format) and runs it through the external
7623 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
7624 isn't available, it converts it to plain text with external
7625 command html2text and runs it through the pager specified
7626 in C<$CPAN::Config->{pager}>
7628 =item CPAN::Distribution::prereq_pm()
7630 Returns the hash reference that has been announced by a distribution
7631 as the merge of the C<requires> element and the C<build_requires>
7632 element of the META.yml or the C<PREREQ_PM> hash in the
7633 C<Makefile.PL>. Note: works only after an attempt has been made to
7634 C<make> the distribution. Returns undef otherwise.
7636 =item CPAN::Distribution::readme()
7638 Downloads the README file associated with a distribution and runs it
7639 through the pager specified in C<$CPAN::Config->{pager}>.
7641 =item CPAN::Distribution::read_yaml()
7643 Returns the content of the META.yml of this distro as a hashref. Note:
7644 works only after an attempt has been made to C<make> the distribution.
7645 Returns undef otherwise.
7647 =item CPAN::Distribution::test()
7649 Changes to the directory where the distribution has been unpacked and
7650 runs C<make test> there.
7652 =item CPAN::Distribution::uptodate()
7654 Returns 1 if all the modules contained in the distribution are
7655 uptodate. Relies on containsmods.
7657 =item CPAN::Index::force_reload()
7659 Forces a reload of all indices.
7661 =item CPAN::Index::reload()
7663 Reloads all indices if they have not been read for more than
7664 C<$CPAN::Config->{index_expire}> days.
7666 =item CPAN::InfoObj::dump()
7668 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
7669 inherit this method. It prints the data structure associated with an
7670 object. Useful for debugging. Note: the data structure is considered
7671 internal and thus subject to change without notice.
7673 =item CPAN::Module::as_glimpse()
7675 Returns a one-line description of the module in four columns: The
7676 first column contains the word C<Module>, the second column consists
7677 of one character: an equals sign if this module is already installed
7678 and uptodate, a less-than sign if this module is installed but can be
7679 upgraded, and a space if the module is not installed. The third column
7680 is the name of the module and the fourth column gives maintainer or
7681 distribution information.
7683 =item CPAN::Module::as_string()
7685 Returns a multi-line description of the module
7687 =item CPAN::Module::clean()
7689 Runs a clean on the distribution associated with this module.
7691 =item CPAN::Module::cpan_file()
7693 Returns the filename on CPAN that is associated with the module.
7695 =item CPAN::Module::cpan_version()
7697 Returns the latest version of this module available on CPAN.
7699 =item CPAN::Module::cvs_import()
7701 Runs a cvs_import on the distribution associated with this module.
7703 =item CPAN::Module::description()
7705 Returns a 44 character description of this module. Only available for
7706 modules listed in The Module List (CPAN/modules/00modlist.long.html
7707 or 00modlist.long.txt.gz)
7709 =item CPAN::Module::distribution()
7711 Returns the CPAN::Distribution object that contains the current
7712 version of this module.
7714 =item CPAN::Module::dslip_status()
7716 Returns a hash reference. The keys of the hash are the letters C<D>,
7717 C<S>, C<L>, C<I>, and <P>, for development status, support level,
7718 language, interface and public licence respectively. The data for the
7719 DSLIP status are collected by pause.perl.org when authors register
7720 their namespaces. The values of the 5 hash elements are one-character
7721 words whose meaning is described in the table below. There are also 5
7722 hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
7723 verbose value of the 5 status variables.
7725 Where the 'DSLIP' characters have the following meanings:
7727 D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
7728 i - Idea, listed to gain consensus or as a placeholder
7729 c - under construction but pre-alpha (not yet released)
7730 a/b - Alpha/Beta testing
7732 M - Mature (no rigorous definition)
7733 S - Standard, supplied with Perl 5
7738 u - Usenet newsgroup comp.lang.perl.modules
7739 n - None known, try comp.lang.perl.modules
7740 a - abandoned; volunteers welcome to take over maintainance
7743 p - Perl-only, no compiler needed, should be platform independent
7744 c - C and perl, a C compiler will be needed
7745 h - Hybrid, written in perl with optional C code, no compiler needed
7746 + - C++ and perl, a C++ compiler will be needed
7747 o - perl and another language other than C or C++
7750 f - plain Functions, no references used
7751 h - hybrid, object and function interfaces available
7752 n - no interface at all (huh?)
7753 r - some use of unblessed References or ties
7754 O - Object oriented using blessed references and/or inheritance
7757 p - Standard-Perl: user may choose between GPL and Artistic
7758 g - GPL: GNU General Public License
7759 l - LGPL: "GNU Lesser General Public License" (previously known as
7760 "GNU Library General Public License")
7761 b - BSD: The BSD License
7762 a - Artistic license alone
7763 o - open source: appoved by www.opensource.org
7764 d - allows distribution without restrictions
7765 r - restricted distribtion
7766 n - no license at all
7768 =item CPAN::Module::force($method,@args)
7770 Forces CPAN to perform a task that normally would have failed. Force
7771 takes as arguments a method name to be called and any number of
7772 additional arguments that should be passed to the called method. The
7773 internals of the object get the needed changes so that CPAN.pm does
7774 not refuse to take the action.
7776 =item CPAN::Module::get()
7778 Runs a get on the distribution associated with this module.
7780 =item CPAN::Module::inst_file()
7782 Returns the filename of the module found in @INC. The first file found
7783 is reported just like perl itself stops searching @INC when it finds a
7786 =item CPAN::Module::inst_version()
7788 Returns the version number of the module in readable format.
7790 =item CPAN::Module::install()
7792 Runs an C<install> on the distribution associated with this module.
7794 =item CPAN::Module::look()
7796 Changes to the directory where the distribution associated with this
7797 module has been unpacked and opens a subshell there. Exiting the
7800 =item CPAN::Module::make()
7802 Runs a C<make> on the distribution associated with this module.
7804 =item CPAN::Module::manpage_headline()
7806 If module is installed, peeks into the module's manpage, reads the
7807 headline and returns it. Moreover, if the module has been downloaded
7808 within this session, does the equivalent on the downloaded module even
7809 if it is not installed.
7811 =item CPAN::Module::perldoc()
7813 Runs a C<perldoc> on this module.
7815 =item CPAN::Module::readme()
7817 Runs a C<readme> on the distribution associated with this module.
7819 =item CPAN::Module::test()
7821 Runs a C<test> on the distribution associated with this module.
7823 =item CPAN::Module::uptodate()
7825 Returns 1 if the module is installed and up-to-date.
7827 =item CPAN::Module::userid()
7829 Returns the author's ID of the module.
7833 =head2 Cache Manager
7835 Currently the cache manager only keeps track of the build directory
7836 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
7837 deletes complete directories below C<build_dir> as soon as the size of
7838 all directories there gets bigger than $CPAN::Config->{build_cache}
7839 (in MB). The contents of this cache may be used for later
7840 re-installations that you intend to do manually, but will never be
7841 trusted by CPAN itself. This is due to the fact that the user might
7842 use these directories for building modules on different architectures.
7844 There is another directory ($CPAN::Config->{keep_source_where}) where
7845 the original distribution files are kept. This directory is not
7846 covered by the cache manager and must be controlled by the user. If
7847 you choose to have the same directory as build_dir and as
7848 keep_source_where directory, then your sources will be deleted with
7849 the same fifo mechanism.
7853 A bundle is just a perl module in the namespace Bundle:: that does not
7854 define any functions or methods. It usually only contains documentation.
7856 It starts like a perl module with a package declaration and a $VERSION
7857 variable. After that the pod section looks like any other pod with the
7858 only difference being that I<one special pod section> exists starting with
7863 In this pod section each line obeys the format
7865 Module_Name [Version_String] [- optional text]
7867 The only required part is the first field, the name of a module
7868 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
7869 of the line is optional. The comment part is delimited by a dash just
7870 as in the man page header.
7872 The distribution of a bundle should follow the same convention as
7873 other distributions.
7875 Bundles are treated specially in the CPAN package. If you say 'install
7876 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
7877 the modules in the CONTENTS section of the pod. You can install your
7878 own Bundles locally by placing a conformant Bundle file somewhere into
7879 your @INC path. The autobundle() command which is available in the
7880 shell interface does that for you by including all currently installed
7881 modules in a snapshot bundle file.
7883 =head2 Prerequisites
7885 If you have a local mirror of CPAN and can access all files with
7886 "file:" URLs, then you only need a perl better than perl5.003 to run
7887 this module. Otherwise Net::FTP is strongly recommended. LWP may be
7888 required for non-UNIX systems or if your nearest CPAN site is
7889 associated with a URL that is not C<ftp:>.
7891 If you have neither Net::FTP nor LWP, there is a fallback mechanism
7892 implemented for an external ftp command or for an external lynx
7895 =head2 Finding packages and VERSION
7897 This module presumes that all packages on CPAN
7903 declare their $VERSION variable in an easy to parse manner. This
7904 prerequisite can hardly be relaxed because it consumes far too much
7905 memory to load all packages into the running program just to determine
7906 the $VERSION variable. Currently all programs that are dealing with
7907 version use something like this
7909 perl -MExtUtils::MakeMaker -le \
7910 'print MM->parse_version(shift)' filename
7912 If you are author of a package and wonder if your $VERSION can be
7913 parsed, please try the above method.
7917 come as compressed or gzipped tarfiles or as zip files and contain a
7918 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
7919 without much enthusiasm).
7925 The debugging of this module is a bit complex, because we have
7926 interferences of the software producing the indices on CPAN, of the
7927 mirroring process on CPAN, of packaging, of configuration, of
7928 synchronicity, and of bugs within CPAN.pm.
7930 For code debugging in interactive mode you can try "o debug" which
7931 will list options for debugging the various parts of the code. You
7932 should know that "o debug" has built-in completion support.
7934 For data debugging there is the C<dump> command which takes the same
7935 arguments as make/test/install and outputs the object's Data::Dumper
7938 =head2 Floppy, Zip, Offline Mode
7940 CPAN.pm works nicely without network too. If you maintain machines
7941 that are not networked at all, you should consider working with file:
7942 URLs. Of course, you have to collect your modules somewhere first. So
7943 you might use CPAN.pm to put together all you need on a networked
7944 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
7945 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
7946 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
7947 with this floppy. See also below the paragraph about CD-ROM support.
7949 =head1 CONFIGURATION
7951 When the CPAN module is used for the first time, a configuration
7952 dialog tries to determine a couple of site specific options. The
7953 result of the dialog is stored in a hash reference C< $CPAN::Config >
7954 in a file CPAN/Config.pm.
7956 The default values defined in the CPAN/Config.pm file can be
7957 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
7958 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
7959 added to the search path of the CPAN module before the use() or
7960 require() statements.
7962 The configuration dialog can be started any time later again by
7963 issuing the command C< o conf init > in the CPAN shell.
7965 Currently the following keys in the hash reference $CPAN::Config are
7968 build_cache size of cache for directories to build modules
7969 build_dir locally accessible directory to build modules
7970 cache_metadata use serializer to cache metadata
7971 commands_quote prefered character to use for quoting external
7972 commands when running them. Defaults to double
7973 quote on Windows, single tick everywhere else;
7974 can be set to space to disable quoting
7975 check_sigs if signatures should be verified
7976 cpan_home local directory reserved for this package
7977 dontload_list arrayref: modules in the list will not be
7978 loaded by the CPAN::has_inst() routine
7980 gzip location of external program gzip
7981 histfile file to maintain history between sessions
7982 histsize maximum number of lines to keep in histfile
7983 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
7984 after this many seconds inactivity. Set to 0 to
7986 index_expire after this many days refetch index files
7987 inhibit_startup_message
7988 if true, does not print the startup message
7989 keep_source_where directory in which to keep the source (if we do)
7990 make location of external make program
7991 make_arg arguments that should always be passed to 'make'
7992 make_install_make_command
7993 the make command for running 'make install', for
7995 make_install_arg same as make_arg for 'make install'
7996 makepl_arg arguments passed to 'perl Makefile.PL'
7997 mbuild_arg arguments passed to './Build'
7998 mbuild_install_arg arguments passed to './Build install'
7999 mbuild_install_build_command
8000 command to use instead of './Build' when we are
8001 in the install stage, for example 'sudo ./Build'
8002 mbuildpl_arg arguments passed to 'perl Build.PL'
8003 pager location of external program more (or any pager)
8004 prefer_installer legal values are MB and EUMM: if a module comes
8005 with both a Makefile.PL and a Build.PL, use the
8006 former (EUMM) or the latter (MB); if the module
8007 comes with only one of the two, that one will be
8009 prerequisites_policy
8010 what to do if you are missing module prerequisites
8011 ('follow' automatically, 'ask' me, or 'ignore')
8012 proxy_user username for accessing an authenticating proxy
8013 proxy_pass password for accessing an authenticating proxy
8014 scan_cache controls scanning of cache ('atstart' or 'never')
8015 tar location of external program tar
8016 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
8017 (and nonsense for characters outside latin range)
8018 unzip location of external program unzip
8019 urllist arrayref to nearby CPAN sites (or equivalent locations)
8020 wait_list arrayref to a wait server to try (See CPAN::WAIT)
8021 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
8022 ftp_proxy, } the three usual variables for configuring
8023 http_proxy, } proxy requests. Both as CPAN::Config variables
8024 no_proxy } and as environment variables configurable.
8026 You can set and query each of these options interactively in the cpan
8027 shell with the command set defined within the C<o conf> command:
8031 =item C<o conf E<lt>scalar optionE<gt>>
8033 prints the current value of the I<scalar option>
8035 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
8037 Sets the value of the I<scalar option> to I<value>
8039 =item C<o conf E<lt>list optionE<gt>>
8041 prints the current value of the I<list option> in MakeMaker's
8044 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
8046 shifts or pops the array in the I<list option> variable
8048 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
8050 works like the corresponding perl commands.
8054 =head2 Not on config variable getcwd
8056 CPAN.pm changes the current working directory often and needs to
8057 determine its own current working directory. Per default it uses
8058 Cwd::cwd but if this doesn't work on your system for some reason,
8059 alternatives can be configured according to the following table:
8063 fastcwd Cwd::fastcwd
8064 backtickcwd external command cwd
8066 =head2 Note on urllist parameter's format
8068 urllist parameters are URLs according to RFC 1738. We do a little
8069 guessing if your URL is not compliant, but if you have problems with
8070 file URLs, please try the correct format. Either:
8072 file://localhost/whatever/ftp/pub/CPAN/
8076 file:///home/ftp/pub/CPAN/
8078 =head2 urllist parameter has CD-ROM support
8080 The C<urllist> parameter of the configuration table contains a list of
8081 URLs that are to be used for downloading. If the list contains any
8082 C<file> URLs, CPAN always tries to get files from there first. This
8083 feature is disabled for index files. So the recommendation for the
8084 owner of a CD-ROM with CPAN contents is: include your local, possibly
8085 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
8087 o conf urllist push file://localhost/CDROM/CPAN
8089 CPAN.pm will then fetch the index files from one of the CPAN sites
8090 that come at the beginning of urllist. It will later check for each
8091 module if there is a local copy of the most recent version.
8093 Another peculiarity of urllist is that the site that we could
8094 successfully fetch the last file from automatically gets a preference
8095 token and is tried as the first site for the next request. So if you
8096 add a new site at runtime it may happen that the previously preferred
8097 site will be tried another time. This means that if you want to disallow
8098 a site for the next transfer, it must be explicitly removed from
8103 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
8104 install foreign, unmasked, unsigned code on your machine. We compare
8105 to a checksum that comes from the net just as the distribution file
8106 itself. But we try to make it easy to add security on demand:
8108 =head2 Cryptographically signed modules
8110 Since release 1.77 CPAN.pm has been able to verify cryptographically
8111 signed module distributions using Module::Signature. The CPAN modules
8112 can be signed by their authors, thus giving more security. The simple
8113 unsigned MD5 checksums that were used before by CPAN protect mainly
8114 against accidental file corruption.
8116 You will need to have Module::Signature installed, which in turn
8117 requires that you have at least one of Crypt::OpenPGP module or the
8118 command-line F<gpg> tool installed.
8120 You will also need to be able to connect over the Internet to the public
8121 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
8123 The configuration parameter check_sigs is there to turn signature
8128 Most functions in package CPAN are exported per default. The reason
8129 for this is that the primary use is intended for the cpan shell or for
8134 When the CPAN shell enters a subshell via the look command, it sets
8135 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
8138 When the config variable ftp_passive is set, all downloads will be run
8139 with the environment variable FTP_PASSIVE set to this value. This is
8140 in general a good idea as it influences both Net::FTP and LWP based
8141 connections. The same effect can be achieved by starting the cpan
8142 shell with this environment variable set. For Net::FTP alone, one can
8143 also always set passive mode by running libnetcfg.
8145 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
8147 Populating a freshly installed perl with my favorite modules is pretty
8148 easy if you maintain a private bundle definition file. To get a useful
8149 blueprint of a bundle definition file, the command autobundle can be used
8150 on the CPAN shell command line. This command writes a bundle definition
8151 file for all modules that are installed for the currently running perl
8152 interpreter. It's recommended to run this command only once and from then
8153 on maintain the file manually under a private name, say
8154 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
8156 cpan> install Bundle::my_bundle
8158 then answer a few questions and then go out for a coffee.
8160 Maintaining a bundle definition file means keeping track of two
8161 things: dependencies and interactivity. CPAN.pm sometimes fails on
8162 calculating dependencies because not all modules define all MakeMaker
8163 attributes correctly, so a bundle definition file should specify
8164 prerequisites as early as possible. On the other hand, it's a bit
8165 annoying that many distributions need some interactive configuring. So
8166 what I try to accomplish in my private bundle file is to have the
8167 packages that need to be configured early in the file and the gentle
8168 ones later, so I can go out after a few minutes and leave CPAN.pm
8171 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
8173 Thanks to Graham Barr for contributing the following paragraphs about
8174 the interaction between perl, and various firewall configurations. For
8175 further information on firewalls, it is recommended to consult the
8176 documentation that comes with the ncftp program. If you are unable to
8177 go through the firewall with a simple Perl setup, it is very likely
8178 that you can configure ncftp so that it works for your firewall.
8180 =head2 Three basic types of firewalls
8182 Firewalls can be categorized into three basic types.
8188 This is where the firewall machine runs a web server and to access the
8189 outside world you must do it via the web server. If you set environment
8190 variables like http_proxy or ftp_proxy to a values beginning with http://
8191 or in your web browser you have to set proxy information then you know
8192 you are running an http firewall.
8194 To access servers outside these types of firewalls with perl (even for
8195 ftp) you will need to use LWP.
8199 This where the firewall machine runs an ftp server. This kind of
8200 firewall will only let you access ftp servers outside the firewall.
8201 This is usually done by connecting to the firewall with ftp, then
8202 entering a username like "user@outside.host.com"
8204 To access servers outside these type of firewalls with perl you
8205 will need to use Net::FTP.
8207 =item One way visibility
8209 I say one way visibility as these firewalls try to make themselves look
8210 invisible to the users inside the firewall. An FTP data connection is
8211 normally created by sending the remote server your IP address and then
8212 listening for the connection. But the remote server will not be able to
8213 connect to you because of the firewall. So for these types of firewall
8214 FTP connections need to be done in a passive mode.
8216 There are two that I can think off.
8222 If you are using a SOCKS firewall you will need to compile perl and link
8223 it with the SOCKS library, this is what is normally called a 'socksified'
8224 perl. With this executable you will be able to connect to servers outside
8225 the firewall as if it is not there.
8229 This is the firewall implemented in the Linux kernel, it allows you to
8230 hide a complete network behind one IP address. With this firewall no
8231 special compiling is needed as you can access hosts directly.
8233 For accessing ftp servers behind such firewalls you usually need to
8234 set the environment variable C<FTP_PASSIVE> or the config variable
8235 ftp_passive to a true value.
8241 =head2 Configuring lynx or ncftp for going through a firewall
8243 If you can go through your firewall with e.g. lynx, presumably with a
8246 /usr/local/bin/lynx -pscott:tiger
8248 then you would configure CPAN.pm with the command
8250 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
8252 That's all. Similarly for ncftp or ftp, you would configure something
8255 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
8257 Your mileage may vary...
8265 I installed a new version of module X but CPAN keeps saying,
8266 I have the old version installed
8268 Most probably you B<do> have the old version installed. This can
8269 happen if a module installs itself into a different directory in the
8270 @INC path than it was previously installed. This is not really a
8271 CPAN.pm problem, you would have the same problem when installing the
8272 module manually. The easiest way to prevent this behaviour is to add
8273 the argument C<UNINST=1> to the C<make install> call, and that is why
8274 many people add this argument permanently by configuring
8276 o conf make_install_arg UNINST=1
8280 So why is UNINST=1 not the default?
8282 Because there are people who have their precise expectations about who
8283 may install where in the @INC path and who uses which @INC array. In
8284 fine tuned environments C<UNINST=1> can cause damage.
8288 I want to clean up my mess, and install a new perl along with
8289 all modules I have. How do I go about it?
8291 Run the autobundle command for your old perl and optionally rename the
8292 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
8293 with the Configure option prefix, e.g.
8295 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
8297 Install the bundle file you produced in the first step with something like
8299 cpan> install Bundle::mybundle
8305 When I install bundles or multiple modules with one command
8306 there is too much output to keep track of.
8308 You may want to configure something like
8310 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
8311 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
8313 so that STDOUT is captured in a file for later inspection.
8318 I am not root, how can I install a module in a personal directory?
8320 First of all, you will want to use your own configuration, not the one
8321 that your root user installed. If you do not have permission to write
8322 in the cpan directory that root has configured, you will be asked if
8323 you want to create your own config. Answering "yes" will bring you into
8324 CPAN's configuration stage, using the system config for all defaults except
8325 things that have to do with CPAN's work directory, saving your choices to
8326 your MyConfig.pm file.
8328 You can also manually initiate this process with the following command:
8330 % perl -MCPAN -e 'mkmyconfig'
8336 from the CPAN shell.
8338 You will most probably also want to configure something like this:
8340 o conf makepl_arg "LIB=~/myperl/lib \
8341 INSTALLMAN1DIR=~/myperl/man/man1 \
8342 INSTALLMAN3DIR=~/myperl/man/man3"
8344 You can make this setting permanent like all C<o conf> settings with
8347 You will have to add ~/myperl/man to the MANPATH environment variable
8348 and also tell your perl programs to look into ~/myperl/lib, e.g. by
8351 use lib "$ENV{HOME}/myperl/lib";
8353 or setting the PERL5LIB environment variable.
8355 While we're speaking about $ENV{HOME}, it might be worth mentioning,
8356 that for Windows we use the File::HomeDir module that provides an
8357 equivalent to the concept of the home directory on Unix.
8359 Another thing you should bear in mind is that the UNINST parameter can
8360 be dnagerous when you are installing into a private area because you
8361 might accidentally remove modules that other people depend on that are
8362 not using the private area.
8366 How to get a package, unwrap it, and make a change before building it?
8368 look Sybase::Sybperl
8372 I installed a Bundle and had a couple of fails. When I
8373 retried, everything resolved nicely. Can this be fixed to work
8376 The reason for this is that CPAN does not know the dependencies of all
8377 modules when it starts out. To decide about the additional items to
8378 install, it just uses data found in the META.yml file or the generated
8379 Makefile. An undetected missing piece breaks the process. But it may
8380 well be that your Bundle installs some prerequisite later than some
8381 depending item and thus your second try is able to resolve everything.
8382 Please note, CPAN.pm does not know the dependency tree in advance and
8383 cannot sort the queue of things to install in a topologically correct
8384 order. It resolves perfectly well IF all modules declare the
8385 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
8386 the C<requires> stanza of Module::Build. For bundles which fail and
8387 you need to install often, it is recommended to sort the Bundle
8388 definition file manually.
8392 In our intranet we have many modules for internal use. How
8393 can I integrate these modules with CPAN.pm but without uploading
8394 the modules to CPAN?
8396 Have a look at the CPAN::Site module.
8400 When I run CPAN's shell, I get an error message about things in my
8401 /etc/inputrc (or ~/.inputrc) file.
8403 These are readline issues and can only be fixed by studying readline
8404 configuration on your architecture and adjusting the referenced file
8405 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
8406 and edit them. Quite often harmless changes like uppercasing or
8407 lowercasing some arguments solves the problem.
8411 Some authors have strange characters in their names.
8413 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
8414 expecting ISO-8859-1 charset, a converter can be activated by setting
8415 term_is_latin to a true value in your config file. One way of doing so
8418 cpan> o conf term_is_latin 1
8420 If other charset support is needed, please file a bugreport against
8421 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
8422 the support or maybe UTF-8 terminals become widely available.
8426 When an install fails for some reason and then I correct the error
8427 condition and retry, CPAN.pm refuses to install the module, saying
8428 C<Already tried without success>.
8430 Use the force pragma like so
8432 force install Foo::Bar
8434 This does a bit more than really needed because it untars the
8435 distribution again and runs make and test and only then install.
8437 Or, if you find this is too fast and you would prefer to do smaller
8442 first and then continue as always. C<Force get> I<forgets> previous
8449 and then 'make install' directly in the subshell.
8451 Or you leave the CPAN shell and start it again.
8453 For the really curious, by accessing internals directly, you I<could>
8455 !delete CPAN::Shell->expandany("Foo::Bar")->distribution->{install}
8457 but this is neither guaranteed to work in the future nor is it a
8462 How do I install a "DEVELOPER RELEASE" of a module?
8464 By default, CPAN will install the latest non-developer release of a module.
8465 If you want to install a dev release, you have to specify a partial path to
8466 the tarball you wish to install, like so:
8468 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
8472 How do I install a module and all its dependencies from the commandline,
8473 without being prompted for anything, despite my CPAN configuration
8476 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
8477 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
8478 asked any questions at all (assuming the modules you are installing are
8479 nice about obeying that variable as well):
8481 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
8485 How do I create a Module::Build based Build.PL derived from an
8486 ExtUtils::MakeMaker focused Makefile.PL?
8488 http://search.cpan.org/search?query=Module::Build::Convert
8490 http://accognoscere.org/papers/perl-module-build-convert/module-build-convert.html
8497 Please report bugs via http://rt.cpan.org/
8499 Before submitting a bug, please make sure that the traditional method
8500 of building a Perl module package from a shell by following the
8501 installation instructions of that package still works in your
8504 =head1 SECURITY ADVICE
8506 This software enables you to upgrade software on your computer and so
8507 is inherently dangerous because the newly installed software may
8508 contain bugs and may alter the way your computer works or even make it
8509 unusable. Please consider backing up your data before every upgrade.
8513 Andreas Koenig C<< <andk@cpan.org> >>
8517 Kawai,Takanori provides a Japanese translation of this manpage at
8518 http://member.nifty.ne.jp/hippo2000/perltips/CPAN.htm
8522 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)