1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 $CPAN::VERSION = '1.8801';
5 $CPAN::VERSION = eval $CPAN::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 ();
30 # we need to run chdir all over and we would get at wrong libraries
33 if (File::Spec->can("rel2abs")) {
35 $inc = File::Spec->rel2abs($inc);
41 require Mac::BuildTools if $^O eq 'MacOS';
43 END { $CPAN::End++; &cleanup; }
46 $CPAN::Frontend ||= "CPAN::Shell";
47 unless (@CPAN::Defaultsites){
48 @CPAN::Defaultsites = map {
49 CPAN::URL->new(TEXT => $_, FROM => "DEF")
51 "http://www.perl.org/CPAN/",
52 "ftp://ftp.perl.org/pub/CPAN/";
54 # $CPAN::iCwd (i for initial) is going to be initialized during find_perl
55 $CPAN::Perl ||= CPAN::find_perl();
56 $CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
57 $CPAN::Defaultrecent ||= "http://search.cpan.org/recent";
60 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term
61 $Signal $Suppress_readline $Frontend
62 @Defaultsites $Have_warned $Defaultdocs $Defaultrecent
65 @CPAN::ISA = qw(CPAN::Debug Exporter);
67 # note that these functions live in CPAN::Shell and get executed via
68 # AUTOLOAD when called directly
90 sub soft_chdir_with_alternatives ($);
92 #-> sub CPAN::AUTOLOAD ;
97 @EXPORT{@EXPORT} = '';
98 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
99 if (exists $EXPORT{$l}){
102 die(qq{Unknown CPAN command "$AUTOLOAD". }.
103 qq{Type ? for help.\n});
107 #-> sub CPAN::shell ;
110 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
111 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
113 my $oprompt = shift || CPAN::Prompt->new;
114 my $prompt = $oprompt;
115 my $commandline = shift || "";
116 $CPAN::CurrentCommandId ||= 1;
119 unless ($Suppress_readline) {
120 require Term::ReadLine;
123 $term->ReadLine eq "Term::ReadLine::Stub"
125 $term = Term::ReadLine->new('CPAN Monitor');
127 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
128 my $attribs = $term->Attribs;
129 $attribs->{attempted_completion_function} = sub {
130 &CPAN::Complete::gnu_cpl;
133 $readline::rl_completion_function =
134 $readline::rl_completion_function = 'CPAN::Complete::cpl';
136 if (my $histfile = $CPAN::Config->{'histfile'}) {{
137 unless ($term->can("AddHistory")) {
138 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
141 my($fh) = FileHandle->new;
142 open $fh, "<$histfile" or last;
146 $term->AddHistory($_);
150 for ($CPAN::Config->{term_ornaments}) { # alias
151 local $Term::ReadLine::termcap_nowarn = 1;
152 $term->ornaments($_) if defined;
154 # $term->OUT is autoflushed anyway
155 my $odef = select STDERR;
162 # no strict; # I do not recall why no strict was here (2000-09-03)
166 File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
167 File::Spec->rootdir(),
169 my $try_detect_readline;
170 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
171 my $rl_avail = $Suppress_readline ? "suppressed" :
172 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
173 "available (try 'install Bundle::CPAN')";
175 unless ($CPAN::Config->{'inhibit_startup_message'}){
176 $CPAN::Frontend->myprint(
178 cpan shell -- CPAN exploration and modules installation (v%s)
186 my($continuation) = "";
187 my $last_term_ornaments;
188 SHELLCOMMAND: while () {
189 if ($Suppress_readline) {
191 last SHELLCOMMAND unless defined ($_ = <> );
194 last SHELLCOMMAND unless
195 defined ($_ = $term->readline($prompt, $commandline));
197 $_ = "$continuation$_" if $continuation;
199 next SHELLCOMMAND if /^$/;
200 $_ = 'h' if /^\s*\?/;
201 if (/^(?:q(?:uit)?|bye|exit)$/i) {
212 use vars qw($import_done);
213 CPAN->import(':DEFAULT') unless $import_done++;
214 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
221 if ($] < 5.00322) { # parsewords had a bug until recently
224 eval { @line = Text::ParseWords::shellwords($_) };
225 warn($@), next SHELLCOMMAND if $@;
226 warn("Text::Parsewords could not parse the line [$_]"),
227 next SHELLCOMMAND unless @line;
229 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
230 my $command = shift @line;
231 eval { CPAN::Shell->$command(@line) };
233 if ($command =~ /^(make|test|install|force|notest|clean|upgrade)$/) {
234 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
236 soft_chdir_with_alternatives(\@cwd);
237 $CPAN::Frontend->myprint("\n");
239 $CPAN::CurrentCommandId++;
243 $commandline = ""; # I do want to be able to pass a default to
244 # shell, but on the second command I see no
247 CPAN::Queue->nullify_queue;
248 if ($try_detect_readline) {
249 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
251 $CPAN::META->has_inst("Term::ReadLine::Perl")
253 delete $INC{"Term/ReadLine.pm"};
255 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
256 require Term::ReadLine;
257 $CPAN::Frontend->myprint("\n$redef subroutines in ".
258 "Term::ReadLine redefined\n");
263 if ($term and $term->can("ornaments")) {
264 for ($CPAN::Config->{term_ornaments}) { # alias
266 if (not defined $last_term_ornaments
267 or $_ != $last_term_ornaments
269 local $Term::ReadLine::termcap_nowarn = 1;
270 $term->ornaments($_);
271 $last_term_ornaments = $_;
274 undef $last_term_ornaments;
279 soft_chdir_with_alternatives(\@cwd);
282 sub soft_chdir_with_alternatives ($) {
284 while (not chdir $cwd->[0]) {
286 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
287 Trying to chdir to "$cwd->[1]" instead.
291 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
296 package CPAN::CacheMgr;
298 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
303 use vars qw($Ua $Thesite $ThesiteURL $Themethod);
304 @CPAN::FTP::ISA = qw(CPAN::Debug);
306 package CPAN::LWP::UserAgent;
308 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
309 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
311 package CPAN::Complete;
313 @CPAN::Complete::ISA = qw(CPAN::Debug);
314 @CPAN::Complete::COMMANDS = sort qw(
315 ! a b d h i m o q r u
339 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03);
340 @CPAN::Index::ISA = qw(CPAN::Debug);
343 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
346 package CPAN::InfoObj;
348 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
350 package CPAN::Author;
352 @CPAN::Author::ISA = qw(CPAN::InfoObj);
354 package CPAN::Distribution;
356 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
358 package CPAN::Bundle;
360 @CPAN::Bundle::ISA = qw(CPAN::Module);
362 package CPAN::Module;
364 @CPAN::Module::ISA = qw(CPAN::InfoObj);
366 package CPAN::Exception::RecursiveDependency;
368 use overload '""' => "as_string";
375 for my $dep (@$deps) {
377 last if $seen{$dep}++;
379 bless { deps => \@deps }, $class;
384 "\nRecursive dependency detected:\n " .
385 join("\n => ", @{$self->{deps}}) .
386 ".\nCannot continue.\n";
389 package CPAN::Prompt; use overload '""' => "as_string";
390 use vars qw($prompt);
392 $CPAN::CurrentCommandId ||= 0;
397 if ($CPAN::Config->{commandnumber_in_prompt}) {
398 sprintf "cpan[%d]> ", $CPAN::CurrentCommandId;
404 package CPAN::URL; use overload '""' => "as_string", fallback => 1;
405 # accessors: TEXT(the url string), FROM(DEF=>defaultlist,USER=>urllist),
406 # planned are things like age or quality
408 my($class,%args) = @_;
420 $self->{TEXT} = $set;
425 package CPAN::Distrostatus;
426 use overload '""' => "as_string",
429 my($class,$arg) = @_;
432 FAILED => substr($arg,0,2) eq "NO",
433 COMMANDID => $CPAN::CurrentCommandId,
436 sub commandid { shift->{COMMANDID} }
437 sub failed { shift->{FAILED} }
441 $self->{TEXT} = $set;
452 use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY);
453 @CPAN::Shell::ISA = qw(CPAN::Debug);
454 $COLOR_REGISTERED ||= 0;
456 #-> sub CPAN::Shell::AUTOLOAD ;
458 my($autoload) = $AUTOLOAD;
459 my $class = shift(@_);
460 # warn "autoload[$autoload] class[$class]";
461 $autoload =~ s/.*:://;
462 if ($autoload =~ /^w/) {
463 if ($CPAN::META->has_inst('CPAN::WAIT')) {
464 CPAN::WAIT->$autoload(@_);
466 $CPAN::Frontend->mywarn(qq{
467 Commands starting with "w" require CPAN::WAIT to be installed.
468 Please consider installing CPAN::WAIT to use the fulltext index.
469 For this you just need to type
474 $CPAN::Frontend->mywarn(qq{Unknown shell command '$autoload @_'. }.
483 # One use of the queue is to determine if we should or shouldn't
484 # announce the availability of a new CPAN module
486 # Now we try to use it for dependency tracking. For that to happen
487 # we need to draw a dependency tree and do the leaves first. This can
488 # easily be reached by running CPAN.pm recursively, but we don't want
489 # to waste memory and run into deep recursion. So what we can do is
492 # CPAN::Queue is the package where the queue is maintained. Dependencies
493 # often have high priority and must be brought to the head of the queue,
494 # possibly by jumping the queue if they are already there. My first code
495 # attempt tried to be extremely correct. Whenever a module needed
496 # immediate treatment, I either unshifted it to the front of the queue,
497 # or, if it was already in the queue, I spliced and let it bypass the
498 # others. This became a too correct model that made it impossible to put
499 # an item more than once into the queue. Why would you need that? Well,
500 # you need temporary duplicates as the manager of the queue is a loop
503 # (1) looks at the first item in the queue without shifting it off
505 # (2) cares for the item
507 # (3) removes the item from the queue, *even if its agenda failed and
508 # even if the item isn't the first in the queue anymore* (that way
509 # protecting against never ending queues)
511 # So if an item has prerequisites, the installation fails now, but we
512 # want to retry later. That's easy if we have it twice in the queue.
514 # I also expect insane dependency situations where an item gets more
515 # than two lives in the queue. Simplest example is triggered by 'install
516 # Foo Foo Foo'. People make this kind of mistakes and I don't want to
517 # get in the way. I wanted the queue manager to be a dumb servant, not
518 # one that knows everything.
520 # Who would I tell in this model that the user wants to be asked before
521 # processing? I can't attach that information to the module object,
522 # because not modules are installed but distributions. So I'd have to
523 # tell the distribution object that it should ask the user before
524 # processing. Where would the question be triggered then? Most probably
525 # in CPAN::Distribution::rematein.
526 # Hope that makes sense, my head is a bit off:-) -- AK
533 my $self = bless { qmod => $s }, $class;
538 # CPAN::Queue::first ;
544 # CPAN::Queue::delete_first ;
546 my($class,$what) = @_;
548 for my $i (0..$#All) {
549 if ( $All[$i]->{qmod} eq $what ) {
556 # CPAN::Queue::jumpqueue ;
560 CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
561 join(",",map {$_->{qmod}} @All),
564 WHAT: for my $what (reverse @what) {
566 for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
567 CPAN->debug("i[$All[$i]]what[$what]") if $CPAN::DEBUG;
568 if ($All[$i]->{qmod} eq $what){
570 if ($jumped > 100) { # one's OK if e.g. just
571 # processing now; more are OK if
572 # user typed it several times
573 $CPAN::Frontend->mywarn(
574 qq{Object [$what] queued more than 100 times, ignoring}
580 my $obj = bless { qmod => $what }, $class;
583 CPAN->debug(sprintf("after jumpqueue All[%s] what[%s]",
584 join(",",map {$_->{qmod}} @All),
589 # CPAN::Queue::exists ;
591 my($self,$what) = @_;
592 my @all = map { $_->{qmod} } @All;
593 my $exists = grep { $_->{qmod} eq $what } @All;
594 # warn "in exists what[$what] all[@all] exists[$exists]";
598 # CPAN::Queue::delete ;
601 @All = grep { $_->{qmod} ne $mod } @All;
604 # CPAN::Queue::nullify_queue ;
614 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
616 # from here on only subs.
617 ################################################################################
619 sub suggest_myconfig () {
620 SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
621 $CPAN::Frontend->myprint("You don't seem to have a user ".
622 "configuration (MyConfig.pm) yet.\n");
623 my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ".
624 "user configuration now? (Y/n)",
627 CPAN::Shell->mkmyconfig();
630 $CPAN::Frontend->mydie("OK, giving up.");
635 #-> sub CPAN::all_objects ;
637 my($mgr,$class) = @_;
638 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
639 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
641 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
644 # Called by shell, not in batch mode. In batch mode I see no risk in
645 # having many processes updating something as installations are
646 # continually checked at runtime. In shell mode I suspect it is
647 # unintentional to open more than one shell at a time
649 #-> sub CPAN::checklock ;
652 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
653 if (-f $lockfile && -M _ > 0) {
654 my $fh = FileHandle->new($lockfile) or
655 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
656 my $otherpid = <$fh>;
657 my $otherhost = <$fh>;
659 if (defined $otherpid && $otherpid) {
662 if (defined $otherhost && $otherhost) {
665 my $thishost = hostname();
666 if (defined $otherhost && defined $thishost &&
667 $otherhost ne '' && $thishost ne '' &&
668 $otherhost ne $thishost) {
669 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
670 "reports other host $otherhost and other ".
671 "process $otherpid.\n".
672 "Cannot proceed.\n"));
674 elsif (defined $otherpid && $otherpid) {
675 return if $$ == $otherpid; # should never happen
676 $CPAN::Frontend->mywarn(
678 There seems to be running another CPAN process (pid $otherpid). Contacting...
680 if (kill 0, $otherpid) {
681 $CPAN::Frontend->mydie(qq{Other job is running.
682 You may want to kill it and delete the lockfile, maybe. On UNIX try:
686 } elsif (-w $lockfile) {
688 CPAN::Shell::colorable_makemaker_prompt
689 (qq{Other job not responding. Shall I overwrite }.
690 qq{the lockfile '$lockfile'? (Y/n)},"y");
691 $CPAN::Frontend->myexit("Ok, bye\n")
692 unless $ans =~ /^y/i;
695 qq{Lockfile '$lockfile' not writeable by you. }.
696 qq{Cannot proceed.\n}.
698 qq{ rm '$lockfile'\n}.
699 qq{ and then rerun us.\n}
703 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
704 "reports other process with ID ".
705 "$otherpid. Cannot proceed.\n"));
708 my $dotcpan = $CPAN::Config->{cpan_home};
709 eval { File::Path::mkpath($dotcpan);};
711 # A special case at least for Jarkko.
716 $symlinkcpan = readlink $dotcpan;
717 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
718 eval { File::Path::mkpath($symlinkcpan); };
722 $CPAN::Frontend->mywarn(qq{
723 Working directory $symlinkcpan created.
727 unless (-d $dotcpan) {
729 Your configuration suggests "$dotcpan" as your
730 CPAN.pm working directory. I could not create this directory due
731 to this error: $firsterror\n};
733 As "$dotcpan" is a symlink to "$symlinkcpan",
734 I tried to create that, but I failed with this error: $seconderror
737 Please make sure the directory exists and is writable.
739 $CPAN::Frontend->myprint($mess);
740 return suggest_myconfig;
742 } # $@ after eval mkpath $dotcpan
744 unless ($fh = FileHandle->new(">$lockfile")) {
745 if ($! =~ /Permission/) {
746 $CPAN::Frontend->myprint(qq{
748 Your configuration suggests that CPAN.pm should use a working
750 $CPAN::Config->{cpan_home}
751 Unfortunately we could not create the lock file
753 due to permission problems.
755 Please make sure that the configuration variable
756 \$CPAN::Config->{cpan_home}
757 points to a directory where you can write a .lock file. You can set
758 this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
761 return suggest_myconfig;
764 $fh->print($$, "\n");
765 $fh->print(hostname(), "\n");
766 $self->{LOCK} = $lockfile;
770 $CPAN::Frontend->mydie("Got SIGTERM, leaving");
775 $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
776 $CPAN::Frontend->myprint("Caught SIGINT\n");
780 # From: Larry Wall <larry@wall.org>
781 # Subject: Re: deprecating SIGDIE
782 # To: perl5-porters@perl.org
783 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
785 # The original intent of __DIE__ was only to allow you to substitute one
786 # kind of death for another on an application-wide basis without respect
787 # to whether you were in an eval or not. As a global backstop, it should
788 # not be used any more lightly (or any more heavily :-) than class
789 # UNIVERSAL. Any attempt to build a general exception model on it should
790 # be politely squashed. Any bug that causes every eval {} to have to be
791 # modified should be not so politely squashed.
793 # Those are my current opinions. It is also my optinion that polite
794 # arguments degenerate to personal arguments far too frequently, and that
795 # when they do, it's because both people wanted it to, or at least didn't
796 # sufficiently want it not to.
800 # global backstop to cleanup if we should really die
801 $SIG{__DIE__} = \&cleanup;
802 $self->debug("Signal handler set.") if $CPAN::DEBUG;
805 #-> sub CPAN::DESTROY ;
807 &cleanup; # need an eval?
810 #-> sub CPAN::anycwd ;
813 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
818 sub cwd {Cwd::cwd();}
820 #-> sub CPAN::getcwd ;
821 sub getcwd {Cwd::getcwd();}
823 #-> sub CPAN::fastcwd ;
824 sub fastcwd {Cwd::fastcwd();}
826 #-> sub CPAN::backtickcwd ;
827 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
829 #-> sub CPAN::find_perl ;
831 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
832 my $pwd = $CPAN::iCwd = CPAN::anycwd();
833 my $candidate = File::Spec->catfile($pwd,$^X);
834 $perl ||= $candidate if MM->maybe_command($candidate);
837 my ($component,$perl_name);
838 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
839 PATH_COMPONENT: foreach $component (File::Spec->path(),
840 $Config::Config{'binexp'}) {
841 next unless defined($component) && $component;
842 my($abs) = File::Spec->catfile($component,$perl_name);
843 if (MM->maybe_command($abs)) {
855 #-> sub CPAN::exists ;
857 my($mgr,$class,$id) = @_;
858 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
860 ### Carp::croak "exists called without class argument" unless $class;
862 $id =~ s/:+/::/g if $class eq "CPAN::Module";
863 exists $META->{readonly}{$class}{$id} or
864 exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
867 #-> sub CPAN::delete ;
869 my($mgr,$class,$id) = @_;
870 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
871 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
874 #-> sub CPAN::has_usable
875 # has_inst is sometimes too optimistic, we should replace it with this
876 # has_usable whenever a case is given
878 my($self,$mod,$message) = @_;
879 return 1 if $HAS_USABLE->{$mod};
880 my $has_inst = $self->has_inst($mod,$message);
881 return unless $has_inst;
884 LWP => [ # we frequently had "Can't locate object
885 # method "new" via package "LWP::UserAgent" at
886 # (eval 69) line 2006
888 sub {require LWP::UserAgent},
889 sub {require HTTP::Request},
890 sub {require URI::URL},
893 sub {require Net::FTP},
894 sub {require Net::Config},
897 sub {require File::HomeDir;
898 unless (File::HomeDir->VERSION >= 0.52){
899 for ("Will not use File::HomeDir, need 0.52\n") {
900 $CPAN::Frontend->mywarn($_);
907 if ($usable->{$mod}) {
908 for my $c (0..$#{$usable->{$mod}}) {
909 my $code = $usable->{$mod}[$c];
910 my $ret = eval { &$code() };
911 $ret = "" unless defined $ret;
913 # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
918 return $HAS_USABLE->{$mod} = 1;
921 #-> sub CPAN::has_inst
923 my($self,$mod,$message) = @_;
924 Carp::croak("CPAN->has_inst() called without an argument")
926 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
927 keys %{$CPAN::Config->{dontload_hash}||{}},
928 @{$CPAN::Config->{dontload_list}||[]};
929 if (defined $message && $message eq "no" # afair only used by Nox
933 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
941 # checking %INC is wrong, because $INC{LWP} may be true
942 # although $INC{"URI/URL.pm"} may have failed. But as
943 # I really want to say "bla loaded OK", I have to somehow
945 ### warn "$file in %INC"; #debug
947 } elsif (eval { require $file }) {
948 # eval is good: if we haven't yet read the database it's
949 # perfect and if we have installed the module in the meantime,
950 # it tries again. The second require is only a NOOP returning
951 # 1 if we had success, otherwise it's retrying
953 $CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
954 if ($mod eq "CPAN::WAIT") {
955 push @CPAN::Shell::ISA, 'CPAN::WAIT';
958 } elsif ($mod eq "Net::FTP") {
959 $CPAN::Frontend->mywarn(qq{
960 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
962 install Bundle::libnet
964 }) unless $Have_warned->{"Net::FTP"}++;
965 $CPAN::Frontend->mysleep(3);
966 } elsif ($mod eq "Digest::SHA"){
967 if ($Have_warned->{"Digest::SHA"}++) {
968 $CPAN::Frontend->myprint(qq{CPAN: checksum security checks disabled}.
969 qq{because Digest::SHA not installed.\n});
971 $CPAN::Frontend->mywarn(qq{
972 CPAN: checksum security checks disabled because Digest::SHA not installed.
973 Please consider installing the Digest::SHA module.
976 $CPAN::Frontend->mysleep(2);
978 } elsif ($mod eq "Module::Signature"){
979 if (not $CPAN::Config->{check_sigs}) {
980 # they do not want us:-(
981 } elsif (not $Have_warned->{"Module::Signature"}++) {
982 # No point in complaining unless the user can
983 # reasonably install and use it.
984 if (eval { require Crypt::OpenPGP; 1 } ||
986 defined $CPAN::Config->{'gpg'}
988 $CPAN::Config->{'gpg'} =~ /\S/
991 $CPAN::Frontend->mywarn(qq{
992 CPAN: Module::Signature security checks disabled because Module::Signature
993 not installed. Please consider installing the Module::Signature module.
994 You may also need to be able to connect over the Internet to the public
995 keyservers like pgp.mit.edu (port 11371).
998 $CPAN::Frontend->mysleep(2);
1002 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
1007 #-> sub CPAN::instance ;
1009 my($mgr,$class,$id) = @_;
1010 CPAN::Index->reload;
1012 # unsafe meta access, ok?
1013 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
1014 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
1022 #-> sub CPAN::cleanup ;
1024 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
1025 local $SIG{__DIE__} = '';
1030 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
1031 $ineval = 1, last if
1032 $subroutine eq '(eval)';
1034 return if $ineval && !$CPAN::End;
1035 return unless defined $META->{LOCK};
1036 return unless -f $META->{LOCK};
1038 unlink $META->{LOCK};
1040 # Carp::cluck("DEBUGGING");
1041 $CPAN::Frontend->myprint("Lockfile removed.\n");
1044 #-> sub CPAN::savehist
1047 my($histfile,$histsize);
1048 unless ($histfile = $CPAN::Config->{'histfile'}){
1049 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
1052 $histsize = $CPAN::Config->{'histsize'} || 100;
1054 unless ($CPAN::term->can("GetHistory")) {
1055 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
1061 my @h = $CPAN::term->GetHistory;
1062 splice @h, 0, @h-$histsize if @h>$histsize;
1063 my($fh) = FileHandle->new;
1064 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
1065 local $\ = local $, = "\n";
1071 my($self,$what) = @_;
1072 $self->{is_tested}{$what} = 1;
1075 # looks suspicious but maybe it is really intended to set is_tested
1076 # here. Please document next time around
1078 my($self,$what) = @_;
1079 delete $self->{is_tested}{$what};
1084 $self->{is_tested} ||= {};
1085 return unless %{$self->{is_tested}};
1086 my $env = $ENV{PERL5LIB};
1087 $env = $ENV{PERLLIB} unless defined $env;
1089 push @env, $env if defined $env and length $env;
1090 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1091 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1092 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1095 package CPAN::CacheMgr;
1098 #-> sub CPAN::CacheMgr::as_string ;
1100 eval { require Data::Dumper };
1102 return shift->SUPER::as_string;
1104 return Data::Dumper::Dumper(shift);
1108 #-> sub CPAN::CacheMgr::cachesize ;
1113 #-> sub CPAN::CacheMgr::tidyup ;
1116 return unless -d $self->{ID};
1117 while ($self->{DU} > $self->{'MAX'} ) {
1118 my($toremove) = shift @{$self->{FIFO}};
1119 $CPAN::Frontend->myprint(sprintf(
1120 "Deleting from cache".
1121 ": $toremove (%.1f>%.1f MB)\n",
1122 $self->{DU}, $self->{'MAX'})
1124 return if $CPAN::Signal;
1125 $self->force_clean_cache($toremove);
1126 return if $CPAN::Signal;
1130 #-> sub CPAN::CacheMgr::dir ;
1135 #-> sub CPAN::CacheMgr::entries ;
1137 my($self,$dir) = @_;
1138 return unless defined $dir;
1139 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1140 $dir ||= $self->{ID};
1141 my($cwd) = CPAN::anycwd();
1142 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1143 my $dh = DirHandle->new(File::Spec->curdir)
1144 or Carp::croak("Couldn't opendir $dir: $!");
1147 next if $_ eq "." || $_ eq "..";
1149 push @entries, File::Spec->catfile($dir,$_);
1151 push @entries, File::Spec->catdir($dir,$_);
1153 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1156 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1157 sort { -M $b <=> -M $a} @entries;
1160 #-> sub CPAN::CacheMgr::disk_usage ;
1162 my($self,$dir) = @_;
1163 return if exists $self->{SIZE}{$dir};
1164 return if $CPAN::Signal;
1168 unless (chmod 0755, $dir) {
1169 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1170 "permission to change the permission; cannot ".
1171 "estimate disk usage of '$dir'\n");
1172 $CPAN::Frontend->mysleep(5);
1177 $CPAN::Frontend->mywarn("Directory '$dir' has gone. Cannot continue.\n");
1178 $CPAN::Frontend->mysleep(2);
1183 $File::Find::prune++ if $CPAN::Signal;
1185 if ($^O eq 'MacOS') {
1187 my $cat = Mac::Files::FSpGetCatInfo($_);
1188 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1192 unless (chmod 0755, $_) {
1193 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1194 "the permission to change the permission; ".
1195 "can only partially estimate disk usage ".
1197 $CPAN::Frontend->mysleep(5);
1208 return if $CPAN::Signal;
1209 $self->{SIZE}{$dir} = $Du/1024/1024;
1210 push @{$self->{FIFO}}, $dir;
1211 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1212 $self->{DU} += $Du/1024/1024;
1216 #-> sub CPAN::CacheMgr::force_clean_cache ;
1217 sub force_clean_cache {
1218 my($self,$dir) = @_;
1219 return unless -e $dir;
1220 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1222 File::Path::rmtree($dir);
1223 $self->{DU} -= $self->{SIZE}{$dir};
1224 delete $self->{SIZE}{$dir};
1227 #-> sub CPAN::CacheMgr::new ;
1234 ID => $CPAN::Config->{'build_dir'},
1235 MAX => $CPAN::Config->{'build_cache'},
1236 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1239 File::Path::mkpath($self->{ID});
1240 my $dh = DirHandle->new($self->{ID});
1241 bless $self, $class;
1244 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1246 CPAN->debug($debug) if $CPAN::DEBUG;
1250 #-> sub CPAN::CacheMgr::scan_cache ;
1253 return if $self->{SCAN} eq 'never';
1254 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1255 unless $self->{SCAN} eq 'atstart';
1256 $CPAN::Frontend->myprint(
1257 sprintf("Scanning cache %s for sizes\n",
1260 for $e ($self->entries($self->{ID})) {
1261 next if $e eq ".." || $e eq ".";
1262 $self->disk_usage($e);
1263 return if $CPAN::Signal;
1268 package CPAN::Shell;
1271 #-> sub CPAN::Shell::h ;
1273 my($class,$about) = @_;
1274 if (defined $about) {
1275 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1277 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1278 $CPAN::Frontend->myprint(qq{
1279 Display Information $filler (ver $CPAN::VERSION)
1280 command argument description
1281 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1282 i WORD or /REGEXP/ about any of the above
1283 ls AUTHOR or GLOB about files in the author's directory
1284 (with WORD being a module, bundle or author name or a distribution
1285 name of the form AUTHOR/DISTRIBUTION)
1287 Download, Test, Make, Install...
1288 get download clean make clean
1289 make make (implies get) look open subshell in dist directory
1290 test make test (implies make) readme display these README files
1291 install make install (implies test) perldoc display POD documentation
1294 force COMMAND unconditionally do command
1295 notest COMMAND skip testing
1298 h,? display this menu ! perl-code eval a perl command
1299 r report module updates upgrade upgrade all modules
1300 o conf [opt] set and query options q quit the cpan shell
1301 reload cpan load CPAN.pm again reload index load newer indices
1302 autobundle Snapshot recent latest CPAN uploads});
1308 #-> sub CPAN::Shell::a ;
1310 my($self,@arg) = @_;
1311 # authors are always UPPERCASE
1313 $_ = uc $_ unless /=/;
1315 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1318 #-> sub CPAN::Shell::globls ;
1320 my($self,$s,$pragmas) = @_;
1321 # ls is really very different, but we had it once as an ordinary
1322 # command in the Shell (upto rev. 321) and we could not handle
1324 my(@accept,@preexpand);
1325 if ($s =~ /[\*\?\/]/) {
1326 if ($CPAN::META->has_inst("Text::Glob")) {
1327 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1328 my $rau = Text::Glob::glob_to_regex(uc $au);
1329 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1331 push @preexpand, map { $_->id . "/" . $pathglob }
1332 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1334 my $rau = Text::Glob::glob_to_regex(uc $s);
1335 push @preexpand, map { $_->id }
1336 CPAN::Shell->expand_by_method('CPAN::Author',
1341 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1344 push @preexpand, uc $s;
1347 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1348 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1353 my $silent = @accept>1;
1354 my $last_alpha = "";
1356 for my $a (@accept){
1357 my($author,$pathglob);
1358 if ($a =~ m|(.*?)/(.*)|) {
1361 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1363 $a2) or die "No author found for $a2";
1365 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1367 $a) or die "No author found for $a";
1370 my $alpha = substr $author->id, 0, 1;
1372 if ($alpha eq $last_alpha) {
1376 $last_alpha = $alpha;
1378 $CPAN::Frontend->myprint($ad);
1380 for my $pragma (@$pragmas) {
1381 if ($author->can($pragma)) {
1385 push @results, $author->ls($pathglob,$silent); # silent if
1388 for my $pragma (@$pragmas) {
1389 my $meth = "un$pragma";
1390 if ($author->can($meth)) {
1398 #-> sub CPAN::Shell::local_bundles ;
1400 my($self,@which) = @_;
1401 my($incdir,$bdir,$dh);
1402 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1403 my @bbase = "Bundle";
1404 while (my $bbase = shift @bbase) {
1405 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1406 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1407 if ($dh = DirHandle->new($bdir)) { # may fail
1409 for $entry ($dh->read) {
1410 next if $entry =~ /^\./;
1411 next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
1412 if (-d File::Spec->catdir($bdir,$entry)){
1413 push @bbase, "$bbase\::$entry";
1415 next unless $entry =~ s/\.pm(?!\n)\Z//;
1416 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1424 #-> sub CPAN::Shell::b ;
1426 my($self,@which) = @_;
1427 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1428 $self->local_bundles;
1429 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1432 #-> sub CPAN::Shell::d ;
1433 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1435 #-> sub CPAN::Shell::m ;
1436 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1438 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1441 #-> sub CPAN::Shell::i ;
1445 @args = '/./' unless @args;
1447 for my $type (qw/Bundle Distribution Module/) {
1448 push @result, $self->expand($type,@args);
1450 # Authors are always uppercase.
1451 push @result, $self->expand("Author", map { uc $_ } @args);
1453 my $result = @result == 1 ?
1454 $result[0]->as_string :
1456 "No objects found of any type for argument @args\n" :
1458 (map {$_->as_glimpse} @result),
1459 scalar @result, " items found\n",
1461 $CPAN::Frontend->myprint($result);
1464 #-> sub CPAN::Shell::o ;
1466 # CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o
1467 # conf' calls through to CPAN::HandleConfig::edit. 'o conf' should
1468 # have been called 'set' and 'o debug' maybe 'set debug' or 'debug'
1469 # 'o conf XXX' calls ->edit in CPAN/HandleConfig.pm
1471 my($self,$o_type,@o_what) = @_;
1474 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1475 if ($o_type eq 'conf') {
1476 if (!@o_what) { # print all things, "o conf"
1478 $CPAN::Frontend->myprint("\$CPAN::Config options from ");
1480 if (exists $INC{'CPAN/Config.pm'}) {
1481 push @from, $INC{'CPAN/Config.pm'};
1483 if (exists $INC{'CPAN/MyConfig.pm'}) {
1484 push @from, $INC{'CPAN/MyConfig.pm'};
1486 $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
1487 $CPAN::Frontend->myprint(":\n");
1488 for $k (sort keys %CPAN::HandleConfig::can) {
1489 $v = $CPAN::HandleConfig::can{$k};
1490 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
1492 $CPAN::Frontend->myprint("\n");
1493 for $k (sort keys %$CPAN::Config) {
1494 CPAN::HandleConfig->prettyprint($k);
1496 $CPAN::Frontend->myprint("\n");
1497 } elsif (!CPAN::HandleConfig->edit(@o_what)) {
1498 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
1501 } elsif ($o_type eq 'debug') {
1503 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1506 my($what) = shift @o_what;
1507 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1508 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1511 if ( exists $CPAN::DEBUG{$what} ) {
1512 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1513 } elsif ($what =~ /^\d/) {
1514 $CPAN::DEBUG = $what;
1515 } elsif (lc $what eq 'all') {
1517 for (values %CPAN::DEBUG) {
1520 $CPAN::DEBUG = $max;
1523 for (keys %CPAN::DEBUG) {
1524 next unless lc($_) eq lc($what);
1525 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1528 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1533 my $raw = "Valid options for debug are ".
1534 join(", ",sort(keys %CPAN::DEBUG), 'all').
1535 qq{ or a number. Completion works on the options. }.
1536 qq{Case is ignored.};
1538 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1539 $CPAN::Frontend->myprint("\n\n");
1542 $CPAN::Frontend->myprint("Options set for debugging:\n");
1544 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1545 $v = $CPAN::DEBUG{$k};
1546 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1547 if $v & $CPAN::DEBUG;
1550 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1553 $CPAN::Frontend->myprint(qq{
1555 conf set or get configuration variables
1556 debug set or get debugging options
1561 sub paintdots_onreload {
1564 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
1568 # $CPAN::Frontend->myprint(".($subr)");
1569 $CPAN::Frontend->myprint(".");
1576 #-> sub CPAN::Shell::reload ;
1578 my($self,$command,@arg) = @_;
1580 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1581 if ($command =~ /cpan/i) {
1583 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
1587 "CPAN/HandleConfig.pm",
1588 "CPAN/FirstTime.pm",
1593 if ($CPAN::Config->{test_report}) {
1594 push @relo, "CPAN/Reporter.pm";
1596 MFILE: for my $f (@relo) {
1597 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
1598 $self->reload_this($f) or $failed++;
1600 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1601 $failed++ unless $redef;
1603 $CPAN::Frontend->mywarn("\n$failed errors during reload. You better quit ".
1606 } elsif ($command =~ /index/) {
1607 CPAN::Index->force_reload;
1609 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
1610 index re-reads the index files\n});
1614 # reload means only load again what we have loaded before
1615 #-> sub CPAN::Shell::reload_this ;
1618 return 1 unless $INC{$f}; # we never loaded this, so we do not
1620 my $pwd = CPAN::anycwd();
1621 CPAN->debug("reloading the whole '$f' from '$INC{$f}' while pwd='$pwd'")
1624 for my $inc (@INC) {
1625 $read = File::Spec->catfile($inc,split /\//, $f);
1632 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
1635 my $fh = FileHandle->new($read) or
1636 $CPAN::Frontend->mydie("Could not open $read: $!");
1640 CPAN->debug(sprintf("evaling [%s...]\n",substr($eval,0,64)))
1650 #-> sub CPAN::Shell::mkmyconfig ;
1652 my($self, $cpanpm, %args) = @_;
1653 require CPAN::FirstTime;
1654 my $home = CPAN::HandleConfig::home;
1655 $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
1656 File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
1657 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
1658 CPAN::HandleConfig::require_myconfig_or_config;
1659 $CPAN::Config ||= {};
1664 keep_source_where => undef,
1667 CPAN::FirstTime::init($cpanpm, %args);
1670 #-> sub CPAN::Shell::_binary_extensions ;
1671 sub _binary_extensions {
1672 my($self) = shift @_;
1673 my(@result,$module,%seen,%need,$headerdone);
1674 for $module ($self->expand('Module','/./')) {
1675 my $file = $module->cpan_file;
1676 next if $file eq "N/A";
1677 next if $file =~ /^Contact Author/;
1678 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
1679 next if $dist->isa_perl;
1680 next unless $module->xs_file;
1682 $CPAN::Frontend->myprint(".");
1683 push @result, $module;
1685 # print join " | ", @result;
1686 $CPAN::Frontend->myprint("\n");
1690 #-> sub CPAN::Shell::recompile ;
1692 my($self) = shift @_;
1693 my($module,@module,$cpan_file,%dist);
1694 @module = $self->_binary_extensions();
1695 for $module (@module){ # we force now and compile later, so we
1697 $cpan_file = $module->cpan_file;
1698 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1700 $dist{$cpan_file}++;
1702 for $cpan_file (sort keys %dist) {
1703 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1704 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1706 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1707 # stop a package from recompiling,
1708 # e.g. IO-1.12 when we have perl5.003_10
1712 #-> sub CPAN::Shell::scripts ;
1714 my($self, $arg) = @_;
1715 $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n");
1717 for my $req (qw( HTML::LinkExtor Sort::Versions List::Util )) {
1718 unless ($CPAN::META->has_inst($req)) {
1719 $CPAN::Frontend->mywarn(" $req not available\n");
1722 my $p = HTML::LinkExtor->new();
1723 my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html";
1724 unless (-f $indexfile) {
1725 $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n");
1727 $p->parse_file($indexfile);
1730 if ($arg =~ s|^/(.+)/$|$1|) {
1731 $qrarg = eval 'qr/$arg/'; # hide construct from 5.004
1733 for my $l ($p->links) {
1734 my $tag = shift @$l;
1735 next unless $tag eq "a";
1737 my $href = $att{href};
1738 next unless $href =~ s|^\.\./authors/id/./../||;
1741 if ($href =~ $qrarg) {
1745 if ($href =~ /\Q$arg\E/) {
1753 # now filter for the latest version if there is more than one of a name
1759 $stems{$stem} ||= [];
1760 push @{$stems{$stem}}, $href;
1762 for (sort keys %stems) {
1764 if (@{$stems{$_}} > 1) {
1765 $highest = List::Util::reduce {
1766 Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b
1769 $highest = $stems{$_}[0];
1771 $CPAN::Frontend->myprint("$highest\n");
1775 #-> sub CPAN::Shell::upgrade ;
1777 my($self) = shift @_;
1778 $self->install($self->r);
1781 #-> sub CPAN::Shell::_u_r_common ;
1783 my($self) = shift @_;
1784 my($what) = shift @_;
1785 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1786 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
1787 $what && $what =~ /^[aru]$/;
1789 @args = '/./' unless @args;
1790 my(@result,$module,%seen,%need,$headerdone,
1791 $version_undefs,$version_zeroes);
1792 $version_undefs = $version_zeroes = 0;
1793 my $sprintf = "%s%-25s%s %9s %9s %s\n";
1794 my @expand = $self->expand('Module',@args);
1795 my $expand = scalar @expand;
1796 if (0) { # Looks like noise to me, was very useful for debugging
1797 # for metadata cache
1798 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
1800 MODULE: for $module (@expand) {
1801 my $file = $module->cpan_file;
1802 next MODULE unless defined $file; # ??
1803 $file =~ s|^./../||;
1804 my($latest) = $module->cpan_version;
1805 my($inst_file) = $module->inst_file;
1807 return if $CPAN::Signal;
1810 $have = $module->inst_version;
1811 } elsif ($what eq "r") {
1812 $have = $module->inst_version;
1814 if ($have eq "undef"){
1816 } elsif ($have == 0){
1819 next MODULE unless CPAN::Version->vgt($latest, $have);
1820 # to be pedantic we should probably say:
1821 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
1822 # to catch the case where CPAN has a version 0 and we have a version undef
1823 } elsif ($what eq "u") {
1829 } elsif ($what eq "r") {
1831 } elsif ($what eq "u") {
1835 return if $CPAN::Signal; # this is sometimes lengthy
1838 push @result, sprintf "%s %s\n", $module->id, $have;
1839 } elsif ($what eq "r") {
1840 push @result, $module->id;
1841 next MODULE if $seen{$file}++;
1842 } elsif ($what eq "u") {
1843 push @result, $module->id;
1844 next MODULE if $seen{$file}++;
1845 next MODULE if $file =~ /^Contact/;
1847 unless ($headerdone++){
1848 $CPAN::Frontend->myprint("\n");
1849 $CPAN::Frontend->myprint(sprintf(
1852 "Package namespace",
1864 $CPAN::META->has_inst("Term::ANSIColor")
1866 $module->description
1868 $color_on = Term::ANSIColor::color("green");
1869 $color_off = Term::ANSIColor::color("reset");
1871 $CPAN::Frontend->myprint(sprintf $sprintf,
1878 $need{$module->id}++;
1882 $CPAN::Frontend->myprint("No modules found for @args\n");
1883 } elsif ($what eq "r") {
1884 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
1888 if ($version_zeroes) {
1889 my $s_has = $version_zeroes > 1 ? "s have" : " has";
1890 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
1891 qq{a version number of 0\n});
1893 if ($version_undefs) {
1894 my $s_has = $version_undefs > 1 ? "s have" : " has";
1895 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
1896 qq{parseable version number\n});
1902 #-> sub CPAN::Shell::r ;
1904 shift->_u_r_common("r",@_);
1907 #-> sub CPAN::Shell::u ;
1909 shift->_u_r_common("u",@_);
1912 #-> sub CPAN::Shell::failed ;
1914 my($self,$only_id,$silent) = @_;
1916 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
1918 NAY: for my $nosayer (
1926 next unless exists $d->{$nosayer};
1928 $d->{$nosayer}->can("failed") ?
1929 $d->{$nosayer}->failed :
1930 $d->{$nosayer} =~ /^NO/
1932 next NAY if $only_id && $only_id != (
1933 $d->{$nosayer}->can("commandid")
1935 $d->{$nosayer}->commandid
1937 $CPAN::CurrentCommandId
1942 next DIST unless $failed;
1946 # " %-45s: %s %s\n",
1949 $d->{$failed}->can("failed") ?
1951 $d->{$failed}->commandid,
1954 $d->{$failed}->text,
1964 my $scope = $only_id ? "command" : "session";
1966 my $print = join "",
1967 map { sprintf " %-45s: %s %s\n", @$_[1,2,3] }
1968 sort { $a->[0] <=> $b->[0] } @failed;
1969 $CPAN::Frontend->myprint("Failed during this $scope:\n$print");
1970 } elsif (!$only_id || !$silent) {
1971 $CPAN::Frontend->myprint("Nothing failed in this $scope\n");
1975 # XXX intentionally undocumented because completely bogus, unportable,
1978 #-> sub CPAN::Shell::status ;
1981 require Devel::Size;
1982 my $ps = FileHandle->new;
1983 open $ps, "/proc/$$/status";
1986 next unless /VmSize:\s+(\d+)/;
1990 $CPAN::Frontend->mywarn(sprintf(
1991 "%-27s %6d\n%-27s %6d\n",
1995 Devel::Size::total_size($CPAN::META)/1024,
1997 for my $k (sort keys %$CPAN::META) {
1998 next unless substr($k,0,4) eq "read";
1999 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
2000 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
2001 warn sprintf " %-25s %6d %6d\n",
2003 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
2004 scalar keys %{$CPAN::META->{$k}{$k2}};
2009 #-> sub CPAN::Shell::autobundle ;
2012 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
2013 my(@bundle) = $self->_u_r_common("a",@_);
2014 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2015 File::Path::mkpath($todir);
2016 unless (-d $todir) {
2017 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
2020 my($y,$m,$d) = (localtime)[5,4,3];
2024 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
2025 my($to) = File::Spec->catfile($todir,"$me.pm");
2027 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
2028 $to = File::Spec->catfile($todir,"$me.pm");
2030 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
2032 "package Bundle::$me;\n\n",
2033 "\$VERSION = '0.01';\n\n",
2037 "Bundle::$me - Snapshot of installation on ",
2038 $Config::Config{'myhostname'},
2041 "\n\n=head1 SYNOPSIS\n\n",
2042 "perl -MCPAN -e 'install Bundle::$me'\n\n",
2043 "=head1 CONTENTS\n\n",
2044 join("\n", @bundle),
2045 "\n\n=head1 CONFIGURATION\n\n",
2047 "\n\n=head1 AUTHOR\n\n",
2048 "This Bundle has been generated automatically ",
2049 "by the autobundle routine in CPAN.pm.\n",
2052 $CPAN::Frontend->myprint("\nWrote bundle file
2056 #-> sub CPAN::Shell::expandany ;
2059 CPAN->debug("s[$s]") if $CPAN::DEBUG;
2060 if ($s =~ m|/|) { # looks like a file
2061 $s = CPAN::Distribution->normalize($s);
2062 return $CPAN::META->instance('CPAN::Distribution',$s);
2063 # Distributions spring into existence, not expand
2064 } elsif ($s =~ m|^Bundle::|) {
2065 $self->local_bundles; # scanning so late for bundles seems
2066 # both attractive and crumpy: always
2067 # current state but easy to forget
2069 return $self->expand('Bundle',$s);
2071 return $self->expand('Module',$s)
2072 if $CPAN::META->exists('CPAN::Module',$s);
2077 #-> sub CPAN::Shell::expand ;
2080 my($type,@args) = @_;
2081 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
2082 my $class = "CPAN::$type";
2083 my $methods = ['id'];
2084 for my $meth (qw(name)) {
2085 next if $] < 5.00303; # no "can"
2086 next unless $class->can($meth);
2087 push @$methods, $meth;
2089 $self->expand_by_method($class,$methods,@args);
2092 sub expand_by_method {
2094 my($class,$methods,@args) = @_;
2097 my($regex,$command);
2098 if ($arg =~ m|^/(.*)/$|) {
2100 } elsif ($arg =~ m/=/) {
2104 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
2106 defined $regex ? $regex : "UNDEFINED",
2107 defined $command ? $command : "UNDEFINED",
2109 if (defined $regex) {
2111 $CPAN::META->all_objects($class)
2114 # BUG, we got an empty object somewhere
2115 require Data::Dumper;
2116 CPAN->debug(sprintf(
2117 "Bug in CPAN: Empty id on obj[%s][%s]",
2119 Data::Dumper::Dumper($obj)
2123 for my $method (@$methods) {
2124 if ($obj->$method() =~ /$regex/i) {
2130 } elsif ($command) {
2131 die "equal sign in command disabled (immature interface), ".
2133 ! \$CPAN::Shell::ADVANCED_QUERY=1
2134 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
2135 that may go away anytime.\n"
2136 unless $ADVANCED_QUERY;
2137 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
2138 my($matchcrit) = $criterion =~ m/^~(.+)/;
2142 $CPAN::META->all_objects($class)
2144 my $lhs = $self->$method() or next; # () for 5.00503
2146 push @m, $self if $lhs =~ m/$matchcrit/;
2148 push @m, $self if $lhs eq $criterion;
2153 if ( $class eq 'CPAN::Bundle' ) {
2154 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
2155 } elsif ($class eq "CPAN::Distribution") {
2156 $xarg = CPAN::Distribution->normalize($arg);
2160 if ($CPAN::META->exists($class,$xarg)) {
2161 $obj = $CPAN::META->instance($class,$xarg);
2162 } elsif ($CPAN::META->exists($class,$arg)) {
2163 $obj = $CPAN::META->instance($class,$arg);
2170 @m = sort {$a->id cmp $b->id} @m;
2171 if ( $CPAN::DEBUG ) {
2172 my $wantarray = wantarray;
2173 my $join_m = join ",", map {$_->id} @m;
2174 $self->debug("wantarray[$wantarray]join_m[$join_m]");
2176 return wantarray ? @m : $m[0];
2179 #-> sub CPAN::Shell::format_result ;
2182 my($type,@args) = @_;
2183 @args = '/./' unless @args;
2184 my(@result) = $self->expand($type,@args);
2185 my $result = @result == 1 ?
2186 $result[0]->as_string :
2188 "No objects of type $type found for argument @args\n" :
2190 (map {$_->as_glimpse} @result),
2191 scalar @result, " items found\n",
2196 #-> sub CPAN::Shell::report_fh ;
2198 my $installation_report_fh;
2199 my $previously_noticed = 0;
2202 return $installation_report_fh if $installation_report_fh;
2203 if ($CPAN::META->has_inst("File::Temp")) {
2204 $installation_report_fh
2206 template => 'cpan_install_XXXX',
2211 unless ( $installation_report_fh ) {
2212 warn("Couldn't open installation report file; " .
2213 "no report file will be generated."
2214 ) unless $previously_noticed++;
2220 # The only reason for this method is currently to have a reliable
2221 # debugging utility that reveals which output is going through which
2222 # channel. No, I don't like the colors ;-)
2224 # to turn colordebugging on, write
2225 # cpan> o conf colorize_output 1
2227 #-> sub CPAN::Shell::print_ornamented ;
2229 my $print_ornamented_have_warned = 0;
2230 sub colorize_output {
2231 my $colorize_output = $CPAN::Config->{colorize_output};
2232 if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) {
2233 unless ($print_ornamented_have_warned++) {
2234 # no myprint/mywarn within myprint/mywarn!
2235 warn "Colorize_output is set to true but Term::ANSIColor is not
2236 installed. To activate colorized output, please install Term::ANSIColor.\n\n";
2238 $colorize_output = 0;
2240 return $colorize_output;
2245 sub print_ornamented {
2246 my($self,$what,$ornament) = @_;
2247 return unless defined $what;
2249 local $| = 1; # Flush immediately
2250 if ( $CPAN::Be_Silent ) {
2251 print {report_fh()} $what;
2254 my $swhat = "$what"; # stringify if it is an object
2255 if ($CPAN::Config->{term_is_latin}){
2258 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
2260 if ($self->colorize_output) {
2261 my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
2263 print "Term::ANSIColor rejects color[$ornament]: $@\n
2264 Please choose a different color (Hint: try 'o conf init color.*')\n";
2266 my $colorstyle = 0; # (=0) works, (=1) tries to make
2267 # background colors more attractive by
2268 # appending whitespace to short lines, it
2269 # seems also to work but is less tested;
2270 # for testing use the make target
2271 # testshell-with-protocol-twice; overall
2272 # seems not worth any effort
2273 if ($colorstyle == 1) {
2275 my $longest = 0; # Does list::util work on 5.004?
2276 for $line (split /\n/, $swhat) {
2277 $longest = length($line) if length($line) > $longest;
2279 $longest = 78 if $longest > 78; # yes, arbitrary, who wants it set-able?
2280 my $nl = chomp $swhat ? "\n" : "";
2281 my $block = join "",
2283 sprintf("%s%-*s%s%s",
2287 Term::ANSIColor::color("reset"),
2291 split /[\r\t ]*\n/, $swhat, -1;
2296 Term::ANSIColor::color("reset");
2303 # where is myprint/mywarn/Frontend/etc. documented? We need guidelines
2304 # where to use what! I think, we send everything to STDOUT and use
2305 # print for normal/good news and warn for news that need more
2306 # attention. Yes, this is our working contract for now.
2308 my($self,$what) = @_;
2310 $self->print_ornamented($what, $CPAN::Config->{colorize_print}||'bold blue on_white');
2314 my($self,$what) = @_;
2315 $self->myprint($what);
2320 my($self,$what) = @_;
2321 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2324 # only to be used for shell commands
2326 my($self,$what) = @_;
2327 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2329 # If it is the shell, we want that the following die to be silent,
2330 # but if it is not the shell, we would need a 'die $what'. We need
2331 # to take care that only shell commands use mydie. Is this
2337 # sub CPAN::Shell::colorable_makemaker_prompt
2338 sub colorable_makemaker_prompt {
2340 if (CPAN::Shell->colorize_output) {
2341 my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white';
2342 my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
2345 my $ans = ExtUtils::MakeMaker::prompt($foo,$bar);
2346 if (CPAN::Shell->colorize_output) {
2347 print Term::ANSIColor::color('reset');
2352 # use this only for unrecoverable errors!
2353 sub unrecoverable_error {
2354 my($self,$what) = @_;
2355 my @lines = split /\n/, $what;
2357 for my $l (@lines) {
2358 $longest = length $l if length $l > $longest;
2360 $longest = 62 if $longest > 62;
2361 for my $l (@lines) {
2367 if (length $l < 66) {
2368 $l = pack "A66 A*", $l, "<==";
2372 unshift @lines, "\n";
2373 $self->mydie(join "", @lines);
2377 my($self, $sleep) = @_;
2382 return if -t STDOUT;
2383 my $odef = select STDERR;
2390 #-> sub CPAN::Shell::rematein ;
2391 # RE-adme||MA-ke||TE-st||IN-stall
2394 my($meth,@some) = @_;
2396 while($meth =~ /^(force|notest)$/) {
2397 push @pragma, $meth;
2398 $meth = shift @some or
2399 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
2403 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
2405 # Here is the place to set "test_count" on all involved parties to
2406 # 0. We then can pass this counter on to the involved
2407 # distributions and those can refuse to test if test_count > X. In
2408 # the first stab at it we could use a 1 for "X".
2410 # But when do I reset the distributions to start with 0 again?
2411 # Jost suggested to have a random or cycling interaction ID that
2412 # we pass through. But the ID is something that is just left lying
2413 # around in addition to the counter, so I'd prefer to set the
2414 # counter to 0 now, and repeat at the end of the loop. But what
2415 # about dependencies? They appear later and are not reset, they
2416 # enter the queue but not its copy. How do they get a sensible
2419 # construct the queue
2421 STHING: foreach $s (@some) {
2424 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
2426 } elsif ($s =~ m|^/|) { # looks like a regexp
2427 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
2429 $CPAN::Frontend->mysleep(2);
2431 } elsif ($meth eq "ls") {
2432 $self->globls($s,\@pragma);
2435 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
2436 $obj = CPAN::Shell->expandany($s);
2439 $obj->color_cmd_tmps(0,1);
2440 CPAN::Queue->new($obj->id);
2442 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
2443 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
2444 if ($meth =~ /^(dump|ls)$/) {
2447 $CPAN::Frontend->mywarn(
2449 "Don't be silly, you can't $meth ",
2453 $CPAN::Frontend->mysleep(2);
2457 ->mywarn(qq{Warning: Cannot $meth $s, }.
2458 qq{don\'t know what it is.
2463 to find objects with matching identifiers.
2465 $CPAN::Frontend->mysleep(2);
2469 # queuerunner (please be warned: when I started to change the
2470 # queue to hold objects instead of names, I made one or two
2471 # mistakes and never found which. I reverted back instead)
2472 while ($s = CPAN::Queue->first) {
2475 $obj = $s; # I do not believe, we would survive if this happened
2477 $obj = CPAN::Shell->expandany($s);
2479 for my $pragma (@pragma) {
2482 ($] < 5.00303 || $obj->can($pragma))){
2483 ### compatibility with 5.003
2484 $obj->$pragma($meth); # the pragma "force" in
2485 # "CPAN::Distribution" must know
2486 # what we are intending
2489 if ($]>=5.00303 && $obj->can('called_for')) {
2490 $obj->called_for($s);
2493 qq{pragma[@pragma]meth[$meth]obj[$obj]as_string[$obj->{ID}]}
2497 CPAN::Queue->delete($s);
2499 CPAN->debug("failed");
2503 CPAN::Queue->delete_first($s);
2505 for my $obj (@qcopy) {
2506 $obj->color_cmd_tmps(0,0);
2507 delete $obj->{incommandcolor};
2511 #-> sub CPAN::Shell::recent ;
2515 CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
2520 # set up the dispatching methods
2522 for my $command (qw(
2537 *$command = sub { shift->rematein($command, @_); };
2541 package CPAN::LWP::UserAgent;
2545 return if $SETUPDONE;
2546 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2547 require LWP::UserAgent;
2548 @ISA = qw(Exporter LWP::UserAgent);
2551 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
2555 sub get_basic_credentials {
2556 my($self, $realm, $uri, $proxy) = @_;
2557 if ($USER && $PASSWD) {
2558 return ($USER, $PASSWD);
2561 ($USER,$PASSWD) = $self->get_proxy_credentials();
2563 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
2565 return($USER,$PASSWD);
2568 sub get_proxy_credentials {
2570 my ($user, $password);
2571 if ( defined $CPAN::Config->{proxy_user} &&
2572 defined $CPAN::Config->{proxy_pass}) {
2573 $user = $CPAN::Config->{proxy_user};
2574 $password = $CPAN::Config->{proxy_pass};
2575 return ($user, $password);
2577 my $username_prompt = "\nProxy authentication needed!
2578 (Note: to permanently configure username and password run
2579 o conf proxy_user your_username
2580 o conf proxy_pass your_password
2582 ($user, $password) =
2583 _get_username_and_password_from_user($username_prompt);
2584 return ($user,$password);
2587 sub get_non_proxy_credentials {
2589 my ($user,$password);
2590 if ( defined $CPAN::Config->{username} &&
2591 defined $CPAN::Config->{password}) {
2592 $user = $CPAN::Config->{username};
2593 $password = $CPAN::Config->{password};
2594 return ($user, $password);
2596 my $username_prompt = "\nAuthentication needed!
2597 (Note: to permanently configure username and password run
2598 o conf username your_username
2599 o conf password your_password
2602 ($user, $password) =
2603 _get_username_and_password_from_user($username_prompt);
2604 return ($user,$password);
2607 sub _get_username_and_password_from_user {
2609 my $username_message = shift;
2610 my ($username,$password);
2612 ExtUtils::MakeMaker->import(qw(prompt));
2613 $username = prompt($username_message);
2614 if ($CPAN::META->has_inst("Term::ReadKey")) {
2615 Term::ReadKey::ReadMode("noecho");
2618 $CPAN::Frontend->mywarn(
2619 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
2622 $password = prompt("Password:");
2624 if ($CPAN::META->has_inst("Term::ReadKey")) {
2625 Term::ReadKey::ReadMode("restore");
2627 $CPAN::Frontend->myprint("\n\n");
2628 return ($username,$password);
2631 # mirror(): Its purpose is to deal with proxy authentication. When we
2632 # call SUPER::mirror, we relly call the mirror method in
2633 # LWP::UserAgent. LWP::UserAgent will then call
2634 # $self->get_basic_credentials or some equivalent and this will be
2635 # $self->dispatched to our own get_basic_credentials method.
2637 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2639 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2640 # although we have gone through our get_basic_credentials, the proxy
2641 # server refuses to connect. This could be a case where the username or
2642 # password has changed in the meantime, so I'm trying once again without
2643 # $USER and $PASSWD to give the get_basic_credentials routine another
2644 # chance to set $USER and $PASSWD.
2646 # mirror(): Its purpose is to deal with proxy authentication. When we
2647 # call SUPER::mirror, we relly call the mirror method in
2648 # LWP::UserAgent. LWP::UserAgent will then call
2649 # $self->get_basic_credentials or some equivalent and this will be
2650 # $self->dispatched to our own get_basic_credentials method.
2652 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2654 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2655 # although we have gone through our get_basic_credentials, the proxy
2656 # server refuses to connect. This could be a case where the username or
2657 # password has changed in the meantime, so I'm trying once again without
2658 # $USER and $PASSWD to give the get_basic_credentials routine another
2659 # chance to set $USER and $PASSWD.
2662 my($self,$url,$aslocal) = @_;
2663 my $result = $self->SUPER::mirror($url,$aslocal);
2664 if ($result->code == 407) {
2667 $result = $self->SUPER::mirror($url,$aslocal);
2675 #-> sub CPAN::FTP::ftp_get ;
2677 my($class,$host,$dir,$file,$target) = @_;
2679 qq[Going to fetch file [$file] from dir [$dir]
2680 on host [$host] as local [$target]\n]
2682 my $ftp = Net::FTP->new($host);
2684 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
2687 return 0 unless defined $ftp;
2688 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
2689 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
2690 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
2691 my $msg = $ftp->message;
2692 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
2695 unless ( $ftp->cwd($dir) ){
2696 my $msg = $ftp->message;
2697 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
2701 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
2702 unless ( $ftp->get($file,$target) ){
2703 my $msg = $ftp->message;
2704 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
2707 $ftp->quit; # it's ok if this fails
2711 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
2713 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
2714 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
2716 # > *** 1562,1567 ****
2717 # > --- 1562,1580 ----
2718 # > return 1 if substr($url,0,4) eq "file";
2719 # > return 1 unless $url =~ m|://([^/]+)|;
2721 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
2723 # > + $proxy =~ m|://([^/:]+)|;
2725 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
2726 # > + if ($noproxy) {
2727 # > + if ($host !~ /$noproxy$/) {
2728 # > + $host = $proxy;
2731 # > + $host = $proxy;
2734 # > require Net::Ping;
2735 # > return 1 unless $Net::Ping::VERSION >= 2;
2739 #-> sub CPAN::FTP::localize ;
2741 my($self,$file,$aslocal,$force) = @_;
2743 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
2744 unless defined $aslocal;
2745 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
2748 if ($^O eq 'MacOS') {
2749 # Comment by AK on 2000-09-03: Uniq short filenames would be
2750 # available in CHECKSUMS file
2751 my($name, $path) = File::Basename::fileparse($aslocal, '');
2752 if (length($name) > 31) {
2763 my $size = 31 - length($suf);
2764 while (length($name) > $size) {
2768 $aslocal = File::Spec->catfile($path, $name);
2772 if (-f $aslocal && -r _ && !($force & 1)){
2774 if ($size = -s $aslocal) {
2775 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
2778 # empty file from a previous unsuccessful attempt to download it
2780 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
2781 "could not remove.");
2786 rename $aslocal, "$aslocal.bak";
2790 my($aslocal_dir) = File::Basename::dirname($aslocal);
2791 File::Path::mkpath($aslocal_dir);
2792 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
2793 qq{directory "$aslocal_dir".
2794 I\'ll continue, but if you encounter problems, they may be due
2795 to insufficient permissions.\n}) unless -w $aslocal_dir;
2797 # Inheritance is not easier to manage than a few if/else branches
2798 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2800 CPAN::LWP::UserAgent->config;
2801 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
2803 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
2807 $Ua->proxy('ftp', $var)
2808 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
2809 $Ua->proxy('http', $var)
2810 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
2813 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
2815 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
2816 # > use ones that require basic autorization.
2818 # > Example of when I use it manually in my own stuff:
2820 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
2821 # > $req->proxy_authorization_basic("username","password");
2822 # > $res = $ua->request($req);
2826 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
2830 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
2831 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
2834 # Try the list of urls for each single object. We keep a record
2835 # where we did get a file from
2836 my(@reordered,$last);
2837 $CPAN::Config->{urllist} ||= [];
2838 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
2839 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
2840 $CPAN::Config->{urllist} = [];
2842 $last = $#{$CPAN::Config->{urllist}};
2843 if ($force & 2) { # local cpans probably out of date, don't reorder
2844 @reordered = (0..$last);
2848 (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
2850 (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
2852 defined($ThesiteURL)
2854 ($CPAN::Config->{urllist}[$b] eq $ThesiteURL)
2856 ($CPAN::Config->{urllist}[$a] eq $ThesiteURL)
2861 $self->debug("Themethod[$Themethod]") if $CPAN::DEBUG;
2863 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
2865 @levels = qw/easy hard hardest/;
2867 @levels = qw/easy/ if $^O eq 'MacOS';
2869 local $ENV{FTP_PASSIVE} =
2870 exists $CPAN::Config->{ftp_passive} ?
2871 $CPAN::Config->{ftp_passive} : 1;
2872 for $levelno (0..$#levels) {
2873 my $level = $levels[$levelno];
2874 my $method = "host$level";
2875 my @host_seq = $level eq "easy" ?
2876 @reordered : 0..$last; # reordered has CDROM up front
2877 my @urllist = map { $CPAN::Config->{urllist}[$_] } @host_seq;
2878 for my $u (@urllist) {
2879 if ($u->can("text")) {
2880 $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
2882 $u .= "/" unless substr($u,-1) eq "/";
2883 $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
2886 for my $u (@CPAN::Defaultsites) {
2887 push @urllist, $u unless grep { $_ eq $u } @urllist;
2889 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
2890 my $ret = $self->$method(\@urllist,$file,$aslocal);
2892 $Themethod = $level;
2894 # utime $now, $now, $aslocal; # too bad, if we do that, we
2895 # might alter a local mirror
2896 $self->debug("level[$level]") if $CPAN::DEBUG;
2900 last if $CPAN::Signal; # need to cleanup
2903 unless ($CPAN::Signal) {
2906 if (@{$CPAN::Config->{urllist}}) {
2908 qq{Please check, if the URLs I found in your configuration file \(}.
2909 join(", ", @{$CPAN::Config->{urllist}}).
2912 push @mess, qq{Your urllist is empty!};
2914 push @mess, qq{The urllist can be edited.},
2915 qq{E.g. with 'o conf urllist push ftp://myurl/'};
2916 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
2917 $CPAN::Frontend->mywarn("Could not fetch $file\n");
2918 $CPAN::Frontend->mysleep(2);
2921 rename "$aslocal.bak", $aslocal;
2922 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
2923 $self->ls($aslocal));
2929 # package CPAN::FTP;
2931 my($self,$host_seq,$file,$aslocal) = @_;
2933 HOSTEASY: for $ro_url (@$host_seq) {
2934 my $url .= "$ro_url$file";
2935 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
2936 if ($url =~ /^file:/) {
2938 if ($CPAN::META->has_inst('URI::URL')) {
2939 my $u = URI::URL->new($url);
2941 } else { # works only on Unix, is poorly constructed, but
2942 # hopefully better than nothing.
2943 # RFC 1738 says fileurl BNF is
2944 # fileurl = "file://" [ host | "localhost" ] "/" fpath
2945 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
2947 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
2948 $l =~ s|^file:||; # assume they
2952 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
2954 $self->debug("local file[$l]") if $CPAN::DEBUG;
2955 if ( -f $l && -r _) {
2956 $ThesiteURL = $ro_url;
2959 if ($l =~ /(.+)\.gz$/) {
2961 if ( -f $ungz && -r _) {
2962 $ThesiteURL = $ro_url;
2966 # Maybe mirror has compressed it?
2968 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
2969 CPAN::Tarzip->new("$l.gz")->gunzip($aslocal);
2971 $ThesiteURL = $ro_url;
2976 if ($CPAN::META->has_usable('LWP')) {
2977 $CPAN::Frontend->myprint("Fetching with LWP:
2981 CPAN::LWP::UserAgent->config;
2982 eval { $Ua = CPAN::LWP::UserAgent->new; };
2984 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
2987 my $res = $Ua->mirror($url, $aslocal);
2988 if ($res->is_success) {
2989 $ThesiteURL = $ro_url;
2991 utime $now, $now, $aslocal; # download time is more
2992 # important than upload
2995 } elsif ($url !~ /\.gz(?!\n)\Z/) {
2996 my $gzurl = "$url.gz";
2997 $CPAN::Frontend->myprint("Fetching with LWP:
3000 $res = $Ua->mirror($gzurl, "$aslocal.gz");
3001 if ($res->is_success &&
3002 CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)
3004 $ThesiteURL = $ro_url;
3008 $CPAN::Frontend->myprint(sprintf(
3009 "LWP failed with code[%s] message[%s]\n",
3013 # Alan Burlison informed me that in firewall environments
3014 # Net::FTP can still succeed where LWP fails. So we do not
3015 # skip Net::FTP anymore when LWP is available.
3018 $ro_url->can("text")
3020 $ro_url->{FROM} eq "USER"
3022 my $ret = $self->hosthard([$ro_url],$file,$aslocal);
3023 return $ret if $ret;
3025 $CPAN::Frontend->mywarn(" LWP not available\n");
3027 return if $CPAN::Signal;
3028 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3029 # that's the nice and easy way thanks to Graham
3030 my($host,$dir,$getfile) = ($1,$2,$3);
3031 if ($CPAN::META->has_usable('Net::FTP')) {
3033 $CPAN::Frontend->myprint("Fetching with Net::FTP:
3036 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
3037 "aslocal[$aslocal]") if $CPAN::DEBUG;
3038 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
3039 $ThesiteURL = $ro_url;
3042 if ($aslocal !~ /\.gz(?!\n)\Z/) {
3043 my $gz = "$aslocal.gz";
3044 $CPAN::Frontend->myprint("Fetching with Net::FTP
3047 if (CPAN::FTP->ftp_get($host,
3051 CPAN::Tarzip->new($gz)->gunzip($aslocal)
3053 $ThesiteURL = $ro_url;
3060 return if $CPAN::Signal;
3064 # package CPAN::FTP;
3066 my($self,$host_seq,$file,$aslocal) = @_;
3068 # Came back if Net::FTP couldn't establish connection (or
3069 # failed otherwise) Maybe they are behind a firewall, but they
3070 # gave us a socksified (or other) ftp program...
3073 my($devnull) = $CPAN::Config->{devnull} || "";
3075 my($aslocal_dir) = File::Basename::dirname($aslocal);
3076 File::Path::mkpath($aslocal_dir);
3077 HOSTHARD: for $ro_url (@$host_seq) {
3078 my $url = "$ro_url$file";
3079 my($proto,$host,$dir,$getfile);
3081 # Courtesy Mark Conty mark_conty@cargill.com change from
3082 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3084 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
3085 # proto not yet used
3086 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
3088 next HOSTHARD; # who said, we could ftp anything except ftp?
3090 next HOSTHARD if $proto eq "file"; # file URLs would have had
3091 # success above. Likely a bogus URL
3093 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
3095 # Try the most capable first and leave ncftp* for last as it only
3097 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
3098 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
3099 next unless defined $funkyftp;
3100 next if $funkyftp =~ /^\s*$/;
3102 my($asl_ungz, $asl_gz);
3103 ($asl_ungz = $aslocal) =~ s/\.gz//;
3104 $asl_gz = "$asl_ungz.gz";
3106 my($src_switch) = "";
3108 my($stdout_redir) = " > $asl_ungz";
3110 $src_switch = " -source";
3111 } elsif ($f eq "ncftp"){
3112 $src_switch = " -c";
3113 } elsif ($f eq "wget"){
3114 $src_switch = " -O $asl_ungz";
3116 } elsif ($f eq 'curl'){
3117 $src_switch = ' -L -f -s -S --netrc-optional';
3120 if ($f eq "ncftpget"){
3121 $chdir = "cd $aslocal_dir && ";
3124 $CPAN::Frontend->myprint(
3126 Trying with "$funkyftp$src_switch" to get
3130 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
3131 $self->debug("system[$system]") if $CPAN::DEBUG;
3132 my($wstatus) = system($system);
3134 # lynx returns 0 when it fails somewhere
3136 my $content = do { local *FH; open FH, $asl_ungz or die; local $/; <FH> };
3137 if ($content =~ /^<.*<title>[45]/si) {
3138 $CPAN::Frontend->mywarn(qq{
3139 No success, the file that lynx has has downloaded looks like an error message:
3142 $CPAN::Frontend->mysleep(1);
3146 $CPAN::Frontend->myprint(qq{
3147 No success, the file that lynx has has downloaded is an empty file.
3152 if ($wstatus == 0) {
3155 } elsif ($asl_ungz ne $aslocal) {
3156 # test gzip integrity
3157 if (CPAN::Tarzip->new($asl_ungz)->gtest) {
3158 # e.g. foo.tar is gzipped --> foo.tar.gz
3159 rename $asl_ungz, $aslocal;
3161 CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz);
3164 $ThesiteURL = $ro_url;
3166 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3168 -f $asl_ungz && -s _ == 0;
3169 my $gz = "$aslocal.gz";
3170 my $gzurl = "$url.gz";
3171 $CPAN::Frontend->myprint(
3173 Trying with "$funkyftp$src_switch" to get
3176 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
3177 $self->debug("system[$system]") if $CPAN::DEBUG;
3179 if (($wstatus = system($system)) == 0
3183 # test gzip integrity
3184 my $ct = CPAN::Tarzip->new($asl_gz);
3186 $ct->gunzip($aslocal);
3188 # somebody uncompressed file for us?
3189 rename $asl_ungz, $aslocal;
3191 $ThesiteURL = $ro_url;
3194 unlink $asl_gz if -f $asl_gz;
3197 my $estatus = $wstatus >> 8;
3198 my $size = -f $aslocal ?
3199 ", left\n$aslocal with size ".-s _ :
3200 "\nWarning: expected file [$aslocal] doesn't exist";
3201 $CPAN::Frontend->myprint(qq{
3202 System call "$system"
3203 returned status $estatus (wstat $wstatus)$size
3206 return if $CPAN::Signal;
3207 } # transfer programs
3211 # package CPAN::FTP;
3213 my($self,$host_seq,$file,$aslocal) = @_;
3216 my($aslocal_dir) = File::Basename::dirname($aslocal);
3217 File::Path::mkpath($aslocal_dir);
3218 my $ftpbin = $CPAN::Config->{ftp};
3219 unless (length $ftpbin && MM->maybe_command($ftpbin)) {
3220 $CPAN::Frontend->myprint("No external ftp command available\n\n");
3223 $CPAN::Frontend->mywarn(qq{
3224 As a last ressort we now switch to the external ftp command '$ftpbin'
3227 Doing so often leads to problems that are hard to diagnose.
3229 If you're victim of such problems, please consider unsetting the ftp
3230 config variable with
3236 $CPAN::Frontend->mysleep(2);
3237 HOSTHARDEST: for $ro_url (@$host_seq) {
3238 my $url = "$ro_url$file";
3239 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
3240 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3243 my($host,$dir,$getfile) = ($1,$2,$3);
3245 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
3246 $ctime,$blksize,$blocks) = stat($aslocal);
3247 $timestamp = $mtime ||= 0;
3248 my($netrc) = CPAN::FTP::netrc->new;
3249 my($netrcfile) = $netrc->netrc;
3250 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
3251 my $targetfile = File::Basename::basename($aslocal);
3257 map("cd $_", split /\//, $dir), # RFC 1738
3259 "get $getfile $targetfile",
3263 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
3264 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
3265 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
3267 $netrc->contains($host))) if $CPAN::DEBUG;
3268 if ($netrc->protected) {
3269 my $dialog = join "", map { " $_\n" } @dialog;
3271 if ($netrc->contains($host)) {
3272 $netrc_explain = "Relying that your .netrc entry for '$host' ".
3273 "manages the login";
3275 $netrc_explain = "Relying that your default .netrc entry ".
3276 "manages the login";
3278 $CPAN::Frontend->myprint(qq{
3279 Trying with external ftp to get
3282 Going to send the dialog
3286 $self->talk_ftp("$ftpbin$verbose $host",
3288 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3289 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3291 if ($mtime > $timestamp) {
3292 $CPAN::Frontend->myprint("GOT $aslocal\n");
3293 $ThesiteURL = $ro_url;
3296 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
3298 return if $CPAN::Signal;
3300 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
3301 qq{correctly protected.\n});
3304 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
3305 nor does it have a default entry\n");
3308 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
3309 # then and login manually to host, using e-mail as
3311 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
3315 "user anonymous $Config::Config{'cf_email'}"
3317 my $dialog = join "", map { " $_\n" } @dialog;
3318 $CPAN::Frontend->myprint(qq{
3319 Trying with external ftp to get
3321 Going to send the dialog
3325 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
3326 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3327 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3329 if ($mtime > $timestamp) {
3330 $CPAN::Frontend->myprint("GOT $aslocal\n");
3331 $ThesiteURL = $ro_url;
3334 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
3336 return if $CPAN::Signal;
3337 $CPAN::Frontend->mywarn("Can't access URL $url.\n\n");
3338 $CPAN::Frontend->mysleep(2);
3342 # package CPAN::FTP;
3344 my($self,$command,@dialog) = @_;
3345 my $fh = FileHandle->new;
3346 $fh->open("|$command") or die "Couldn't open ftp: $!";
3347 foreach (@dialog) { $fh->print("$_\n") }
3348 $fh->close; # Wait for process to complete
3350 my $estatus = $wstatus >> 8;
3351 $CPAN::Frontend->myprint(qq{
3352 Subprocess "|$command"
3353 returned status $estatus (wstat $wstatus)
3357 # find2perl needs modularization, too, all the following is stolen
3361 my($self,$name) = @_;
3362 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
3363 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
3365 my($perms,%user,%group);
3369 $blocks = int(($blocks + 1) / 2);
3372 $blocks = int(($sizemm + 1023) / 1024);
3375 if (-f _) { $perms = '-'; }
3376 elsif (-d _) { $perms = 'd'; }
3377 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
3378 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
3379 elsif (-p _) { $perms = 'p'; }
3380 elsif (-S _) { $perms = 's'; }
3381 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
3383 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
3384 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
3385 my $tmpmode = $mode;
3386 my $tmp = $rwx[$tmpmode & 7];
3388 $tmp = $rwx[$tmpmode & 7] . $tmp;
3390 $tmp = $rwx[$tmpmode & 7] . $tmp;
3391 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
3392 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
3393 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
3396 my $user = $user{$uid} || $uid; # too lazy to implement lookup
3397 my $group = $group{$gid} || $gid;
3399 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
3401 my($moname) = $moname[$mon];
3402 if (-M _ > 365.25 / 2) {
3403 $timeyear = $year + 1900;
3406 $timeyear = sprintf("%02d:%02d", $hour, $min);
3409 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
3423 package CPAN::FTP::netrc;
3426 # package CPAN::FTP::netrc;
3429 my $home = CPAN::HandleConfig::home;
3430 my $file = File::Spec->catfile($home,".netrc");
3432 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3433 $atime,$mtime,$ctime,$blksize,$blocks)
3438 my($fh,@machines,$hasdefault);
3440 $fh = FileHandle->new or die "Could not create a filehandle";
3442 if($fh->open($file)){
3443 $protected = ($mode & 077) == 0;
3445 NETRC: while (<$fh>) {
3446 my(@tokens) = split " ", $_;
3447 TOKEN: while (@tokens) {
3448 my($t) = shift @tokens;
3449 if ($t eq "default"){
3453 last TOKEN if $t eq "macdef";
3454 if ($t eq "machine") {
3455 push @machines, shift @tokens;
3460 $file = $hasdefault = $protected = "";
3464 'mach' => [@machines],
3466 'hasdefault' => $hasdefault,
3467 'protected' => $protected,
3471 # CPAN::FTP::netrc::hasdefault;
3472 sub hasdefault { shift->{'hasdefault'} }
3473 sub netrc { shift->{'netrc'} }
3474 sub protected { shift->{'protected'} }
3476 my($self,$mach) = @_;
3477 for ( @{$self->{'mach'}} ) {
3478 return 1 if $_ eq $mach;
3483 package CPAN::Complete;
3487 my($text, $line, $start, $end) = @_;
3488 my(@perlret) = cpl($text, $line, $start);
3489 # find longest common match. Can anybody show me how to peruse
3490 # T::R::Gnu to have this done automatically? Seems expensive.
3491 return () unless @perlret;
3492 my($newtext) = $text;
3493 for (my $i = length($text)+1;;$i++) {
3494 last unless length($perlret[0]) && length($perlret[0]) >= $i;
3495 my $try = substr($perlret[0],0,$i);
3496 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
3497 # warn "try[$try]tries[@tries]";
3498 if (@tries == @perlret) {
3504 ($newtext,@perlret);
3507 #-> sub CPAN::Complete::cpl ;
3509 my($word,$line,$pos) = @_;
3513 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3515 if ($line =~ s/^(force\s*)//) {
3520 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
3521 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
3523 } elsif ($line =~ /^(a|ls)\s/) {
3524 @return = cplx('CPAN::Author',uc($word));
3525 } elsif ($line =~ /^b\s/) {
3526 CPAN::Shell->local_bundles;
3527 @return = cplx('CPAN::Bundle',$word);
3528 } elsif ($line =~ /^d\s/) {
3529 @return = cplx('CPAN::Distribution',$word);
3530 } elsif ($line =~ m/^(
3531 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
3533 if ($word =~ /^Bundle::/) {
3534 CPAN::Shell->local_bundles;
3536 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3537 } elsif ($line =~ /^i\s/) {
3538 @return = cpl_any($word);
3539 } elsif ($line =~ /^reload\s/) {
3540 @return = cpl_reload($word,$line,$pos);
3541 } elsif ($line =~ /^o\s/) {
3542 @return = cpl_option($word,$line,$pos);
3543 } elsif ($line =~ m/^\S+\s/ ) {
3544 # fallback for future commands and what we have forgotten above
3545 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3552 #-> sub CPAN::Complete::cplx ;
3554 my($class, $word) = @_;
3555 # I believed for many years that this was sorted, today I
3556 # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
3557 # make it sorted again. Maybe sort was dropped when GNU-readline
3558 # support came in? The RCS file is difficult to read on that:-(
3559 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
3562 #-> sub CPAN::Complete::cpl_any ;
3566 cplx('CPAN::Author',$word),
3567 cplx('CPAN::Bundle',$word),
3568 cplx('CPAN::Distribution',$word),
3569 cplx('CPAN::Module',$word),
3573 #-> sub CPAN::Complete::cpl_reload ;
3575 my($word,$line,$pos) = @_;
3577 my(@words) = split " ", $line;
3578 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3579 my(@ok) = qw(cpan index);
3580 return @ok if @words == 1;
3581 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
3584 #-> sub CPAN::Complete::cpl_option ;
3586 my($word,$line,$pos) = @_;
3588 my(@words) = split " ", $line;
3589 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3590 my(@ok) = qw(conf debug);
3591 return @ok if @words == 1;
3592 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
3594 } elsif ($words[1] eq 'index') {
3596 } elsif ($words[1] eq 'conf') {
3597 return CPAN::HandleConfig::cpl(@_);
3598 } elsif ($words[1] eq 'debug') {
3599 return sort grep /^\Q$word\E/i,
3600 sort keys %CPAN::DEBUG, 'all';
3604 package CPAN::Index;
3607 #-> sub CPAN::Index::force_reload ;
3610 $CPAN::Index::LAST_TIME = 0;
3614 #-> sub CPAN::Index::reload ;
3616 my($cl,$force) = @_;
3619 # XXX check if a newer one is available. (We currently read it
3620 # from time to time)
3621 for ($CPAN::Config->{index_expire}) {
3622 $_ = 0.001 unless $_ && $_ > 0.001;
3624 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
3625 # debug here when CPAN doesn't seem to read the Metadata
3627 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
3629 unless ($CPAN::META->{PROTOCOL}) {
3630 $cl->read_metadata_cache;
3631 $CPAN::META->{PROTOCOL} ||= "1.0";
3633 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
3634 # warn "Setting last_time to 0";
3635 $LAST_TIME = 0; # No warning necessary
3637 return if $LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
3640 # IFF we are developing, it helps to wipe out the memory
3641 # between reloads, otherwise it is not what a user expects.
3642 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
3643 $CPAN::META = CPAN->new;
3647 local $LAST_TIME = $time;
3648 local $CPAN::META->{PROTOCOL} = PROTOCOL;
3650 my $needshort = $^O eq "dos";
3652 $cl->rd_authindex($cl
3654 "authors/01mailrc.txt.gz",
3656 File::Spec->catfile('authors', '01mailrc.gz') :
3657 File::Spec->catfile('authors', '01mailrc.txt.gz'),
3660 $debug = "timing reading 01[".($t2 - $time)."]";
3662 return if $CPAN::Signal; # this is sometimes lengthy
3663 $cl->rd_modpacks($cl
3665 "modules/02packages.details.txt.gz",
3667 File::Spec->catfile('modules', '02packag.gz') :
3668 File::Spec->catfile('modules', '02packages.details.txt.gz'),
3671 $debug .= "02[".($t2 - $time)."]";
3673 return if $CPAN::Signal; # this is sometimes lengthy
3676 "modules/03modlist.data.gz",
3678 File::Spec->catfile('modules', '03mlist.gz') :
3679 File::Spec->catfile('modules', '03modlist.data.gz'),
3681 $cl->write_metadata_cache;
3683 $debug .= "03[".($t2 - $time)."]";
3685 CPAN->debug($debug) if $CPAN::DEBUG;
3688 $CPAN::META->{PROTOCOL} = PROTOCOL;
3691 #-> sub CPAN::Index::reload_x ;
3693 my($cl,$wanted,$localname,$force) = @_;
3694 $force |= 2; # means we're dealing with an index here
3695 CPAN::HandleConfig->load; # we should guarantee loading wherever we rely
3697 $localname ||= $wanted;
3698 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
3702 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
3705 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
3706 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
3707 qq{day$s. I\'ll use that.});
3710 $force |= 1; # means we're quite serious about it.
3712 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
3715 #-> sub CPAN::Index::rd_authindex ;
3717 my($cl, $index_target) = @_;
3719 return unless defined $index_target;
3720 $CPAN::Frontend->myprint("Going to read $index_target\n");
3722 tie *FH, 'CPAN::Tarzip', $index_target;
3725 push @lines, split /\012/ while <FH>;
3727 my($userid,$fullname,$email) =
3728 m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
3729 next unless $userid && $fullname && $email;
3731 # instantiate an author object
3732 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
3733 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
3734 return if $CPAN::Signal;
3739 my($self,$dist) = @_;
3740 $dist = $self->{'id'} unless defined $dist;
3741 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
3745 #-> sub CPAN::Index::rd_modpacks ;
3747 my($self, $index_target) = @_;
3749 return unless defined $index_target;
3750 $CPAN::Frontend->myprint("Going to read $index_target\n");
3751 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3754 while ($_ = $fh->READLINE) {
3756 my @ls = map {"$_\n"} split /\n/, $_;
3757 unshift @ls, "\n" x length($1) if /^(\n+)/;
3761 my($line_count,$last_updated);
3763 my $shift = shift(@lines);
3764 last if $shift =~ /^\s*$/;
3765 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
3766 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
3768 if (not defined $line_count) {
3770 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
3771 Please check the validity of the index file by comparing it to more
3772 than one CPAN mirror. I'll continue but problems seem likely to
3776 $CPAN::Frontend->mysleep(5);
3777 } elsif ($line_count != scalar @lines) {
3779 $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
3780 contains a Line-Count header of %d but I see %d lines there. Please
3781 check the validity of the index file by comparing it to more than one
3782 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
3783 $index_target, $line_count, scalar(@lines));
3786 if (not defined $last_updated) {
3788 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
3789 Please check the validity of the index file by comparing it to more
3790 than one CPAN mirror. I'll continue but problems seem likely to
3794 $CPAN::Frontend->mysleep(5);
3798 ->myprint(sprintf qq{ Database was generated on %s\n},
3800 $DATE_OF_02 = $last_updated;
3803 if ($CPAN::META->has_inst('HTTP::Date')) {
3805 $age -= HTTP::Date::str2time($last_updated);
3807 $CPAN::Frontend->mywarn(" HTTP::Date not available\n");
3808 require Time::Local;
3809 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
3810 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
3811 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
3818 qq{Warning: This index file is %d days old.
3819 Please check the host you chose as your CPAN mirror for staleness.
3820 I'll continue but problems seem likely to happen.\a\n},
3823 } elsif ($age < -1) {
3827 qq{Warning: Your system date is %d days behind this index file!
3829 Timestamp index file: %s
3830 Please fix your system time, problems with the make command expected.\n},
3840 # A necessity since we have metadata_cache: delete what isn't
3842 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
3843 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
3847 # before 1.56 we split into 3 and discarded the rest. From
3848 # 1.57 we assign remaining text to $comment thus allowing to
3849 # influence isa_perl
3850 my($mod,$version,$dist,$comment) = split " ", $_, 4;
3851 my($bundle,$id,$userid);
3853 if ($mod eq 'CPAN' &&
3855 CPAN::Queue->exists('Bundle::CPAN') ||
3856 CPAN::Queue->exists('CPAN')
3860 if ($version > $CPAN::VERSION){
3861 $CPAN::Frontend->mywarn(qq{
3862 New CPAN.pm version (v$version) available.
3863 [Currently running version is v$CPAN::VERSION]
3864 You might want to try
3867 to both upgrade CPAN.pm and run the new version without leaving
3868 the current session.
3871 $CPAN::Frontend->mysleep(2);
3872 $CPAN::Frontend->myprint(qq{\n});
3874 last if $CPAN::Signal;
3875 } elsif ($mod =~ /^Bundle::(.*)/) {
3880 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
3881 # Let's make it a module too, because bundles have so much
3882 # in common with modules.
3884 # Changed in 1.57_63: seems like memory bloat now without
3885 # any value, so commented out
3887 # $CPAN::META->instance('CPAN::Module',$mod);
3891 # instantiate a module object
3892 $id = $CPAN::META->instance('CPAN::Module',$mod);
3896 # Although CPAN prohibits same name with different version the
3897 # indexer may have changed the version for the same distro
3898 # since the last time ("Force Reindexing" feature)
3899 if ($id->cpan_file ne $dist
3901 $id->cpan_version ne $version
3903 $userid = $id->userid || $self->userid($dist);
3905 'CPAN_USERID' => $userid,
3906 'CPAN_VERSION' => $version,
3907 'CPAN_FILE' => $dist,
3911 # instantiate a distribution object
3912 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
3913 # we do not need CONTAINSMODS unless we do something with
3914 # this dist, so we better produce it on demand.
3916 ## my $obj = $CPAN::META->instance(
3917 ## 'CPAN::Distribution' => $dist
3919 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
3921 $CPAN::META->instance(
3922 'CPAN::Distribution' => $dist
3924 'CPAN_USERID' => $userid,
3925 'CPAN_COMMENT' => $comment,
3929 for my $name ($mod,$dist) {
3930 CPAN->debug("exists name[$name]") if $CPAN::DEBUG;
3931 $exists{$name} = undef;
3934 return if $CPAN::Signal;
3938 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
3939 for my $o ($CPAN::META->all_objects($class)) {
3940 next if exists $exists{$o->{ID}};
3941 $CPAN::META->delete($class,$o->{ID});
3942 CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
3949 #-> sub CPAN::Index::rd_modlist ;
3951 my($cl,$index_target) = @_;
3952 return unless defined $index_target;
3953 $CPAN::Frontend->myprint("Going to read $index_target\n");
3954 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3958 while ($_ = $fh->READLINE) {
3960 my @ls = map {"$_\n"} split /\n/, $_;
3961 unshift @ls, "\n" x length($1) if /^(\n+)/;
3965 my $shift = shift(@eval);
3966 if ($shift =~ /^Date:\s+(.*)/){
3967 return if $DATE_OF_03 eq $1;
3970 last if $shift =~ /^\s*$/;
3973 push @eval, q{CPAN::Modulelist->data;};
3975 my($comp) = Safe->new("CPAN::Safe1");
3976 my($eval) = join("", @eval);
3977 my $ret = $comp->reval($eval);
3978 Carp::confess($@) if $@;
3979 return if $CPAN::Signal;
3981 my $obj = $CPAN::META->instance("CPAN::Module",$_);
3982 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
3983 $obj->set(%{$ret->{$_}});
3984 return if $CPAN::Signal;
3988 #-> sub CPAN::Index::write_metadata_cache ;
3989 sub write_metadata_cache {
3991 return unless $CPAN::Config->{'cache_metadata'};
3992 return unless $CPAN::META->has_usable("Storable");
3994 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
3995 CPAN::Distribution)) {
3996 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
3998 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
3999 $cache->{last_time} = $LAST_TIME;
4000 $cache->{DATE_OF_02} = $DATE_OF_02;
4001 $cache->{PROTOCOL} = PROTOCOL;
4002 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
4003 eval { Storable::nstore($cache, $metadata_file) };
4004 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4007 #-> sub CPAN::Index::read_metadata_cache ;
4008 sub read_metadata_cache {
4010 return unless $CPAN::Config->{'cache_metadata'};
4011 return unless $CPAN::META->has_usable("Storable");
4012 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4013 return unless -r $metadata_file and -f $metadata_file;
4014 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
4016 eval { $cache = Storable::retrieve($metadata_file) };
4017 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4018 if (!$cache || ref $cache ne 'HASH'){
4022 if (exists $cache->{PROTOCOL}) {
4023 if (PROTOCOL > $cache->{PROTOCOL}) {
4024 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
4025 "with protocol v%s, requiring v%s\n",
4032 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
4033 "with protocol v1.0\n");
4038 while(my($class,$v) = each %$cache) {
4039 next unless $class =~ /^CPAN::/;
4040 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
4041 while (my($id,$ro) = each %$v) {
4042 $CPAN::META->{readwrite}{$class}{$id} ||=
4043 $class->new(ID=>$id, RO=>$ro);
4048 unless ($clcnt) { # sanity check
4049 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
4052 if ($idcnt < 1000) {
4053 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
4054 "in $metadata_file\n");
4057 $CPAN::META->{PROTOCOL} ||=
4058 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
4059 # does initialize to some protocol
4060 $LAST_TIME = $cache->{last_time};
4061 $DATE_OF_02 = $cache->{DATE_OF_02};
4062 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
4063 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
4067 package CPAN::InfoObj;
4072 exists $self->{RO} and return $self->{RO};
4077 my $ro = $self->ro or return "N/A"; # N/A for bundles found locally
4078 return $ro->{CPAN_USERID} || "N/A";
4081 sub id { shift->{ID}; }
4083 #-> sub CPAN::InfoObj::new ;
4085 my $this = bless {}, shift;
4090 # The set method may only be used by code that reads index data or
4091 # otherwise "objective" data from the outside world. All session
4092 # related material may do anything else with instance variables but
4093 # must not touch the hash under the RO attribute. The reason is that
4094 # the RO hash gets written to Metadata file and is thus persistent.
4096 #-> sub CPAN::InfoObj::safe_chdir ;
4098 my($self,$todir) = @_;
4099 # we die if we cannot chdir and we are debuggable
4100 Carp::confess("safe_chdir called without todir argument")
4101 unless defined $todir and length $todir;
4103 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4107 unless (-x $todir) {
4108 unless (chmod 0755, $todir) {
4109 my $cwd = CPAN::anycwd();
4110 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
4111 "permission to change the permission; cannot ".
4112 "chdir to '$todir'\n");
4113 $CPAN::Frontend->mysleep(5);
4114 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4115 qq{to todir[$todir]: $!});
4119 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
4122 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4125 my $cwd = CPAN::anycwd();
4126 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4127 qq{to todir[$todir] (a chmod has been issued): $!});
4132 #-> sub CPAN::InfoObj::set ;
4134 my($self,%att) = @_;
4135 my $class = ref $self;
4137 # This must be ||=, not ||, because only if we write an empty
4138 # reference, only then the set method will write into the readonly
4139 # area. But for Distributions that spring into existence, maybe
4140 # because of a typo, we do not like it that they are written into
4141 # the readonly area and made permanent (at least for a while) and
4142 # that is why we do not "allow" other places to call ->set.
4143 unless ($self->id) {
4144 CPAN->debug("Bug? Empty ID, rejecting");
4147 my $ro = $self->{RO} =
4148 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
4150 while (my($k,$v) = each %att) {
4155 #-> sub CPAN::InfoObj::as_glimpse ;
4159 my $class = ref($self);
4160 $class =~ s/^CPAN:://;
4161 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
4165 #-> sub CPAN::InfoObj::as_string ;
4169 my $class = ref($self);
4170 $class =~ s/^CPAN:://;
4171 push @m, $class, " id = $self->{ID}\n";
4173 unless ($ro = $self->ro) {
4174 $CPAN::Frontend->mydie("Unknown object $self->{ID}");
4176 for (sort keys %$ro) {
4177 # next if m/^(ID|RO)$/;
4179 if ($_ eq "CPAN_USERID") {
4181 $extra .= $self->fullname;
4182 my $email; # old perls!
4183 if ($email = $CPAN::META->instance("CPAN::Author",
4186 $extra .= " <$email>";
4188 $extra .= " <no email>";
4191 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
4192 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
4195 next unless defined $ro->{$_};
4196 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
4198 for (sort keys %$self) {
4199 next if m/^(ID|RO)$/;
4200 if (ref($self->{$_}) eq "ARRAY") {
4201 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
4202 } elsif (ref($self->{$_}) eq "HASH") {
4206 join(" ",sort keys %{$self->{$_}}),
4209 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
4215 #-> sub CPAN::InfoObj::fullname ;
4218 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
4221 #-> sub CPAN::InfoObj::dump ;
4224 unless ($CPAN::META->has_inst("Data::Dumper")) {
4225 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
4227 local $Data::Dumper::Sortkeys;
4228 $Data::Dumper::Sortkeys = 1;
4229 $CPAN::Frontend->myprint(Data::Dumper::Dumper($self));
4232 package CPAN::Author;
4235 #-> sub CPAN::Author::force
4241 #-> sub CPAN::Author::force
4244 delete $self->{force};
4247 #-> sub CPAN::Author::id
4250 my $id = $self->{ID};
4251 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
4255 #-> sub CPAN::Author::as_glimpse ;
4259 my $class = ref($self);
4260 $class =~ s/^CPAN:://;
4261 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
4269 #-> sub CPAN::Author::fullname ;
4271 shift->ro->{FULLNAME};
4275 #-> sub CPAN::Author::email ;
4276 sub email { shift->ro->{EMAIL}; }
4278 #-> sub CPAN::Author::ls ;
4281 my $glob = shift || "";
4282 my $silent = shift || 0;
4285 # adapted from CPAN::Distribution::verifyCHECKSUM ;
4286 my(@csf); # chksumfile
4287 @csf = $self->id =~ /(.)(.)(.*)/;
4288 $csf[1] = join "", @csf[0,1];
4289 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
4291 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
4292 unless (grep {$_->[2] eq $csf[1]} @dl) {
4293 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
4296 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
4297 unless (grep {$_->[2] eq $csf[2]} @dl) {
4298 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
4301 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
4303 if ($CPAN::META->has_inst("Text::Glob")) {
4304 my $rglob = Text::Glob::glob_to_regex($glob);
4305 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
4307 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
4310 $CPAN::Frontend->myprint(join "", map {
4311 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
4312 } sort { $a->[2] cmp $b->[2] } @dl);
4316 # returns an array of arrays, the latter contain (size,mtime,filename)
4317 #-> sub CPAN::Author::dir_listing ;
4320 my $chksumfile = shift;
4321 my $recursive = shift;
4322 my $may_ftp = shift;
4325 File::Spec->catfile($CPAN::Config->{keep_source_where},
4326 "authors", "id", @$chksumfile);
4330 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
4331 # hazard. (Without GPG installed they are not that much better,
4333 $fh = FileHandle->new;
4334 if (open($fh, $lc_want)) {
4335 my $line = <$fh>; close $fh;
4336 unlink($lc_want) unless $line =~ /PGP/;
4340 # connect "force" argument with "index_expire".
4341 my $force = $self->{force};
4342 if (my @stat = stat $lc_want) {
4343 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
4347 $lc_file = CPAN::FTP->localize(
4348 "authors/id/@$chksumfile",
4353 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
4354 $chksumfile->[-1] .= ".gz";
4355 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
4358 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
4359 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
4365 $lc_file = $lc_want;
4366 # we *could* second-guess and if the user has a file: URL,
4367 # then we could look there. But on the other hand, if they do
4368 # have a file: URL, wy did they choose to set
4369 # $CPAN::Config->{show_upload_date} to false?
4372 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
4373 $fh = FileHandle->new;
4375 if (open $fh, $lc_file){
4378 $eval =~ s/\015?\012/\n/g;
4380 my($comp) = Safe->new();
4381 $cksum = $comp->reval($eval);
4383 rename $lc_file, "$lc_file.bad";
4384 Carp::confess($@) if $@;
4386 } elsif ($may_ftp) {
4387 Carp::carp "Could not open '$lc_file' for reading.";
4389 # Maybe should warn: "You may want to set show_upload_date to a true value"
4393 for $f (sort keys %$cksum) {
4394 if (exists $cksum->{$f}{isdir}) {
4396 my(@dir) = @$chksumfile;
4398 push @dir, $f, "CHECKSUMS";
4400 [$_->[0], $_->[1], "$f/$_->[2]"]
4401 } $self->dir_listing(\@dir,1,$may_ftp);
4403 push @result, [ 0, "-", $f ];
4407 ($cksum->{$f}{"size"}||0),
4408 $cksum->{$f}{"mtime"}||"---",
4416 package CPAN::Distribution;
4422 my $ro = $self->ro or return;
4426 # CPAN::Distribution::undelay
4429 delete $self->{later};
4432 # add the A/AN/ stuff
4433 # CPAN::Distribution::normalize
4436 $s = $self->id unless defined $s;
4440 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
4442 return $s if $s =~ m:^N/A|^Contact Author: ;
4443 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
4444 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
4445 CPAN->debug("s[$s]") if $CPAN::DEBUG;
4450 #-> sub CPAN::Distribution::author ;
4453 my($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
4454 CPAN::Shell->expand("Author",$authorid);
4457 # tries to get the yaml from CPAN instead of the distro itself:
4458 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
4461 my $meta = $self->pretty_id;
4462 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
4463 my(@ls) = CPAN::Shell->globls($meta);
4464 my $norm = $self->normalize($meta);
4468 File::Spec->catfile(
4469 $CPAN::Config->{keep_source_where},
4474 $self->debug("Doing localize") if $CPAN::DEBUG;
4475 unless ($local_file =
4476 CPAN::FTP->localize("authors/id/$norm",
4478 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
4480 if ($CPAN::META->has_inst("YAML")) {
4481 my $yaml = YAML::LoadFile($local_file);
4484 $CPAN::Frontend->mydie("Yaml not installed, cannot parse '$local_file'\n");
4491 return $id unless $id =~ m|^./../|;
4495 # mark as dirty/clean
4496 #-> sub CPAN::Distribution::color_cmd_tmps ;
4497 sub color_cmd_tmps {
4499 my($depth) = shift || 0;
4500 my($color) = shift || 0;
4501 my($ancestors) = shift || [];
4502 # a distribution needs to recurse into its prereq_pms
4504 return if exists $self->{incommandcolor}
4505 && $self->{incommandcolor}==$color;
4507 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
4509 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
4510 my $prereq_pm = $self->prereq_pm;
4511 if (defined $prereq_pm) {
4512 PREREQ: for my $pre (keys %$prereq_pm) {
4514 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
4515 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
4516 $CPAN::Frontend->mysleep(2);
4519 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
4523 delete $self->{sponsored_mods};
4524 delete $self->{badtestcnt};
4526 $self->{incommandcolor} = $color;
4529 #-> sub CPAN::Distribution::as_string ;
4532 $self->containsmods;
4534 $self->SUPER::as_string(@_);
4537 #-> sub CPAN::Distribution::containsmods ;
4540 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
4541 my $dist_id = $self->{ID};
4542 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
4543 my $mod_file = $mod->cpan_file or next;
4544 my $mod_id = $mod->{ID} or next;
4545 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
4547 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
4549 keys %{$self->{CONTAINSMODS}};
4552 #-> sub CPAN::Distribution::upload_date ;
4555 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
4556 my(@local_wanted) = split(/\//,$self->id);
4557 my $filename = pop @local_wanted;
4558 push @local_wanted, "CHECKSUMS";
4559 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
4560 return unless $author;
4561 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
4563 my($dirent) = grep { $_->[2] eq $filename } @dl;
4564 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
4565 return unless $dirent->[1];
4566 return $self->{UPLOAD_DATE} = $dirent->[1];
4569 #-> sub CPAN::Distribution::uptodate ;
4573 foreach $c ($self->containsmods) {
4574 my $obj = CPAN::Shell->expandany($c);
4575 unless ($obj->uptodate){
4576 my $id = $self->pretty_id;
4577 $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG;
4584 #-> sub CPAN::Distribution::called_for ;
4587 $self->{CALLED_FOR} = $id if defined $id;
4588 return $self->{CALLED_FOR};
4591 #-> sub CPAN::Distribution::get ;
4596 exists $self->{'build_dir'} and push @e,
4597 "Is already unwrapped into directory $self->{'build_dir'}";
4598 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4600 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
4603 # Get the file on local disk
4608 File::Spec->catfile(
4609 $CPAN::Config->{keep_source_where},
4612 split(/\//,$self->id)
4615 $self->debug("Doing localize") if $CPAN::DEBUG;
4616 unless ($local_file =
4617 CPAN::FTP->localize("authors/id/$self->{ID}",
4620 if ($CPAN::Index::DATE_OF_02) {
4621 $note = "Note: Current database in memory was generated ".
4622 "on $CPAN::Index::DATE_OF_02\n";
4624 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
4626 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4627 $self->{localfile} = $local_file;
4628 return if $CPAN::Signal;
4633 if ($CPAN::META->has_inst("Digest::SHA")) {
4634 $self->debug("Digest::SHA is installed, verifying");
4635 $self->verifyCHECKSUM;
4637 $self->debug("Digest::SHA is NOT installed");
4639 return if $CPAN::Signal;
4642 # Create a clean room and go there
4644 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
4645 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
4646 $self->safe_chdir($builddir);
4647 $self->debug("Removing tmp") if $CPAN::DEBUG;
4648 File::Path::rmtree("tmp");
4649 unless (mkdir "tmp", 0755) {
4650 $CPAN::Frontend->unrecoverable_error(<<EOF);
4651 Couldn't mkdir '$builddir/tmp': $!
4653 Cannot continue: Please find the reason why I cannot make the
4656 and fix the problem, then retry.
4661 $self->safe_chdir($sub_wd);
4664 $self->safe_chdir("tmp");
4669 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4670 my $ct = CPAN::Tarzip->new($local_file);
4671 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
4672 $self->{was_uncompressed}++ unless $ct->gtest();
4673 $self->untar_me($ct);
4674 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
4675 $self->unzip_me($ct);
4677 $self->{was_uncompressed}++ unless $ct->gtest();
4678 $self->debug("calling pm2dir for local_file[$local_file]")
4680 $local_file = $self->handle_singlefile($local_file);
4682 # $self->{archived} = "NO";
4683 # $self->safe_chdir($sub_wd);
4687 # we are still in the tmp directory!
4688 # Let's check if the package has its own directory.
4689 my $dh = DirHandle->new(File::Spec->curdir)
4690 or Carp::croak("Couldn't opendir .: $!");
4691 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
4693 my ($distdir,$packagedir);
4694 if (@readdir == 1 && -d $readdir[0]) {
4695 $distdir = $readdir[0];
4696 $packagedir = File::Spec->catdir($builddir,$distdir);
4697 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
4699 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
4701 File::Path::rmtree($packagedir);
4702 unless (File::Copy::move($distdir,$packagedir)) {
4703 $CPAN::Frontend->unrecoverable_error(<<EOF);
4704 Couldn't move '$distdir' to '$packagedir': $!
4706 Cannot continue: Please find the reason why I cannot move
4707 $builddir/tmp/$distdir
4710 and fix the problem, then retry
4714 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
4721 my $userid = $self->cpan_userid;
4723 CPAN->debug("no userid? self[$self]");
4726 my $pragmatic_dir = $userid . '000';
4727 $pragmatic_dir =~ s/\W_//g;
4728 $pragmatic_dir++ while -d "../$pragmatic_dir";
4729 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
4730 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
4731 File::Path::mkpath($packagedir);
4733 for $f (@readdir) { # is already without "." and ".."
4734 my $to = File::Spec->catdir($packagedir,$f);
4735 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
4739 $self->safe_chdir($sub_wd);
4743 $self->{'build_dir'} = $packagedir;
4744 $self->safe_chdir($builddir);
4745 File::Path::rmtree("tmp");
4747 $self->safe_chdir($packagedir);
4748 if ($CPAN::Config->{check_sigs}) {
4749 if ($CPAN::META->has_inst("Module::Signature")) {
4750 if (-f "SIGNATURE") {
4751 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
4752 my $rv = Module::Signature::verify();
4753 if ($rv != Module::Signature::SIGNATURE_OK() and
4754 $rv != Module::Signature::SIGNATURE_MISSING()) {
4755 $CPAN::Frontend->myprint(
4756 qq{\nSignature invalid for }.
4757 qq{distribution file. }.
4758 qq{Please investigate.\n\n}.
4760 $CPAN::META->instance(
4767 sprintf(qq{I'd recommend removing %s. Its signature
4768 is invalid. Maybe you have configured your 'urllist' with
4769 a bad URL. Please check this array with 'o conf urllist', and
4770 retry. For more information, try opening a subshell with
4778 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
4779 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
4780 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
4782 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
4783 $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
4786 $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n});
4789 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
4792 $self->safe_chdir($builddir);
4793 return if $CPAN::Signal;
4796 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
4797 my($mpl_exists) = -f $mpl;
4798 unless ($mpl_exists) {
4799 # NFS has been reported to have racing problems after the
4800 # renaming of a directory in some environments.
4802 $CPAN::Frontend->mysleep(1);
4803 my $mpldh = DirHandle->new($packagedir)
4804 or Carp::croak("Couldn't opendir $packagedir: $!");
4805 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
4808 my $prefer_installer = "eumm"; # eumm|mb
4809 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
4810 if ($mpl_exists) { # they *can* choose
4811 if ($CPAN::META->has_inst("Module::Build")) {
4812 $prefer_installer = $CPAN::Config->{prefer_installer};
4815 $prefer_installer = "mb";
4818 if (lc($prefer_installer) eq "mb") {
4819 $self->{modulebuild} = 1;
4820 } elsif (! $mpl_exists) {
4821 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
4825 my($configure) = File::Spec->catfile($packagedir,"Configure");
4826 if (-f $configure) {
4827 # do we have anything to do?
4828 $self->{'configure'} = $configure;
4829 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
4830 $CPAN::Frontend->mywarn(qq{
4831 Package comes with a Makefile and without a Makefile.PL.
4832 We\'ll try to build it with that Makefile then.
4834 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
4835 $CPAN::Frontend->mysleep(2);
4837 my $cf = $self->called_for || "unknown";
4842 $cf =~ s|[/\\:]||g; # risk of filesystem damage
4843 $cf = "unknown" unless length($cf);
4844 $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
4845 (The test -f "$mpl" returned false.)
4846 Writing one on our own (setting NAME to $cf)\a\n});
4847 $self->{had_no_makefile_pl}++;
4848 $CPAN::Frontend->mysleep(3);
4850 # Writing our own Makefile.PL
4853 if ($self->{archived} eq "maybe_pl"){
4854 my $fh = FileHandle->new;
4855 my $script_file = File::Spec->catfile($packagedir,$local_file);
4856 $fh->open($script_file)
4857 or Carp::croak("Could not open $script_file: $!");
4859 # name parsen und prereq
4860 my($state) = "poddir";
4861 my($name, $prereq) = ("", "");
4863 if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
4866 } elsif ($1 eq 'PREREQUISITES') {
4869 } elsif ($state =~ m{^(name|prereq)$}) {
4874 } elsif ($state eq "name") {
4879 } elsif ($state eq "prereq") {
4882 } elsif (/^=cut\b/) {
4889 s{.*<}{}; # strip X<...>
4893 $prereq = join " ", split /\s+/, $prereq;
4894 my($PREREQ_PM) = join("\n", map {
4895 s{.*<}{}; # strip X<...>
4897 if (/[\s\'\"]/) { # prose?
4899 s/[^\w:]$//; # period?
4900 " "x28 . "'$_' => 0,";
4902 } split /\s*,\s*/, $prereq);
4905 EXE_FILES => ['$name'],
4911 my $to_file = File::Spec->catfile($packagedir, $name);
4912 rename $script_file, $to_file
4913 or die "Can't rename $script_file to $to_file: $!";
4916 my $fh = FileHandle->new;
4918 or Carp::croak("Could not open >$mpl: $!");
4920 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
4921 # because there was no Makefile.PL supplied.
4922 # Autogenerated on: }.scalar localtime().qq{
4924 use ExtUtils::MakeMaker;
4926 NAME => q[$cf],$script
4936 # CPAN::Distribution::untar_me ;
4939 $self->{archived} = "tar";
4941 $self->{unwrapped} = "YES";
4943 $self->{unwrapped} = "NO";
4947 # CPAN::Distribution::unzip_me ;
4950 $self->{archived} = "zip";
4952 $self->{unwrapped} = "YES";
4954 $self->{unwrapped} = "NO";
4959 sub handle_singlefile {
4960 my($self,$local_file) = @_;
4962 if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ){
4963 $self->{archived} = "pm";
4965 $self->{archived} = "maybe_pl";
4968 my $to = File::Basename::basename($local_file);
4969 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
4970 if (CPAN::Tarzip->new($local_file)->gunzip($to)) {
4971 $self->{unwrapped} = "YES";
4973 $self->{unwrapped} = "NO";
4976 File::Copy::cp($local_file,".");
4977 $self->{unwrapped} = "YES";
4982 #-> sub CPAN::Distribution::new ;
4984 my($class,%att) = @_;
4986 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
4988 my $this = { %att };
4989 return bless $this, $class;
4992 #-> sub CPAN::Distribution::look ;
4996 if ($^O eq 'MacOS') {
4997 $self->Mac::BuildTools::look;
5001 if ( $CPAN::Config->{'shell'} ) {
5002 $CPAN::Frontend->myprint(qq{
5003 Trying to open a subshell in the build directory...
5006 $CPAN::Frontend->myprint(qq{
5007 Your configuration does not define a value for subshells.
5008 Please define it with "o conf shell <your shell>"
5012 my $dist = $self->id;
5014 unless ($dir = $self->dir) {
5017 unless ($dir ||= $self->dir) {
5018 $CPAN::Frontend->mywarn(qq{
5019 Could not determine which directory to use for looking at $dist.
5023 my $pwd = CPAN::anycwd();
5024 $self->safe_chdir($dir);
5025 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
5027 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
5028 $ENV{CPAN_SHELL_LEVEL} += 1;
5029 my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
5030 unless (system($shell) == 0) {
5032 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
5035 $self->safe_chdir($pwd);
5038 # CPAN::Distribution::cvs_import ;
5042 my $dir = $self->dir;
5044 my $package = $self->called_for;
5045 my $module = $CPAN::META->instance('CPAN::Module', $package);
5046 my $version = $module->cpan_version;
5048 my $userid = $self->cpan_userid;
5050 my $cvs_dir = (split /\//, $dir)[-1];
5051 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
5053 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
5055 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
5056 if ($cvs_site_perl) {
5057 $cvs_dir = "$cvs_site_perl/$cvs_dir";
5059 my $cvs_log = qq{"imported $package $version sources"};
5060 $version =~ s/\./_/g;
5062 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
5063 "$cvs_dir", $userid, "v$version");
5065 my $pwd = CPAN::anycwd();
5066 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
5068 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
5070 $CPAN::Frontend->myprint(qq{@cmd\n});
5071 system(@cmd) == 0 or
5073 $CPAN::Frontend->mydie("cvs import failed");
5074 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
5077 #-> sub CPAN::Distribution::readme ;
5080 my($dist) = $self->id;
5081 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
5082 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
5085 File::Spec->catfile(
5086 $CPAN::Config->{keep_source_where},
5089 split(/\//,"$sans.readme"),
5091 $self->debug("Doing localize") if $CPAN::DEBUG;
5092 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
5094 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
5096 if ($^O eq 'MacOS') {
5097 Mac::BuildTools::launch_file($local_file);
5101 my $fh_pager = FileHandle->new;
5102 local($SIG{PIPE}) = "IGNORE";
5103 my $pager = $CPAN::Config->{'pager'} || "cat";
5104 $fh_pager->open("|$pager")
5105 or die "Could not open pager $pager\: $!";
5106 my $fh_readme = FileHandle->new;
5107 $fh_readme->open($local_file)
5108 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
5109 $CPAN::Frontend->myprint(qq{
5114 $fh_pager->print(<$fh_readme>);
5118 #-> sub CPAN::Distribution::verifyCHECKSUM ;
5119 sub verifyCHECKSUM {
5123 $self->{CHECKSUM_STATUS} ||= "";
5124 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
5125 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5127 my($lc_want,$lc_file,@local,$basename);
5128 @local = split(/\//,$self->id);
5130 push @local, "CHECKSUMS";
5132 File::Spec->catfile($CPAN::Config->{keep_source_where},
5133 "authors", "id", @local);
5135 if (my $size = -s $lc_want) {
5136 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
5137 if ($self->CHECKSUM_check_file($lc_want,1)) {
5138 return $self->{CHECKSUM_STATUS} = "OK";
5141 $lc_file = CPAN::FTP->localize("authors/id/@local",
5144 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
5145 $local[-1] .= ".gz";
5146 $lc_file = CPAN::FTP->localize("authors/id/@local",
5149 $lc_file =~ s/\.gz(?!\n)\Z//;
5150 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
5155 if ($self->CHECKSUM_check_file($lc_file)) {
5156 return $self->{CHECKSUM_STATUS} = "OK";
5160 #-> sub CPAN::Distribution::SIG_check_file ;
5161 sub SIG_check_file {
5162 my($self,$chk_file) = @_;
5163 my $rv = eval { Module::Signature::_verify($chk_file) };
5165 if ($rv == Module::Signature::SIGNATURE_OK()) {
5166 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
5167 return $self->{SIG_STATUS} = "OK";
5169 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
5170 qq{distribution file. }.
5171 qq{Please investigate.\n\n}.
5173 $CPAN::META->instance(
5178 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
5179 is invalid. Maybe you have configured your 'urllist' with
5180 a bad URL. Please check this array with 'o conf urllist', and
5183 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
5187 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
5189 # sloppy is 1 when we have an old checksums file that maybe is good
5192 sub CHECKSUM_check_file {
5193 my($self,$chk_file,$sloppy) = @_;
5194 my($cksum,$file,$basename);
5197 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
5198 if ($CPAN::Config->{check_sigs}) {
5199 if ($CPAN::META->has_inst("Module::Signature") and Module::Signature->VERSION >= 0.26) {
5200 $self->debug("Module::Signature is installed, verifying");
5201 $self->SIG_check_file($chk_file);
5203 $self->debug("Module::Signature is NOT installed");
5207 $file = $self->{localfile};
5208 $basename = File::Basename::basename($file);
5209 my $fh = FileHandle->new;
5210 if (open $fh, $chk_file){
5213 $eval =~ s/\015?\012/\n/g;
5215 my($comp) = Safe->new();
5216 $cksum = $comp->reval($eval);
5218 rename $chk_file, "$chk_file.bad";
5219 Carp::confess($@) if $@;
5222 Carp::carp "Could not open $chk_file for reading";
5225 if (! ref $cksum or ref $cksum ne "HASH") {
5226 $CPAN::Frontend->mywarn(qq{
5227 Warning: checksum file '$chk_file' broken.
5229 When trying to read that file I expected to get a hash reference
5230 for further processing, but got garbage instead.
5232 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
5233 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
5234 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
5236 } elsif (exists $cksum->{$basename}{sha256}) {
5237 $self->debug("Found checksum for $basename:" .
5238 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
5242 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
5244 $fh = CPAN::Tarzip->TIEHANDLE($file);
5247 my $dg = Digest::SHA->new(256);
5250 while ($fh->READ($ref, 4096) > 0){
5253 my $hexdigest = $dg->hexdigest;
5254 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
5258 $CPAN::Frontend->myprint("Checksum for $file ok\n");
5259 return $self->{CHECKSUM_STATUS} = "OK";
5261 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
5262 qq{distribution file. }.
5263 qq{Please investigate.\n\n}.
5265 $CPAN::META->instance(
5270 my $wrap = qq{I\'d recommend removing $file. Its
5271 checksum is incorrect. Maybe you have configured your 'urllist' with
5272 a bad URL. Please check this array with 'o conf urllist', and
5275 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
5277 # former versions just returned here but this seems a
5278 # serious threat that deserves a die
5280 # $CPAN::Frontend->myprint("\n\n");
5284 # close $fh if fileno($fh);
5287 unless ($self->{CHECKSUM_STATUS}) {
5288 $CPAN::Frontend->mywarn(qq{
5289 Warning: No checksum for $basename in $chk_file.
5291 The cause for this may be that the file is very new and the checksum
5292 has not yet been calculated, but it may also be that something is
5293 going awry right now.
5295 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes");
5296 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
5298 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
5303 #-> sub CPAN::Distribution::eq_CHECKSUM ;
5305 my($self,$fh,$expect) = @_;
5306 if ($CPAN::META->has_inst("Digest::SHA")) {
5307 my $dg = Digest::SHA->new(256);
5309 while (read($fh, $data, 4096)){
5312 my $hexdigest = $dg->hexdigest;
5313 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
5314 return $hexdigest eq $expect;
5319 #-> sub CPAN::Distribution::force ;
5321 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
5322 # effect by autoinspection, not by inspecting a global variable. One
5323 # of the reason why this was chosen to work that way was the treatment
5324 # of dependencies. They should not automatically inherit the force
5325 # status. But this has the downside that ^C and die() will return to
5326 # the prompt but will not be able to reset the force_update
5327 # attributes. We try to correct for it currently in the read_metadata
5328 # routine, and immediately before we check for a Signal. I hope this
5329 # works out in one of v1.57_53ff
5331 # "Force get forgets previous error conditions"
5333 #-> sub CPAN::Distribution::force ;
5335 my($self, $method) = @_;
5337 CHECKSUM_STATUS archived build_dir localfile make install unwrapped
5338 writemakefile modulebuild make_test
5340 delete $self->{$att};
5342 if ($method && $method =~ /make|test|install/) {
5343 $self->{"force_update"}++; # name should probably have been force_install
5348 my($self, $method) = @_;
5349 # warn "XDEBUG: set notest for $self $method";
5350 $self->{"notest"}++; # name should probably have been force_install
5355 # warn "XDEBUG: deleting notest";
5356 delete $self->{'notest'};
5359 #-> sub CPAN::Distribution::unforce ;
5362 delete $self->{'force_update'};
5365 #-> sub CPAN::Distribution::isa_perl ;
5368 my $file = File::Basename::basename($self->id);
5369 if ($file =~ m{ ^ perl
5382 } elsif ($self->cpan_comment
5384 $self->cpan_comment =~ /isa_perl\(.+?\)/){
5390 #-> sub CPAN::Distribution::perl ;
5395 carp __PACKAGE__ . "::perl was called without parameters.";
5397 return CPAN::HandleConfig->safe_quote($CPAN::Perl);
5401 #-> sub CPAN::Distribution::make ;
5404 my $make = $self->{modulebuild} ? "Build" : "make";
5405 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
5406 # Emergency brake if they said install Pippi and get newest perl
5407 if ($self->isa_perl) {
5409 $self->called_for ne $self->id &&
5410 ! $self->{force_update}
5412 # if we die here, we break bundles
5413 $CPAN::Frontend->mywarn(sprintf qq{
5414 The most recent version "%s" of the module "%s"
5415 comes with the current version of perl (%s).
5416 I\'ll build that only if you ask for something like
5421 $CPAN::META->instance(
5429 $self->{make} = CPAN::Distrostatus->new("NO isa perl");
5430 $CPAN::Frontend->mysleep(1);
5436 delete $self->{force_update};
5441 !$self->{archived} || $self->{archived} eq "NO" and push @e,
5442 "Is neither a tar nor a zip archive.";
5444 !$self->{unwrapped} || $self->{unwrapped} eq "NO" and push @e,
5445 "Had problems unarchiving. Please build manually";
5447 unless ($self->{force_update}) {
5448 exists $self->{signature_verify} and (
5449 $self->{signature_verify}->can("failed") ?
5450 $self->{signature_verify}->failed :
5451 $self->{signature_verify} =~ /^NO/
5453 and push @e, "Did not pass the signature test.";
5456 if (exists $self->{writemakefile} &&
5458 $self->{writemakefile}->can("failed") ?
5459 $self->{writemakefile}->failed :
5460 $self->{writemakefile} =~ /^NO/
5462 # XXX maybe a retry would be in order?
5463 my $err = $self->{writemakefile}->can("text") ?
5464 $self->{writemakefile}->text :
5465 $self->{writemakefile};
5467 $err ||= "Had some problem writing Makefile";
5468 $err .= ", won't make";
5472 defined $self->{make} and push @e,
5473 "Has already been processed within this session";
5475 if (exists $self->{later} and length($self->{later})) {
5476 if ($self->unsat_prereq) {
5477 push @e, $self->{later};
5478 # RT ticket 18438 raises doubts if the deletion of {later} is valid.
5479 # YAML-0.53 triggered the later hodge-podge here, but my margin notes
5480 # are not sufficient to be sure if we really must/may do the delete
5481 # here. SO I accept the suggested patch for now. If we trigger a bug
5482 # again, I must go into deep contemplation about the {later} flag.
5485 # delete $self->{later};
5489 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5492 delete $self->{force_update};
5495 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
5496 my $builddir = $self->dir or
5497 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
5498 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
5499 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
5501 if ($^O eq 'MacOS') {
5502 Mac::BuildTools::make($self);
5507 if ($self->{'configure'}) {
5508 $system = $self->{'configure'};
5509 } elsif ($self->{modulebuild}) {
5510 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5511 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
5513 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5515 # This needs a handler that can be turned on or off:
5516 # $switch = "-MExtUtils::MakeMaker ".
5517 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
5519 $system = sprintf("%s%s Makefile.PL%s",
5521 $switch ? " $switch" : "",
5522 $CPAN::Config->{makepl_arg} ? " $CPAN::Config->{makepl_arg}" : "",
5525 unless (exists $self->{writemakefile}) {
5526 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
5530 if ($CPAN::Config->{inactivity_timeout}) {
5532 if ($Config::Config{d_alarm}
5534 $Config::Config{d_alarm} eq "define"
5538 $CPAN::Frontend->mywarn("Warning: you have configured the config ".
5539 "variable 'inactivity_timeout' to ".
5540 "'$CPAN::Config->{inactivity_timeout}'. But ".
5541 "on this machine the system call 'alarm' ".
5542 "isn't available. This means that we cannot ".
5543 "provide the feature of intercepting long ".
5544 "waiting code and will turn this feature off.\n"
5546 $CPAN::Config->{inactivity_timeout} = 0;
5549 if ($go_via_alarm) {
5551 alarm $CPAN::Config->{inactivity_timeout};
5552 local $SIG{CHLD}; # = sub { wait };
5553 if (defined($pid = fork)) {
5558 # note, this exec isn't necessary if
5559 # inactivity_timeout is 0. On the Mac I'd
5560 # suggest, we set it always to 0.
5564 $CPAN::Frontend->myprint("Cannot fork: $!");
5573 $CPAN::Frontend->myprint($err);
5574 $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
5579 $ret = system($system);
5581 $self->{writemakefile} = CPAN::Distrostatus
5582 ->new("NO '$system' returned status $ret");
5583 $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
5587 if (-f "Makefile" || -f "Build") {
5588 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
5589 delete $self->{make_clean}; # if cleaned before, enable next
5591 $self->{writemakefile} = CPAN::Distrostatus
5592 ->new(qq{NO -- Unknown reason.});
5596 delete $self->{force_update};
5599 if (my @prereq = $self->unsat_prereq){
5600 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5602 if ($self->{modulebuild}) {
5603 unless (-f "Build") {
5605 $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'".
5606 " in cwd[$cwd]. Danger, Will Robinson!");
5607 $CPAN::Frontend->mysleep(5);
5609 $system = sprintf "%s %s", $self->_build_command(), $CPAN::Config->{mbuild_arg};
5611 $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
5613 if (system($system) == 0) {
5614 $CPAN::Frontend->myprint(" $system -- OK\n");
5615 $self->{make} = CPAN::Distrostatus->new("YES");
5617 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
5618 $self->{make} = CPAN::Distrostatus->new("NO");
5619 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
5629 $CPAN::Config->{make} || $Config::Config{make} || 'make'
5632 # Old style call, without object. Deprecated
5633 Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
5635 safe_quote(undef, $CPAN::Config->{make} || $Config::Config{make} || 'make');
5639 #-> sub CPAN::Distribution::follow_prereqs ;
5640 sub follow_prereqs {
5642 my(@prereq) = grep {$_ ne "perl"} @_;
5643 return unless @prereq;
5645 $CPAN::Frontend->myprint("---- Unsatisfied dependencies detected ".
5646 "during [$id] -----\n");
5648 for my $p (@prereq) {
5649 $CPAN::Frontend->myprint(" $p\n");
5652 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
5654 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
5655 my $answer = CPAN::Shell::colorable_makemaker_prompt(
5656 "Shall I follow them and prepend them to the queue
5657 of modules we are processing right now?", "yes");
5658 $follow = $answer =~ /^\s*y/i;
5662 myprint(" Ignoring dependencies on modules @prereq\n");
5665 # color them as dirty
5666 for my $p (@prereq) {
5667 # warn "calling color_cmd_tmps(0,1)";
5668 CPAN::Shell->expandany($p)->color_cmd_tmps(0,1);
5670 CPAN::Queue->jumpqueue(@prereq,$id); # queue them and requeue yourself
5671 $self->{later} = "Delayed until after prerequisites";
5672 return 1; # signal success to the queuerunner
5676 #-> sub CPAN::Distribution::unsat_prereq ;
5679 my $prereq_pm = $self->prereq_pm or return;
5681 NEED: while (my($need_module, $need_version) = each %$prereq_pm) {
5682 my $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
5683 # we were too demanding:
5684 next if $nmo->uptodate;
5686 # if they have not specified a version, we accept any installed one
5687 if (not defined $need_version or
5688 $need_version eq "0" or
5689 $need_version eq "undef") {
5690 next if defined $nmo->inst_file;
5693 # We only want to install prereqs if either they're not installed
5694 # or if the installed version is too old. We cannot omit this
5695 # check, because if 'force' is in effect, nobody else will check.
5696 if (defined $nmo->inst_file) {
5697 my(@all_requirements) = split /\s*,\s*/, $need_version;
5700 RQ: for my $rq (@all_requirements) {
5701 if ($rq =~ s|>=\s*||) {
5702 } elsif ($rq =~ s|>\s*||) {
5704 if (CPAN::Version->vgt($nmo->inst_version,$rq)){
5708 } elsif ($rq =~ s|!=\s*||) {
5710 if (CPAN::Version->vcmp($nmo->inst_version,$rq)){
5716 } elsif ($rq =~ m|<=?\s*|) {
5718 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])");
5722 if (! CPAN::Version->vgt($rq, $nmo->inst_version)){
5725 CPAN->debug(sprintf "id[%s]inst_file[%s]inst_version[%s]rq[%s]ok[%d]",
5729 CPAN::Version->readable($rq),
5733 next NEED if $ok == @all_requirements;
5736 if ($self->{sponsored_mods}{$need_module}++){
5737 # We have already sponsored it and for some reason it's still
5738 # not available. So we do nothing. Or what should we do?
5739 # if we push it again, we have a potential infinite loop
5742 push @need, $need_module;
5747 #-> sub CPAN::Distribution::read_yaml ;
5750 return $self->{yaml_content} if exists $self->{yaml_content};
5751 my $build_dir = $self->{build_dir};
5752 my $yaml = File::Spec->catfile($build_dir,"META.yml");
5753 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
5754 return unless -f $yaml;
5755 if ($CPAN::META->has_inst("YAML")) {
5756 eval { $self->{yaml_content} = YAML::LoadFile($yaml); };
5758 $CPAN::Frontend->mywarn("Error while parsing META.yml: $@");
5761 if (not exists $self->{yaml_content}{dynamic_config}
5762 or $self->{yaml_content}{dynamic_config}
5764 $self->{yaml_content} = undef;
5767 $self->debug("yaml_content[$self->{yaml_content}]") if $CPAN::DEBUG;
5768 return $self->{yaml_content};
5771 #-> sub CPAN::Distribution::prereq_pm ;
5774 return $self->{prereq_pm} if
5775 exists $self->{prereq_pm_detected} && $self->{prereq_pm_detected};
5776 return unless $self->{writemakefile} # no need to have succeeded
5777 # but we must have run it
5778 || $self->{modulebuild};
5780 if (my $yaml = $self->read_yaml) {
5781 $req = $yaml->{requires};
5782 undef $req unless ref $req eq "HASH" && %$req;
5784 if ($yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
5785 my $eummv = do { local $^W = 0; $1+0; };
5786 if ($eummv < 6.2501) {
5787 # thanks to Slaven for digging that out: MM before
5788 # that could be wrong because it could reflect a
5795 while (my($k,$v) = each %{$req||{}}) {
5798 } elsif ($k =~ /[A-Za-z]/ &&
5800 $CPAN::META->exists("Module",$v)
5802 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
5803 "requires hash: $k => $v; I'll take both ".
5804 "key and value as a module name\n");
5805 $CPAN::Frontend->mysleep(1);
5811 $req = $areq if $do_replace;
5813 if ($yaml->{build_requires}
5814 && ref $yaml->{build_requires}
5815 && ref $yaml->{build_requires} eq "HASH") {
5816 while (my($k,$v) = each %{$yaml->{build_requires}}) {
5818 # merging of two "requires"-type values--what should we do?
5825 delete $req->{perl};
5829 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
5830 my $makefile = File::Spec->catfile($build_dir,"Makefile");
5834 $fh = FileHandle->new("<$makefile\0")) {
5837 last if /MakeMaker post_initialize section/;
5839 \s+PREREQ_PM\s+=>\s+(.+)
5842 # warn "Found prereq expr[$p]";
5844 # Regexp modified by A.Speer to remember actual version of file
5845 # PREREQ_PM hash key wants, then add to
5846 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){
5847 # In case a prereq is mentioned twice, complain.
5848 if ( defined $req->{$1} ) {
5849 warn "Warning: PREREQ_PM mentions $1 more than once, ".
5850 "last mention wins";
5856 } elsif (-f "Build") {
5857 if ($CPAN::META->has_inst("Module::Build")) {
5858 my $requires = Module::Build->current->requires();
5859 my $brequires = Module::Build->current->build_requires();
5860 $req = { %$requires, %$brequires };
5864 if (-f "Build.PL" && ! -f "Makefile.PL" && ! exists $req->{"Module::Build"}) {
5865 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
5866 "undeclared prerequisite.\n".
5867 " Adding it now as a prerequisite.\n"
5869 $CPAN::Frontend->mysleep(5);
5870 $req->{"Module::Build"} = 0;
5871 delete $self->{writemakefile};
5873 $self->{prereq_pm_detected}++;
5874 return $self->{prereq_pm} = $req;
5877 #-> sub CPAN::Distribution::test ;
5882 delete $self->{force_update};
5885 # warn "XDEBUG: checking for notest: $self->{notest} $self";
5886 if ($self->{notest}) {
5887 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
5891 my $make = $self->{modulebuild} ? "Build" : "make";
5892 $CPAN::Frontend->myprint("Running $make test\n");
5893 if (my @prereq = $self->unsat_prereq){
5894 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5898 unless (exists $self->{make} or exists $self->{later}) {
5900 "Make had some problems, won't test";
5903 exists $self->{make} and
5905 $self->{make}->can("failed") ?
5906 $self->{make}->failed :
5907 $self->{make} =~ /^NO/
5908 ) and push @e, "Can't test without successful make";
5910 exists $self->{build_dir} or push @e, "Has no own directory";
5911 $self->{badtestcnt} ||= 0;
5912 $self->{badtestcnt} > 0 and
5913 push @e, "Won't repeat unsuccessful test during this command";
5915 exists $self->{later} and length($self->{later}) and
5916 push @e, $self->{later};
5918 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5920 chdir $self->{'build_dir'} or
5921 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5922 $self->debug("Changed directory to $self->{'build_dir'}")
5925 if ($^O eq 'MacOS') {
5926 Mac::BuildTools::make_test($self);
5930 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
5932 : ($ENV{PERLLIB} || "");
5934 $CPAN::META->set_perl5lib;
5935 local $ENV{MAKEFLAGS}; # protect us from outer make calls
5938 if ($self->{modulebuild}) {
5939 $system = sprintf "%s test", $self->_build_command();
5941 $system = join " ", $self->_make_command(), "test";
5944 if ( $CPAN::Config->{test_report} &&
5945 $CPAN::META->has_inst("CPAN::Reporter") ) {
5946 $tests_ok = CPAN::Reporter::test($self, $system);
5948 $tests_ok = system($system) == 0;
5951 $CPAN::Frontend->myprint(" $system -- OK\n");
5952 $CPAN::META->is_tested($self->{'build_dir'});
5953 $self->{make_test} = CPAN::Distrostatus->new("YES");
5955 $self->{make_test} = CPAN::Distrostatus->new("NO");
5956 $self->{badtestcnt}++;
5957 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
5961 #-> sub CPAN::Distribution::clean ;
5964 my $make = $self->{modulebuild} ? "Build" : "make";
5965 $CPAN::Frontend->myprint("Running $make clean\n");
5966 unless (exists $self->{archived}) {
5967 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
5968 "/untarred, nothing done\n");
5971 unless (exists $self->{build_dir}) {
5972 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
5977 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
5978 push @e, "make clean already called once";
5979 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5981 chdir $self->{'build_dir'} or
5982 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5983 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
5985 if ($^O eq 'MacOS') {
5986 Mac::BuildTools::make_clean($self);
5991 if ($self->{modulebuild}) {
5992 unless (-f "Build") {
5994 $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}".
5995 " in cwd[$cwd]. Danger, Will Robinson!");
5996 $CPAN::Frontend->mysleep(5);
5998 $system = sprintf "%s clean", $self->_build_command();
6000 $system = join " ", $self->_make_command(), "clean";
6002 if (system($system) == 0) {
6003 $CPAN::Frontend->myprint(" $system -- OK\n");
6007 # Jost Krieger pointed out that this "force" was wrong because
6008 # it has the effect that the next "install" on this distribution
6009 # will untar everything again. Instead we should bring the
6010 # object's state back to where it is after untarring.
6021 $self->{make_clean} = CPAN::Distrostatus->new("YES");
6024 # Hmmm, what to do if make clean failed?
6026 $self->{make_clean} = CPAN::Distrostatus->new("NO");
6027 $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n});
6029 # 2006-02-27: seems silly to me to force a make now
6030 # $self->force("make"); # so that this directory won't be used again
6035 #-> sub CPAN::Distribution::install ;
6040 delete $self->{force_update};
6043 my $make = $self->{modulebuild} ? "Build" : "make";
6044 $CPAN::Frontend->myprint("Running $make install\n");
6047 exists $self->{build_dir} or push @e, "Has no own directory";
6049 unless (exists $self->{make} or exists $self->{later}) {
6051 "Make had some problems, won't install";
6054 exists $self->{make} and
6056 $self->{make}->can("failed") ?
6057 $self->{make}->failed :
6058 $self->{make} =~ /^NO/
6060 push @e, "make had returned bad status, install seems impossible";
6062 if (exists $self->{make_test} and
6064 $self->{make_test}->can("failed") ?
6065 $self->{make_test}->failed :
6066 $self->{make_test} =~ /^NO/
6068 if ($self->{force_update}) {
6069 $self->{make_test}->text("FAILED but failure ignored because ".
6070 "'force' in effect");
6072 push @e, "make test had returned bad status, ".
6073 "won't install without force"
6076 if (exists $self->{'install'}) {
6077 if ($self->{'install'}->can("text") ?
6078 $self->{'install'}->text eq "YES" :
6079 $self->{'install'} =~ /^YES/
6081 push @e, "Already done";
6083 # comment in Todo on 2006-02-11; maybe retry?
6084 push @e, "Already tried without success";
6088 exists $self->{later} and length($self->{later}) and
6089 push @e, $self->{later};
6091 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6093 chdir $self->{'build_dir'} or
6094 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
6095 $self->debug("Changed directory to $self->{'build_dir'}")
6098 if ($^O eq 'MacOS') {
6099 Mac::BuildTools::make_install($self);
6104 if ($self->{modulebuild}) {
6105 my($mbuild_install_build_command) =
6106 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
6107 $CPAN::Config->{mbuild_install_build_command} ?
6108 $CPAN::Config->{mbuild_install_build_command} :
6109 $self->_build_command();
6110 $system = sprintf("%s install %s",
6111 $mbuild_install_build_command,
6112 $CPAN::Config->{mbuild_install_arg},
6115 my($make_install_make_command) = $CPAN::Config->{make_install_make_command} ||
6116 $self->_make_command();
6117 $system = sprintf("%s install %s",
6118 $make_install_make_command,
6119 $CPAN::Config->{make_install_arg},
6123 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
6124 my($pipe) = FileHandle->new("$system $stderr |");
6127 print $_; # intentionally NOT use Frontend->myprint because it
6128 # looks irritating when we markup in color what we
6129 # just pass through from an external program
6134 $CPAN::Frontend->myprint(" $system -- OK\n");
6135 $CPAN::META->is_installed($self->{build_dir});
6136 return $self->{install} = CPAN::Distrostatus->new("YES");
6138 $self->{install} = CPAN::Distrostatus->new("NO");
6139 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
6141 $makeout =~ /permission/s
6144 ! $CPAN::Config->{make_install_make_command}
6145 || $CPAN::Config->{make_install_make_command} eq $CPAN::Config->{make}
6148 $CPAN::Frontend->myprint(
6150 qq{ You may have to su }.
6151 qq{to root to install the package\n}.
6152 qq{ (Or you may want to run something like\n}.
6153 qq{ o conf make_install_make_command 'sudo make'\n}.
6154 qq{ to raise your permissions.}
6158 delete $self->{force_update};
6161 #-> sub CPAN::Distribution::dir ;
6163 shift->{'build_dir'};
6166 #-> sub CPAN::Distribution::perldoc ;
6170 my($dist) = $self->id;
6171 my $package = $self->called_for;
6173 $self->_display_url( $CPAN::Defaultdocs . $package );
6176 #-> sub CPAN::Distribution::_check_binary ;
6178 my ($dist,$shell,$binary) = @_;
6181 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
6185 $pid = open README, "which $binary|"
6186 or $CPAN::Frontend->mydie(qq{Could not fork 'which $binary': $!});
6190 close README or die "Could not run 'which $binary': $!";
6192 $CPAN::Frontend->myprint(qq{ + $out \n})
6193 if $CPAN::DEBUG && $out;
6198 #-> sub CPAN::Distribution::_display_url ;
6200 my($self,$url) = @_;
6201 my($res,$saved_file,$pid,$out);
6203 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
6206 # should we define it in the config instead?
6207 my $html_converter = "html2text";
6209 my $web_browser = $CPAN::Config->{'lynx'} || undef;
6210 my $web_browser_out = $web_browser
6211 ? CPAN::Distribution->_check_binary($self,$web_browser)
6214 if ($web_browser_out) {
6215 # web browser found, run the action
6216 my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
6217 $CPAN::Frontend->myprint(qq{system[$browser $url]})
6219 $CPAN::Frontend->myprint(qq{
6222 with browser $browser
6224 $CPAN::Frontend->mysleep(1);
6225 system("$browser $url");
6226 if ($saved_file) { 1 while unlink($saved_file) }
6228 # web browser not found, let's try text only
6229 my $html_converter_out =
6230 CPAN::Distribution->_check_binary($self,$html_converter);
6231 $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
6233 if ($html_converter_out ) {
6234 # html2text found, run it
6235 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
6236 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
6237 unless defined($saved_file);
6240 $pid = open README, "$html_converter $saved_file |"
6241 or $CPAN::Frontend->mydie(qq{
6242 Could not fork '$html_converter $saved_file': $!});
6244 if ($CPAN::META->has_inst("File::Temp")) {
6245 $fh = File::Temp->new(
6246 template => 'cpan_htmlconvert_XXXX',
6250 $filename = $fh->filename;
6252 $filename = "cpan_htmlconvert_$$.txt";
6253 $fh = FileHandle->new();
6254 open $fh, ">$filename" or die;
6260 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
6261 my $tmpin = $fh->filename;
6262 $CPAN::Frontend->myprint(sprintf(qq{
6264 saved output to %s\n},
6272 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
6273 my $fh_pager = FileHandle->new;
6274 local($SIG{PIPE}) = "IGNORE";
6275 my $pager = $CPAN::Config->{'pager'} || "cat";
6276 $fh_pager->open("|pager")
6277 or $CPAN::Frontend->mydie(qq{
6278 Could not open pager $pager\: $!});
6279 $CPAN::Frontend->myprint(qq{
6284 $CPAN::Frontend->mysleep(1);
6285 $fh_pager->print(<FH>);
6288 # coldn't find the web browser or html converter
6289 $CPAN::Frontend->myprint(qq{
6290 You need to install lynx or $html_converter to use this feature.});
6295 #-> sub CPAN::Distribution::_getsave_url ;
6297 my($dist, $shell, $url) = @_;
6299 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
6303 if ($CPAN::META->has_inst("File::Temp")) {
6304 $fh = File::Temp->new(
6305 template => "cpan_getsave_url_XXXX",
6309 $filename = $fh->filename;
6311 $fh = FileHandle->new;
6312 $filename = "cpan_getsave_url_$$.html";
6314 my $tmpin = $filename;
6315 if ($CPAN::META->has_usable('LWP')) {
6316 $CPAN::Frontend->myprint("Fetching with LWP:
6320 CPAN::LWP::UserAgent->config;
6321 eval { $Ua = CPAN::LWP::UserAgent->new; };
6323 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
6327 $Ua->proxy('http', $var)
6328 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
6330 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
6333 my $req = HTTP::Request->new(GET => $url);
6334 $req->header('Accept' => 'text/html');
6335 my $res = $Ua->request($req);
6336 if ($res->is_success) {
6337 $CPAN::Frontend->myprint(" + request successful.\n")
6339 print $fh $res->content;
6341 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
6345 $CPAN::Frontend->myprint(sprintf(
6346 "LWP failed with code[%s], message[%s]\n",
6353 $CPAN::Frontend->mywarn(" LWP not available\n");
6358 # sub CPAN::Distribution::_build_command
6359 sub _build_command {
6361 if ($^O eq "MSWin32") { # special code needed at least up to
6362 # Module::Build 0.2611 and 0.2706; a fix
6363 # in M:B has been promised 2006-01-30
6365 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
6366 return "$perl ./Build";
6371 package CPAN::Bundle;
6376 $CPAN::Frontend->myprint($self->as_string);
6381 delete $self->{later};
6382 for my $c ( $self->contains ) {
6383 my $obj = CPAN::Shell->expandany($c) or next;
6388 # mark as dirty/clean
6389 #-> sub CPAN::Bundle::color_cmd_tmps ;
6390 sub color_cmd_tmps {
6392 my($depth) = shift || 0;
6393 my($color) = shift || 0;
6394 my($ancestors) = shift || [];
6395 # a module needs to recurse to its cpan_file, a distribution needs
6396 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
6398 return if exists $self->{incommandcolor}
6399 && $self->{incommandcolor}==$color;
6401 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
6403 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
6405 for my $c ( $self->contains ) {
6406 my $obj = CPAN::Shell->expandany($c) or next;
6407 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
6408 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
6411 delete $self->{badtestcnt};
6413 $self->{incommandcolor} = $color;
6416 #-> sub CPAN::Bundle::as_string ;
6420 # following line must be "=", not "||=" because we have a moving target
6421 $self->{INST_VERSION} = $self->inst_version;
6422 return $self->SUPER::as_string;
6425 #-> sub CPAN::Bundle::contains ;
6428 my($inst_file) = $self->inst_file || "";
6429 my($id) = $self->id;
6430 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
6431 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
6434 unless ($inst_file) {
6435 # Try to get at it in the cpan directory
6436 $self->debug("no inst_file") if $CPAN::DEBUG;
6438 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
6439 $cpan_file = $self->cpan_file;
6440 if ($cpan_file eq "N/A") {
6441 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
6442 Maybe stale symlink? Maybe removed during session? Giving up.\n");
6444 my $dist = $CPAN::META->instance('CPAN::Distribution',
6447 $self->debug("id[$dist->{ID}]") if $CPAN::DEBUG;
6448 my($todir) = $CPAN::Config->{'cpan_home'};
6449 my(@me,$from,$to,$me);
6450 @me = split /::/, $self->id;
6452 $me = File::Spec->catfile(@me);
6453 $from = $self->find_bundle_file($dist->{'build_dir'},join('/',@me));
6454 $to = File::Spec->catfile($todir,$me);
6455 File::Path::mkpath(File::Basename::dirname($to));
6456 File::Copy::copy($from, $to)
6457 or Carp::confess("Couldn't copy $from to $to: $!");
6461 my $fh = FileHandle->new;
6463 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
6465 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
6467 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
6468 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
6469 next unless $in_cont;
6474 push @result, (split " ", $_, 2)[0];
6477 delete $self->{STATUS};
6478 $self->{CONTAINS} = \@result;
6479 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
6481 $CPAN::Frontend->mywarn(qq{
6482 The bundle file "$inst_file" may be a broken
6483 bundlefile. It seems not to contain any bundle definition.
6484 Please check the file and if it is bogus, please delete it.
6485 Sorry for the inconvenience.
6491 #-> sub CPAN::Bundle::find_bundle_file
6492 # $where is in local format, $what is in unix format
6493 sub find_bundle_file {
6494 my($self,$where,$what) = @_;
6495 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
6496 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
6497 ### my $bu = File::Spec->catfile($where,$what);
6498 ### return $bu if -f $bu;
6499 my $manifest = File::Spec->catfile($where,"MANIFEST");
6500 unless (-f $manifest) {
6501 require ExtUtils::Manifest;
6502 my $cwd = CPAN::anycwd();
6503 $self->safe_chdir($where);
6504 ExtUtils::Manifest::mkmanifest();
6505 $self->safe_chdir($cwd);
6507 my $fh = FileHandle->new($manifest)
6508 or Carp::croak("Couldn't open $manifest: $!");
6510 my $bundle_filename = $what;
6511 $bundle_filename =~ s|Bundle.*/||;
6512 my $bundle_unixpath;
6515 my($file) = /(\S+)/;
6516 if ($file =~ m|\Q$what\E$|) {
6517 $bundle_unixpath = $file;
6518 # return File::Spec->catfile($where,$bundle_unixpath); # bad
6521 # retry if she managed to have no Bundle directory
6522 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
6524 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
6525 if $bundle_unixpath;
6526 Carp::croak("Couldn't find a Bundle file in $where");
6529 # needs to work quite differently from Module::inst_file because of
6530 # cpan_home/Bundle/ directory and the possibility that we have
6531 # shadowing effect. As it makes no sense to take the first in @INC for
6532 # Bundles, we parse them all for $VERSION and take the newest.
6534 #-> sub CPAN::Bundle::inst_file ;
6539 @me = split /::/, $self->id;
6542 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
6543 my $bfile = File::Spec->catfile($incdir, @me);
6544 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
6545 next unless -f $bfile;
6546 my $foundv = MM->parse_version($bfile);
6547 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
6548 $self->{INST_FILE} = $bfile;
6549 $self->{INST_VERSION} = $bestv = $foundv;
6555 #-> sub CPAN::Bundle::inst_version ;
6558 $self->inst_file; # finds INST_VERSION as side effect
6559 $self->{INST_VERSION};
6562 #-> sub CPAN::Bundle::rematein ;
6564 my($self,$meth) = @_;
6565 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
6566 my($id) = $self->id;
6567 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
6568 unless $self->inst_file || $self->cpan_file;
6570 for $s ($self->contains) {
6571 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
6572 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
6573 if ($type eq 'CPAN::Distribution') {
6574 $CPAN::Frontend->mywarn(qq{
6575 The Bundle }.$self->id.qq{ contains
6576 explicitly a file $s.
6578 $CPAN::Frontend->mysleep(3);
6580 # possibly noisy action:
6581 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
6582 my $obj = $CPAN::META->instance($type,$s);
6584 if ($obj->isa('CPAN::Bundle')
6586 exists $obj->{install_failed}
6588 ref($obj->{install_failed}) eq "HASH"
6590 for (keys %{$obj->{install_failed}}) {
6591 $self->{install_failed}{$_} = undef; # propagate faiure up
6594 $fail{$s} = 1; # the bundle itself may have succeeded but
6599 $success = $obj->can("uptodate") ? $obj->uptodate : 0;
6600 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
6602 delete $self->{install_failed}{$s};
6609 # recap with less noise
6610 if ( $meth eq "install" ) {
6613 my $raw = sprintf(qq{Bundle summary:
6614 The following items in bundle %s had installation problems:},
6617 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
6618 $CPAN::Frontend->myprint("\n");
6621 for $s ($self->contains) {
6623 $paragraph .= "$s ";
6624 $self->{install_failed}{$s} = undef;
6625 $reported{$s} = undef;
6628 my $report_propagated;
6629 for $s (sort keys %{$self->{install_failed}}) {
6630 next if exists $reported{$s};
6631 $paragraph .= "and the following items had problems
6632 during recursive bundle calls: " unless $report_propagated++;
6633 $paragraph .= "$s ";
6635 $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
6636 $CPAN::Frontend->myprint("\n");
6638 $self->{'install'} = 'YES';
6643 # If a bundle contains another that contains an xs_file we have here,
6644 # we just don't bother I suppose
6645 #-> sub CPAN::Bundle::xs_file
6650 #-> sub CPAN::Bundle::force ;
6651 sub force { shift->rematein('force',@_); }
6652 #-> sub CPAN::Bundle::notest ;
6653 sub notest { shift->rematein('notest',@_); }
6654 #-> sub CPAN::Bundle::get ;
6655 sub get { shift->rematein('get',@_); }
6656 #-> sub CPAN::Bundle::make ;
6657 sub make { shift->rematein('make',@_); }
6658 #-> sub CPAN::Bundle::test ;
6661 $self->{badtestcnt} ||= 0;
6662 $self->rematein('test',@_);
6664 #-> sub CPAN::Bundle::install ;
6667 $self->rematein('install',@_);
6669 #-> sub CPAN::Bundle::clean ;
6670 sub clean { shift->rematein('clean',@_); }
6672 #-> sub CPAN::Bundle::uptodate ;
6675 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
6677 foreach $c ($self->contains) {
6678 my $obj = CPAN::Shell->expandany($c);
6679 return 0 unless $obj->uptodate;
6684 #-> sub CPAN::Bundle::readme ;
6687 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
6688 No File found for bundle } . $self->id . qq{\n}), return;
6689 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
6690 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
6693 package CPAN::Module;
6697 # sub CPAN::Module::userid
6702 return $ro->{userid} || $ro->{CPAN_USERID};
6704 # sub CPAN::Module::description
6707 my $ro = $self->ro or return "";
6713 CPAN::Shell->expand("Distribution",$self->cpan_file);
6716 # sub CPAN::Module::undelay
6719 delete $self->{later};
6720 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
6725 # mark as dirty/clean
6726 #-> sub CPAN::Module::color_cmd_tmps ;
6727 sub color_cmd_tmps {
6729 my($depth) = shift || 0;
6730 my($color) = shift || 0;
6731 my($ancestors) = shift || [];
6732 # a module needs to recurse to its cpan_file
6734 return if exists $self->{incommandcolor}
6735 && $self->{incommandcolor}==$color;
6736 return if $depth>=1 && $self->uptodate;
6738 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
6740 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
6742 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
6743 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
6746 delete $self->{badtestcnt};
6748 $self->{incommandcolor} = $color;
6751 #-> sub CPAN::Module::as_glimpse ;
6755 my $class = ref($self);
6756 $class =~ s/^CPAN:://;
6760 $CPAN::Shell::COLOR_REGISTERED
6762 $CPAN::META->has_inst("Term::ANSIColor")
6766 $color_on = Term::ANSIColor::color("green");
6767 $color_off = Term::ANSIColor::color("reset");
6769 my $uptodateness = " ";
6770 if ($class eq "Bundle") {
6771 } elsif ($self->uptodate) {
6772 $uptodateness = "=";
6773 } elsif ($self->inst_version) {
6774 $uptodateness = "<";
6776 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
6782 ($self->distribution ?
6783 $self->distribution->pretty_id :
6790 #-> sub CPAN::Module::dslip_status
6794 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
6795 pre-alpha alpha beta released
6797 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
6798 developer comp.lang.perl.*
6800 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
6801 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
6803 object-oriented pragma
6805 @{$stat->{P}}{qw,p g l b a o d r n,} = qw,Standard-Perl
6809 distribution_allowed
6810 restricted_distribution
6812 for my $x (qw(d s l i p)) {
6813 $stat->{$x}{' '} = 'unknown';
6814 $stat->{$x}{'?'} = 'unknown';
6817 return +{} unless $ro && $ro->{statd};
6824 DV => $stat->{D}{$ro->{statd}},
6825 SV => $stat->{S}{$ro->{stats}},
6826 LV => $stat->{L}{$ro->{statl}},
6827 IV => $stat->{I}{$ro->{stati}},
6828 PV => $stat->{P}{$ro->{statp}},
6832 #-> sub CPAN::Module::as_string ;
6836 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
6837 my $class = ref($self);
6838 $class =~ s/^CPAN:://;
6840 push @m, $class, " id = $self->{ID}\n";
6841 my $sprintf = " %-12s %s\n";
6842 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
6843 if $self->description;
6844 my $sprintf2 = " %-12s %s (%s)\n";
6846 $userid = $self->userid;
6849 if ($author = CPAN::Shell->expand('Author',$userid)) {
6852 if ($m = $author->email) {
6859 $author->fullname . $email
6863 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
6864 if $self->cpan_version;
6865 if (my $cpan_file = $self->cpan_file){
6866 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
6867 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
6868 my $upload_date = $dist->upload_date;
6870 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
6874 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
6875 my $dslip = $self->dslip_status;
6879 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
6881 my $local_file = $self->inst_file;
6882 unless ($self->{MANPAGE}) {
6885 $manpage = $self->manpage_headline($local_file);
6887 # If we have already untarred it, we should look there
6888 my $dist = $CPAN::META->instance('CPAN::Distribution',
6890 # warn "dist[$dist]";
6891 # mff=manifest file; mfh=manifest handle
6896 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
6898 $mfh = FileHandle->new($mff)
6900 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
6901 my $lfre = $self->id; # local file RE
6904 my($lfl); # local file file
6906 my(@mflines) = <$mfh>;
6911 while (length($lfre)>5 and !$lfl) {
6912 ($lfl) = grep /$lfre/, @mflines;
6913 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
6916 $lfl =~ s/\s.*//; # remove comments
6917 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
6918 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
6919 # warn "lfl_abs[$lfl_abs]";
6921 $manpage = $self->manpage_headline($lfl_abs);
6925 $self->{MANPAGE} = $manpage if $manpage;
6928 for $item (qw/MANPAGE/) {
6929 push @m, sprintf($sprintf, $item, $self->{$item})
6930 if exists $self->{$item};
6932 for $item (qw/CONTAINS/) {
6933 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
6934 if exists $self->{$item} && @{$self->{$item}};
6936 push @m, sprintf($sprintf, 'INST_FILE',
6937 $local_file || "(not installed)");
6938 push @m, sprintf($sprintf, 'INST_VERSION',
6939 $self->inst_version) if $local_file;
6943 sub manpage_headline {
6944 my($self,$local_file) = @_;
6945 my(@local_file) = $local_file;
6946 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
6947 push @local_file, $local_file;
6949 for $locf (@local_file) {
6950 next unless -f $locf;
6951 my $fh = FileHandle->new($locf)
6952 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
6956 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
6957 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
6974 #-> sub CPAN::Module::cpan_file ;
6975 # Note: also inherited by CPAN::Bundle
6978 CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
6979 unless ($self->ro) {
6980 CPAN::Index->reload;
6983 if ($ro && defined $ro->{CPAN_FILE}){
6984 return $ro->{CPAN_FILE};
6986 my $userid = $self->userid;
6988 if ($CPAN::META->exists("CPAN::Author",$userid)) {
6989 my $author = $CPAN::META->instance("CPAN::Author",
6991 my $fullname = $author->fullname;
6992 my $email = $author->email;
6993 unless (defined $fullname && defined $email) {
6994 return sprintf("Contact Author %s",
6998 return "Contact Author $fullname <$email>";
7000 return "Contact Author $userid (Email address not available)";
7008 #-> sub CPAN::Module::cpan_version ;
7014 # Can happen with modules that are not on CPAN
7017 $ro->{CPAN_VERSION} = 'undef'
7018 unless defined $ro->{CPAN_VERSION};
7019 $ro->{CPAN_VERSION};
7022 #-> sub CPAN::Module::force ;
7025 $self->{'force_update'}++;
7030 # warn "XDEBUG: set notest for Module";
7031 $self->{'notest'}++;
7034 #-> sub CPAN::Module::rematein ;
7036 my($self,$meth) = @_;
7037 $CPAN::Frontend->myprint(sprintf("Running %s for module %s\n",
7040 my $cpan_file = $self->cpan_file;
7041 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
7042 $CPAN::Frontend->mywarn(sprintf qq{
7043 The module %s isn\'t available on CPAN.
7045 Either the module has not yet been uploaded to CPAN, or it is
7046 temporary unavailable. Please contact the author to find out
7047 more about the status. Try 'i %s'.
7054 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
7055 $pack->called_for($self->id);
7056 $pack->force($meth) if exists $self->{'force_update'};
7057 $pack->notest($meth) if exists $self->{'notest'};
7062 $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
7063 $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
7064 delete $self->{'force_update'};
7065 delete $self->{'notest'};
7071 #-> sub CPAN::Module::perldoc ;
7072 sub perldoc { shift->rematein('perldoc') }
7073 #-> sub CPAN::Module::readme ;
7074 sub readme { shift->rematein('readme') }
7075 #-> sub CPAN::Module::look ;
7076 sub look { shift->rematein('look') }
7077 #-> sub CPAN::Module::cvs_import ;
7078 sub cvs_import { shift->rematein('cvs_import') }
7079 #-> sub CPAN::Module::get ;
7080 sub get { shift->rematein('get',@_) }
7081 #-> sub CPAN::Module::make ;
7082 sub make { shift->rematein('make') }
7083 #-> sub CPAN::Module::test ;
7086 $self->{badtestcnt} ||= 0;
7087 $self->rematein('test',@_);
7089 #-> sub CPAN::Module::uptodate ;
7092 local($_); # protect against a bug in MakeMaker 6.17
7093 my($latest) = $self->cpan_version;
7095 my($inst_file) = $self->inst_file;
7097 if (defined $inst_file) {
7098 $have = $self->inst_version;
7103 ! CPAN::Version->vgt($latest, $have)
7105 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
7106 "latest[$latest] have[$have]") if $CPAN::DEBUG;
7111 #-> sub CPAN::Module::install ;
7117 not exists $self->{'force_update'}
7119 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
7121 $self->inst_version,
7127 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
7128 $CPAN::Frontend->mywarn(qq{
7129 \n\n\n ***WARNING***
7130 The module $self->{ID} has no active maintainer.\n\n\n
7132 $CPAN::Frontend->mysleep(5);
7134 $self->rematein('install') if $doit;
7136 #-> sub CPAN::Module::clean ;
7137 sub clean { shift->rematein('clean') }
7139 #-> sub CPAN::Module::inst_file ;
7143 @packpath = split /::/, $self->{ID};
7144 $packpath[-1] .= ".pm";
7145 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
7146 unshift @packpath, "Term", "ReadLine"; # historical reasons
7148 foreach $dir (@INC) {
7149 my $pmfile = File::Spec->catfile($dir,@packpath);
7157 #-> sub CPAN::Module::xs_file ;
7161 @packpath = split /::/, $self->{ID};
7162 push @packpath, $packpath[-1];
7163 $packpath[-1] .= "." . $Config::Config{'dlext'};
7164 foreach $dir (@INC) {
7165 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
7173 #-> sub CPAN::Module::inst_version ;
7176 my $parsefile = $self->inst_file or return;
7177 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
7180 $have = MM->parse_version($parsefile) || "undef";
7181 $have =~ s/^ //; # since the %vd hack these two lines here are needed
7182 $have =~ s/ $//; # trailing whitespace happens all the time
7184 # My thoughts about why %vd processing should happen here
7186 # Alt1 maintain it as string with leading v:
7187 # read index files do nothing
7188 # compare it use utility for compare
7189 # print it do nothing
7191 # Alt2 maintain it as what it is
7192 # read index files convert
7193 # compare it use utility because there's still a ">" vs "gt" issue
7194 # print it use CPAN::Version for print
7196 # Seems cleaner to hold it in memory as a string starting with a "v"
7198 # If the author of this module made a mistake and wrote a quoted
7199 # "v1.13" instead of v1.13, we simply leave it at that with the
7200 # effect that *we* will treat it like a v-tring while the rest of
7201 # perl won't. Seems sensible when we consider that any action we
7202 # could take now would just add complexity.
7204 $have = CPAN::Version->readable($have);
7206 $have =~ s/\s*//g; # stringify to float around floating point issues
7207 $have; # no stringify needed, \s* above matches always
7220 CPAN - query, download and build perl modules from CPAN sites
7226 perl -MCPAN -e shell;
7234 $mod = "Acme::Meta";
7236 CPAN::Shell->install($mod); # same thing
7237 CPAN::Shell->expandany($mod)->install; # same thing
7238 CPAN::Shell->expand("Module",$mod)->install; # same thing
7239 CPAN::Shell->expand("Module",$mod)
7240 ->distribution->install; # same thing
7244 $distro = "NWCLARK/Acme-Meta-0.01.tar.gz";
7245 install $distro; # same thing
7246 CPAN::Shell->install($distro); # same thing
7247 CPAN::Shell->expandany($distro)->install; # same thing
7248 CPAN::Shell->expand("Distribution",$distro)->install; # same thing
7252 This module and its competitor, the CPANPLUS module, are both much
7253 cooler than the other.
7255 =head1 COMPATIBILITY
7257 CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
7258 newer versions. It is getting more and more difficult to get the
7259 minimal prerequisites working on older perls. It is close to
7260 impossible to get the whole Bundle::CPAN working there. If you're in
7261 the position to have only these old versions, be advised that CPAN is
7262 designed to work fine without the Bundle::CPAN installed.
7264 To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
7265 compatible with ancient perls and that File::Temp is listed as a
7266 prerequisite but CPAN has reasonable workarounds if it is missing.
7270 The CPAN module is designed to automate the make and install of perl
7271 modules and extensions. It includes some primitive searching
7272 capabilities and knows how to use Net::FTP or LWP (or some external
7273 download clients) to fetch the raw data from the net.
7275 Modules are fetched from one or more of the mirrored CPAN
7276 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
7279 The CPAN module also supports the concept of named and versioned
7280 I<bundles> of modules. Bundles simplify the handling of sets of
7281 related modules. See Bundles below.
7283 The package contains a session manager and a cache manager. There is
7284 no status retained between sessions. The session manager keeps track
7285 of what has been fetched, built and installed in the current
7286 session. The cache manager keeps track of the disk space occupied by
7287 the make processes and deletes excess space according to a simple FIFO
7290 All methods provided are accessible in a programmer style and in an
7291 interactive shell style.
7293 =head2 CPAN::shell([$prompt, $command]) Starting Interactive Mode
7295 The interactive mode is entered by running
7297 perl -MCPAN -e shell
7299 which puts you into a readline interface. You will have the most fun if
7300 you install Term::ReadKey and Term::ReadLine to enjoy both history and
7303 Once you are on the command line, type 'h' and the rest should be
7306 The function call C<shell> takes two optional arguments, one is the
7307 prompt, the second is the default initial command line (the latter
7308 only works if a real ReadLine interface module is installed).
7310 The most common uses of the interactive modes are
7314 =item Searching for authors, bundles, distribution files and modules
7316 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
7317 for each of the four categories and another, C<i> for any of the
7318 mentioned four. Each of the four entities is implemented as a class
7319 with slightly differing methods for displaying an object.
7321 Arguments you pass to these commands are either strings exactly matching
7322 the identification string of an object or regular expressions that are
7323 then matched case-insensitively against various attributes of the
7324 objects. The parser recognizes a regular expression only if you
7325 enclose it between two slashes.
7327 The principle is that the number of found objects influences how an
7328 item is displayed. If the search finds one item, the result is
7329 displayed with the rather verbose method C<as_string>, but if we find
7330 more than one, we display each object with the terse method
7333 =item make, test, install, clean modules or distributions
7335 These commands take any number of arguments and investigate what is
7336 necessary to perform the action. If the argument is a distribution
7337 file name (recognized by embedded slashes), it is processed. If it is
7338 a module, CPAN determines the distribution file in which this module
7339 is included and processes that, following any dependencies named in
7340 the module's META.yml or Makefile.PL (this behavior is controlled by
7341 the configuration parameter C<prerequisites_policy>.)
7343 Any C<make> or C<test> are run unconditionally. An
7345 install <distribution_file>
7347 also is run unconditionally. But for
7351 CPAN checks if an install is actually needed for it and prints
7352 I<module up to date> in the case that the distribution file containing
7353 the module doesn't need to be updated.
7355 CPAN also keeps track of what it has done within the current session
7356 and doesn't try to build a package a second time regardless if it
7357 succeeded or not. The C<force> pragma may precede another command
7358 (currently: C<make>, C<test>, or C<install>) and executes the
7359 command from scratch and tries to continue in case of some errors.
7363 cpan> install OpenGL
7364 OpenGL is up to date.
7365 cpan> force install OpenGL
7368 OpenGL-0.4/COPYRIGHT
7371 The C<notest> pragma may be set to skip the test part in the build
7376 cpan> notest install Tk
7378 A C<clean> command results in a
7382 being executed within the distribution file's working directory.
7384 =item get, readme, perldoc, look module or distribution
7386 C<get> downloads a distribution file without further action. C<readme>
7387 displays the README file of the associated distribution. C<Look> gets
7388 and untars (if not yet done) the distribution file, changes to the
7389 appropriate directory and opens a subshell process in that directory.
7390 C<perldoc> displays the pod documentation of the module in html or
7395 =item ls globbing_expression
7397 The first form lists all distribution files in and below an author's
7398 CPAN directory as they are stored in the CHECKUMS files distributed on
7399 CPAN. The listing goes recursive into all subdirectories.
7401 The second form allows to limit or expand the output with shell
7402 globbing as in the following examples:
7408 The last example is very slow and outputs extra progress indicators
7409 that break the alignment of the result.
7411 Note that globbing only lists directories explicitly asked for, for
7412 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
7413 regarded as a bug and may be changed in future versions.
7417 The C<failed> command reports all distributions that failed on one of
7418 C<make>, C<test> or C<install> for some reason in the currently
7419 running shell session.
7423 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>
7424 (but the directory can be configured via the C<cpan_home> config
7425 variable). The shell is a bit picky if you try to start another CPAN
7426 session. It dies immediately if there is a lockfile and the lock seems
7427 to belong to a running process. In case you want to run a second shell
7428 session, it is probably safest to maintain another directory, say
7429 C<~/.cpan-for-X/> and a C<~/.cpan-for-X/CPAN/MyConfig.pm> that
7430 contains the configuration options. Then you can start the second
7433 perl -I ~/.cpan-for-X -MCPAN::MyConfig -MCPAN -e shell
7437 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
7438 in the cpan-shell it is intended that you can press C<^C> anytime and
7439 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
7440 to clean up and leave the shell loop. You can emulate the effect of a
7441 SIGTERM by sending two consecutive SIGINTs, which usually means by
7442 pressing C<^C> twice.
7444 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
7445 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
7446 Build.PL> subprocess.
7452 The commands that are available in the shell interface are methods in
7453 the package CPAN::Shell. If you enter the shell command, all your
7454 input is split by the Text::ParseWords::shellwords() routine which
7455 acts like most shells do. The first word is being interpreted as the
7456 method to be called and the rest of the words are treated as arguments
7457 to this method. Continuation lines are supported if a line ends with a
7462 C<autobundle> writes a bundle file into the
7463 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
7464 a list of all modules that are both available from CPAN and currently
7465 installed within @INC. The name of the bundle file is based on the
7466 current date and a counter.
7470 recompile() is a very special command in that it takes no argument and
7471 runs the make/test/install cycle with brute force over all installed
7472 dynamically loadable extensions (aka XS modules) with 'force' in
7473 effect. The primary purpose of this command is to finish a network
7474 installation. Imagine, you have a common source tree for two different
7475 architectures. You decide to do a completely independent fresh
7476 installation. You start on one architecture with the help of a Bundle
7477 file produced earlier. CPAN installs the whole Bundle for you, but
7478 when you try to repeat the job on the second architecture, CPAN
7479 responds with a C<"Foo up to date"> message for all modules. So you
7480 invoke CPAN's recompile on the second architecture and you're done.
7482 Another popular use for C<recompile> is to act as a rescue in case your
7483 perl breaks binary compatibility. If one of the modules that CPAN uses
7484 is in turn depending on binary compatibility (so you cannot run CPAN
7485 commands), then you should try the CPAN::Nox module for recovery.
7489 The C<upgrade> command first runs an C<r> command and then installs
7490 the newest versions of all modules that were listed by that.
7494 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
7495 directory so that you can save your own preferences instead of the
7498 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
7500 Although it may be considered internal, the class hierarchy does matter
7501 for both users and programmer. CPAN.pm deals with above mentioned four
7502 classes, and all those classes share a set of methods. A classical
7503 single polymorphism is in effect. A metaclass object registers all
7504 objects of all kinds and indexes them with a string. The strings
7505 referencing objects have a separated namespace (well, not completely
7510 words containing a "/" (slash) Distribution
7511 words starting with Bundle:: Bundle
7512 everything else Module or Author
7514 Modules know their associated Distribution objects. They always refer
7515 to the most recent official release. Developers may mark their releases
7516 as unstable development versions (by inserting an underbar into the
7517 module version number which will also be reflected in the distribution
7518 name when you run 'make dist'), so the really hottest and newest
7519 distribution is not always the default. If a module Foo circulates
7520 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
7521 way to install version 1.23 by saying
7525 This would install the complete distribution file (say
7526 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
7527 like to install version 1.23_90, you need to know where the
7528 distribution file resides on CPAN relative to the authors/id/
7529 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
7530 so you would have to say
7532 install BAR/Foo-1.23_90.tar.gz
7534 The first example will be driven by an object of the class
7535 CPAN::Module, the second by an object of class CPAN::Distribution.
7537 =head1 PROGRAMMER'S INTERFACE
7539 If you do not enter the shell, the available shell commands are both
7540 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
7541 functions in the calling package (C<install(...)>).
7543 There's currently only one class that has a stable interface -
7544 CPAN::Shell. All commands that are available in the CPAN shell are
7545 methods of the class CPAN::Shell. Each of the commands that produce
7546 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
7547 the IDs of all modules within the list.
7551 =item expand($type,@things)
7553 The IDs of all objects available within a program are strings that can
7554 be expanded to the corresponding real objects with the
7555 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
7556 list of CPAN::Module objects according to the C<@things> arguments
7557 given. In scalar context it only returns the first element of the
7560 =item expandany(@things)
7562 Like expand, but returns objects of the appropriate type, i.e.
7563 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
7564 CPAN::Distribution objects for distributions. Note: it does not expand
7565 to CPAN::Author objects.
7567 =item Programming Examples
7569 This enables the programmer to do operations that combine
7570 functionalities that are available in the shell.
7572 # install everything that is outdated on my disk:
7573 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
7575 # install my favorite programs if necessary:
7576 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
7577 my $obj = CPAN::Shell->expand('Module',$mod);
7581 # list all modules on my disk that have no VERSION number
7582 for $mod (CPAN::Shell->expand("Module","/./")){
7583 next unless $mod->inst_file;
7584 # MakeMaker convention for undefined $VERSION:
7585 next unless $mod->inst_version eq "undef";
7586 print "No VERSION in ", $mod->id, "\n";
7589 # find out which distribution on CPAN contains a module:
7590 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
7592 Or if you want to write a cronjob to watch The CPAN, you could list
7593 all modules that need updating. First a quick and dirty way:
7595 perl -e 'use CPAN; CPAN::Shell->r;'
7597 If you don't want to get any output in the case that all modules are
7598 up to date, you can parse the output of above command for the regular
7599 expression //modules are up to date// and decide to mail the output
7600 only if it doesn't match. Ick?
7602 If you prefer to do it more in a programmer style in one single
7603 process, maybe something like this suits you better:
7605 # list all modules on my disk that have newer versions on CPAN
7606 for $mod (CPAN::Shell->expand("Module","/./")){
7607 next unless $mod->inst_file;
7608 next if $mod->uptodate;
7609 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
7610 $mod->id, $mod->inst_version, $mod->cpan_version;
7613 If that gives you too much output every day, you maybe only want to
7614 watch for three modules. You can write
7616 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
7618 as the first line instead. Or you can combine some of the above
7621 # watch only for a new mod_perl module
7622 $mod = CPAN::Shell->expand("Module","mod_perl");
7623 exit if $mod->uptodate;
7624 # new mod_perl arrived, let me know all update recommendations
7629 =head2 Methods in the other Classes
7631 The programming interface for the classes CPAN::Module,
7632 CPAN::Distribution, CPAN::Bundle, and CPAN::Author is still considered
7633 beta and partially even alpha. In the following paragraphs only those
7634 methods are documented that have proven useful over a longer time and
7635 thus are unlikely to change.
7639 =item CPAN::Author::as_glimpse()
7641 Returns a one-line description of the author
7643 =item CPAN::Author::as_string()
7645 Returns a multi-line description of the author
7647 =item CPAN::Author::email()
7649 Returns the author's email address
7651 =item CPAN::Author::fullname()
7653 Returns the author's name
7655 =item CPAN::Author::name()
7657 An alias for fullname
7659 =item CPAN::Bundle::as_glimpse()
7661 Returns a one-line description of the bundle
7663 =item CPAN::Bundle::as_string()
7665 Returns a multi-line description of the bundle
7667 =item CPAN::Bundle::clean()
7669 Recursively runs the C<clean> method on all items contained in the bundle.
7671 =item CPAN::Bundle::contains()
7673 Returns a list of objects' IDs contained in a bundle. The associated
7674 objects may be bundles, modules or distributions.
7676 =item CPAN::Bundle::force($method,@args)
7678 Forces CPAN to perform a task that normally would have failed. Force
7679 takes as arguments a method name to be called and any number of
7680 additional arguments that should be passed to the called method. The
7681 internals of the object get the needed changes so that CPAN.pm does
7682 not refuse to take the action. The C<force> is passed recursively to
7683 all contained objects.
7685 =item CPAN::Bundle::get()
7687 Recursively runs the C<get> method on all items contained in the bundle
7689 =item CPAN::Bundle::inst_file()
7691 Returns the highest installed version of the bundle in either @INC or
7692 C<$CPAN::Config->{cpan_home}>. Note that this is different from
7693 CPAN::Module::inst_file.
7695 =item CPAN::Bundle::inst_version()
7697 Like CPAN::Bundle::inst_file, but returns the $VERSION
7699 =item CPAN::Bundle::uptodate()
7701 Returns 1 if the bundle itself and all its members are uptodate.
7703 =item CPAN::Bundle::install()
7705 Recursively runs the C<install> method on all items contained in the bundle
7707 =item CPAN::Bundle::make()
7709 Recursively runs the C<make> method on all items contained in the bundle
7711 =item CPAN::Bundle::readme()
7713 Recursively runs the C<readme> method on all items contained in the bundle
7715 =item CPAN::Bundle::test()
7717 Recursively runs the C<test> method on all items contained in the bundle
7719 =item CPAN::Distribution::as_glimpse()
7721 Returns a one-line description of the distribution
7723 =item CPAN::Distribution::as_string()
7725 Returns a multi-line description of the distribution
7727 =item CPAN::Distribution::author
7729 Returns the CPAN::Author object of the maintainer who uploaded this
7732 =item CPAN::Distribution::clean()
7734 Changes to the directory where the distribution has been unpacked and
7735 runs C<make clean> there.
7737 =item CPAN::Distribution::containsmods()
7739 Returns a list of IDs of modules contained in a distribution file.
7740 Only works for distributions listed in the 02packages.details.txt.gz
7741 file. This typically means that only the most recent version of a
7742 distribution is covered.
7744 =item CPAN::Distribution::cvs_import()
7746 Changes to the directory where the distribution has been unpacked and
7749 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
7753 =item CPAN::Distribution::dir()
7755 Returns the directory into which this distribution has been unpacked.
7757 =item CPAN::Distribution::force($method,@args)
7759 Forces CPAN to perform a task that normally would have failed. Force
7760 takes as arguments a method name to be called and any number of
7761 additional arguments that should be passed to the called method. The
7762 internals of the object get the needed changes so that CPAN.pm does
7763 not refuse to take the action.
7765 =item CPAN::Distribution::get()
7767 Downloads the distribution from CPAN and unpacks it. Does nothing if
7768 the distribution has already been downloaded and unpacked within the
7771 =item CPAN::Distribution::install()
7773 Changes to the directory where the distribution has been unpacked and
7774 runs the external command C<make install> there. If C<make> has not
7775 yet been run, it will be run first. A C<make test> will be issued in
7776 any case and if this fails, the install will be canceled. The
7777 cancellation can be avoided by letting C<force> run the C<install> for
7780 Note that install() gives no meaningful return value. See uptodate().
7782 =item CPAN::Distribution::isa_perl()
7784 Returns 1 if this distribution file seems to be a perl distribution.
7785 Normally this is derived from the file name only, but the index from
7786 CPAN can contain a hint to achieve a return value of true for other
7789 =item CPAN::Distribution::look()
7791 Changes to the directory where the distribution has been unpacked and
7792 opens a subshell there. Exiting the subshell returns.
7794 =item CPAN::Distribution::make()
7796 First runs the C<get> method to make sure the distribution is
7797 downloaded and unpacked. Changes to the directory where the
7798 distribution has been unpacked and runs the external commands C<perl
7799 Makefile.PL> or C<perl Build.PL> and C<make> there.
7801 =item CPAN::Distribution::perldoc()
7803 Downloads the pod documentation of the file associated with a
7804 distribution (in html format) and runs it through the external
7805 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
7806 isn't available, it converts it to plain text with external
7807 command html2text and runs it through the pager specified
7808 in C<$CPAN::Config->{pager}>
7810 =item CPAN::Distribution::prereq_pm()
7812 Returns the hash reference that has been announced by a distribution
7813 as the merge of the C<requires> element and the C<build_requires>
7814 element of the META.yml or the C<PREREQ_PM> hash in the
7815 C<Makefile.PL>. Note: works only after an attempt has been made to
7816 C<make> the distribution. Returns undef otherwise.
7818 =item CPAN::Distribution::readme()
7820 Downloads the README file associated with a distribution and runs it
7821 through the pager specified in C<$CPAN::Config->{pager}>.
7823 =item CPAN::Distribution::read_yaml()
7825 Returns the content of the META.yml of this distro as a hashref. Note:
7826 works only after an attempt has been made to C<make> the distribution.
7827 Returns undef otherwise.
7829 =item CPAN::Distribution::test()
7831 Changes to the directory where the distribution has been unpacked and
7832 runs C<make test> there.
7834 =item CPAN::Distribution::uptodate()
7836 Returns 1 if all the modules contained in the distribution are
7837 uptodate. Relies on containsmods.
7839 =item CPAN::Index::force_reload()
7841 Forces a reload of all indices.
7843 =item CPAN::Index::reload()
7845 Reloads all indices if they have not been read for more than
7846 C<$CPAN::Config->{index_expire}> days.
7848 =item CPAN::InfoObj::dump()
7850 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
7851 inherit this method. It prints the data structure associated with an
7852 object. Useful for debugging. Note: the data structure is considered
7853 internal and thus subject to change without notice.
7855 =item CPAN::Module::as_glimpse()
7857 Returns a one-line description of the module in four columns: The
7858 first column contains the word C<Module>, the second column consists
7859 of one character: an equals sign if this module is already installed
7860 and uptodate, a less-than sign if this module is installed but can be
7861 upgraded, and a space if the module is not installed. The third column
7862 is the name of the module and the fourth column gives maintainer or
7863 distribution information.
7865 =item CPAN::Module::as_string()
7867 Returns a multi-line description of the module
7869 =item CPAN::Module::clean()
7871 Runs a clean on the distribution associated with this module.
7873 =item CPAN::Module::cpan_file()
7875 Returns the filename on CPAN that is associated with the module.
7877 =item CPAN::Module::cpan_version()
7879 Returns the latest version of this module available on CPAN.
7881 =item CPAN::Module::cvs_import()
7883 Runs a cvs_import on the distribution associated with this module.
7885 =item CPAN::Module::description()
7887 Returns a 44 character description of this module. Only available for
7888 modules listed in The Module List (CPAN/modules/00modlist.long.html
7889 or 00modlist.long.txt.gz)
7891 =item CPAN::Module::distribution()
7893 Returns the CPAN::Distribution object that contains the current
7894 version of this module.
7896 =item CPAN::Module::dslip_status()
7898 Returns a hash reference. The keys of the hash are the letters C<D>,
7899 C<S>, C<L>, C<I>, and <P>, for development status, support level,
7900 language, interface and public licence respectively. The data for the
7901 DSLIP status are collected by pause.perl.org when authors register
7902 their namespaces. The values of the 5 hash elements are one-character
7903 words whose meaning is described in the table below. There are also 5
7904 hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
7905 verbose value of the 5 status variables.
7907 Where the 'DSLIP' characters have the following meanings:
7909 D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
7910 i - Idea, listed to gain consensus or as a placeholder
7911 c - under construction but pre-alpha (not yet released)
7912 a/b - Alpha/Beta testing
7914 M - Mature (no rigorous definition)
7915 S - Standard, supplied with Perl 5
7920 u - Usenet newsgroup comp.lang.perl.modules
7921 n - None known, try comp.lang.perl.modules
7922 a - abandoned; volunteers welcome to take over maintainance
7925 p - Perl-only, no compiler needed, should be platform independent
7926 c - C and perl, a C compiler will be needed
7927 h - Hybrid, written in perl with optional C code, no compiler needed
7928 + - C++ and perl, a C++ compiler will be needed
7929 o - perl and another language other than C or C++
7932 f - plain Functions, no references used
7933 h - hybrid, object and function interfaces available
7934 n - no interface at all (huh?)
7935 r - some use of unblessed References or ties
7936 O - Object oriented using blessed references and/or inheritance
7939 p - Standard-Perl: user may choose between GPL and Artistic
7940 g - GPL: GNU General Public License
7941 l - LGPL: "GNU Lesser General Public License" (previously known as
7942 "GNU Library General Public License")
7943 b - BSD: The BSD License
7944 a - Artistic license alone
7945 o - open source: appoved by www.opensource.org
7946 d - allows distribution without restrictions
7947 r - restricted distribtion
7948 n - no license at all
7950 =item CPAN::Module::force($method,@args)
7952 Forces CPAN to perform a task that normally would have failed. Force
7953 takes as arguments a method name to be called and any number of
7954 additional arguments that should be passed to the called method. The
7955 internals of the object get the needed changes so that CPAN.pm does
7956 not refuse to take the action.
7958 =item CPAN::Module::get()
7960 Runs a get on the distribution associated with this module.
7962 =item CPAN::Module::inst_file()
7964 Returns the filename of the module found in @INC. The first file found
7965 is reported just like perl itself stops searching @INC when it finds a
7968 =item CPAN::Module::inst_version()
7970 Returns the version number of the module in readable format.
7972 =item CPAN::Module::install()
7974 Runs an C<install> on the distribution associated with this module.
7976 =item CPAN::Module::look()
7978 Changes to the directory where the distribution associated with this
7979 module has been unpacked and opens a subshell there. Exiting the
7982 =item CPAN::Module::make()
7984 Runs a C<make> on the distribution associated with this module.
7986 =item CPAN::Module::manpage_headline()
7988 If module is installed, peeks into the module's manpage, reads the
7989 headline and returns it. Moreover, if the module has been downloaded
7990 within this session, does the equivalent on the downloaded module even
7991 if it is not installed.
7993 =item CPAN::Module::perldoc()
7995 Runs a C<perldoc> on this module.
7997 =item CPAN::Module::readme()
7999 Runs a C<readme> on the distribution associated with this module.
8001 =item CPAN::Module::test()
8003 Runs a C<test> on the distribution associated with this module.
8005 =item CPAN::Module::uptodate()
8007 Returns 1 if the module is installed and up-to-date.
8009 =item CPAN::Module::userid()
8011 Returns the author's ID of the module.
8015 =head2 Cache Manager
8017 Currently the cache manager only keeps track of the build directory
8018 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
8019 deletes complete directories below C<build_dir> as soon as the size of
8020 all directories there gets bigger than $CPAN::Config->{build_cache}
8021 (in MB). The contents of this cache may be used for later
8022 re-installations that you intend to do manually, but will never be
8023 trusted by CPAN itself. This is due to the fact that the user might
8024 use these directories for building modules on different architectures.
8026 There is another directory ($CPAN::Config->{keep_source_where}) where
8027 the original distribution files are kept. This directory is not
8028 covered by the cache manager and must be controlled by the user. If
8029 you choose to have the same directory as build_dir and as
8030 keep_source_where directory, then your sources will be deleted with
8031 the same fifo mechanism.
8035 A bundle is just a perl module in the namespace Bundle:: that does not
8036 define any functions or methods. It usually only contains documentation.
8038 It starts like a perl module with a package declaration and a $VERSION
8039 variable. After that the pod section looks like any other pod with the
8040 only difference being that I<one special pod section> exists starting with
8045 In this pod section each line obeys the format
8047 Module_Name [Version_String] [- optional text]
8049 The only required part is the first field, the name of a module
8050 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
8051 of the line is optional. The comment part is delimited by a dash just
8052 as in the man page header.
8054 The distribution of a bundle should follow the same convention as
8055 other distributions.
8057 Bundles are treated specially in the CPAN package. If you say 'install
8058 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
8059 the modules in the CONTENTS section of the pod. You can install your
8060 own Bundles locally by placing a conformant Bundle file somewhere into
8061 your @INC path. The autobundle() command which is available in the
8062 shell interface does that for you by including all currently installed
8063 modules in a snapshot bundle file.
8065 =head1 PREREQUISITES
8067 If you have a local mirror of CPAN and can access all files with
8068 "file:" URLs, then you only need a perl better than perl5.003 to run
8069 this module. Otherwise Net::FTP is strongly recommended. LWP may be
8070 required for non-UNIX systems or if your nearest CPAN site is
8071 associated with a URL that is not C<ftp:>.
8073 If you have neither Net::FTP nor LWP, there is a fallback mechanism
8074 implemented for an external ftp command or for an external lynx
8079 =head2 Finding packages and VERSION
8081 This module presumes that all packages on CPAN
8087 declare their $VERSION variable in an easy to parse manner. This
8088 prerequisite can hardly be relaxed because it consumes far too much
8089 memory to load all packages into the running program just to determine
8090 the $VERSION variable. Currently all programs that are dealing with
8091 version use something like this
8093 perl -MExtUtils::MakeMaker -le \
8094 'print MM->parse_version(shift)' filename
8096 If you are author of a package and wonder if your $VERSION can be
8097 parsed, please try the above method.
8101 come as compressed or gzipped tarfiles or as zip files and contain a
8102 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
8103 without much enthusiasm).
8109 The debugging of this module is a bit complex, because we have
8110 interferences of the software producing the indices on CPAN, of the
8111 mirroring process on CPAN, of packaging, of configuration, of
8112 synchronicity, and of bugs within CPAN.pm.
8114 For code debugging in interactive mode you can try "o debug" which
8115 will list options for debugging the various parts of the code. You
8116 should know that "o debug" has built-in completion support.
8118 For data debugging there is the C<dump> command which takes the same
8119 arguments as make/test/install and outputs the object's Data::Dumper
8122 =head2 Floppy, Zip, Offline Mode
8124 CPAN.pm works nicely without network too. If you maintain machines
8125 that are not networked at all, you should consider working with file:
8126 URLs. Of course, you have to collect your modules somewhere first. So
8127 you might use CPAN.pm to put together all you need on a networked
8128 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
8129 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
8130 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
8131 with this floppy. See also below the paragraph about CD-ROM support.
8133 =head2 Basic Utilities for Programmers
8137 =item has_inst($module)
8139 Returns true if the module is installed. See the source for details.
8141 =item has_usable($module)
8143 Returns true if the module is installed and several and is in a usable
8144 state. Only useful for a handful of modules that are used internally.
8145 See the source for details.
8147 =item instance($module)
8149 The constructor for all the singletons used to represent modules,
8150 distributions, authors and bundles. If the object already exists, this
8151 method returns the object, otherwise it calls the constructor.
8155 =head1 CONFIGURATION
8157 When the CPAN module is used for the first time, a configuration
8158 dialog tries to determine a couple of site specific options. The
8159 result of the dialog is stored in a hash reference C< $CPAN::Config >
8160 in a file CPAN/Config.pm.
8162 The default values defined in the CPAN/Config.pm file can be
8163 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
8164 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
8165 added to the search path of the CPAN module before the use() or
8166 require() statements.
8168 The configuration dialog can be started any time later again by
8169 issuing the command C< o conf init > in the CPAN shell. A subset of
8170 the configuration dialog can be run by issuing C<o conf init WORD>
8171 where WORD is any valid config variable or a regular expression.
8173 Currently the following keys in the hash reference $CPAN::Config are
8176 build_cache size of cache for directories to build modules
8177 build_dir locally accessible directory to build modules
8178 bzip2 path to external prg
8179 cache_metadata use serializer to cache metadata
8180 commands_quote prefered character to use for quoting external
8181 commands when running them. Defaults to double
8182 quote on Windows, single tick everywhere else;
8183 can be set to space to disable quoting
8184 check_sigs if signatures should be verified
8185 colorize_output boolean if Term::ANSIColor should colorize output
8186 colorize_print Term::ANSIColor attributes for normal output
8187 colorize_warn Term::ANSIColor attributes for warnings
8188 commandnumber_in_prompt
8189 boolean if you want to see current command number
8190 cpan_home local directory reserved for this package
8191 curl path to external prg
8192 dontload_hash DEPRECATED
8193 dontload_list arrayref: modules in the list will not be
8194 loaded by the CPAN::has_inst() routine
8195 ftp path to external prg
8196 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
8197 ftp_proxy proxy host for ftp requests
8199 gpg path to external prg
8200 gzip location of external program gzip
8201 histfile file to maintain history between sessions
8202 histsize maximum number of lines to keep in histfile
8203 http_proxy proxy host for http requests
8204 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
8205 after this many seconds inactivity. Set to 0 to
8207 index_expire after this many days refetch index files
8208 inhibit_startup_message
8209 if true, does not print the startup message
8210 keep_source_where directory in which to keep the source (if we do)
8211 lynx path to external prg
8212 make location of external make program
8213 make_arg arguments that should always be passed to 'make'
8214 make_install_make_command
8215 the make command for running 'make install', for
8217 make_install_arg same as make_arg for 'make install'
8218 makepl_arg arguments passed to 'perl Makefile.PL'
8219 mbuild_arg arguments passed to './Build'
8220 mbuild_install_arg arguments passed to './Build install'
8221 mbuild_install_build_command
8222 command to use instead of './Build' when we are
8223 in the install stage, for example 'sudo ./Build'
8224 mbuildpl_arg arguments passed to 'perl Build.PL'
8225 ncftp path to external prg
8226 ncftpget path to external prg
8227 no_proxy don't proxy to these hosts/domains (comma separated list)
8228 pager location of external program more (or any pager)
8229 password your password if you CPAN server wants one
8230 prefer_installer legal values are MB and EUMM: if a module comes
8231 with both a Makefile.PL and a Build.PL, use the
8232 former (EUMM) or the latter (MB); if the module
8233 comes with only one of the two, that one will be
8235 prerequisites_policy
8236 what to do if you are missing module prerequisites
8237 ('follow' automatically, 'ask' me, or 'ignore')
8238 proxy_user username for accessing an authenticating proxy
8239 proxy_pass password for accessing an authenticating proxy
8240 scan_cache controls scanning of cache ('atstart' or 'never')
8241 shell your favorite shell
8242 show_upload_date boolean if commands should try to determine upload date
8243 tar location of external program tar
8244 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
8245 (and nonsense for characters outside latin range)
8246 term_ornaments boolean to turn ReadLine ornamenting on/off
8247 test_report email test reports (if CPAN::Reporter is installed)
8248 unzip location of external program unzip
8249 urllist arrayref to nearby CPAN sites (or equivalent locations)
8250 username your username if you CPAN server wants one
8251 wait_list arrayref to a wait server to try (See CPAN::WAIT)
8252 wget path to external prg
8254 You can set and query each of these options interactively in the cpan
8255 shell with the command set defined within the C<o conf> command:
8259 =item C<o conf E<lt>scalar optionE<gt>>
8261 prints the current value of the I<scalar option>
8263 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
8265 Sets the value of the I<scalar option> to I<value>
8267 =item C<o conf E<lt>list optionE<gt>>
8269 prints the current value of the I<list option> in MakeMaker's
8272 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
8274 shifts or pops the array in the I<list option> variable
8276 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
8278 works like the corresponding perl commands.
8282 =head2 CPAN::anycwd($path): Note on config variable getcwd
8284 CPAN.pm changes the current working directory often and needs to
8285 determine its own current working directory. Per default it uses
8286 Cwd::cwd but if this doesn't work on your system for some reason,
8287 alternatives can be configured according to the following table:
8305 Calls the external command cwd.
8309 =head2 Note on urllist parameter's format
8311 urllist parameters are URLs according to RFC 1738. We do a little
8312 guessing if your URL is not compliant, but if you have problems with
8313 file URLs, please try the correct format. Either:
8315 file://localhost/whatever/ftp/pub/CPAN/
8319 file:///home/ftp/pub/CPAN/
8321 =head2 urllist parameter has CD-ROM support
8323 The C<urllist> parameter of the configuration table contains a list of
8324 URLs that are to be used for downloading. If the list contains any
8325 C<file> URLs, CPAN always tries to get files from there first. This
8326 feature is disabled for index files. So the recommendation for the
8327 owner of a CD-ROM with CPAN contents is: include your local, possibly
8328 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
8330 o conf urllist push file://localhost/CDROM/CPAN
8332 CPAN.pm will then fetch the index files from one of the CPAN sites
8333 that come at the beginning of urllist. It will later check for each
8334 module if there is a local copy of the most recent version.
8336 Another peculiarity of urllist is that the site that we could
8337 successfully fetch the last file from automatically gets a preference
8338 token and is tried as the first site for the next request. So if you
8339 add a new site at runtime it may happen that the previously preferred
8340 site will be tried another time. This means that if you want to disallow
8341 a site for the next transfer, it must be explicitly removed from
8346 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
8347 install foreign, unmasked, unsigned code on your machine. We compare
8348 to a checksum that comes from the net just as the distribution file
8349 itself. But we try to make it easy to add security on demand:
8351 =head2 Cryptographically signed modules
8353 Since release 1.77 CPAN.pm has been able to verify cryptographically
8354 signed module distributions using Module::Signature. The CPAN modules
8355 can be signed by their authors, thus giving more security. The simple
8356 unsigned MD5 checksums that were used before by CPAN protect mainly
8357 against accidental file corruption.
8359 You will need to have Module::Signature installed, which in turn
8360 requires that you have at least one of Crypt::OpenPGP module or the
8361 command-line F<gpg> tool installed.
8363 You will also need to be able to connect over the Internet to the public
8364 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
8366 The configuration parameter check_sigs is there to turn signature
8371 Most functions in package CPAN are exported per default. The reason
8372 for this is that the primary use is intended for the cpan shell or for
8377 When the CPAN shell enters a subshell via the look command, it sets
8378 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
8381 When the config variable ftp_passive is set, all downloads will be run
8382 with the environment variable FTP_PASSIVE set to this value. This is
8383 in general a good idea as it influences both Net::FTP and LWP based
8384 connections. The same effect can be achieved by starting the cpan
8385 shell with this environment variable set. For Net::FTP alone, one can
8386 also always set passive mode by running libnetcfg.
8388 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
8390 Populating a freshly installed perl with my favorite modules is pretty
8391 easy if you maintain a private bundle definition file. To get a useful
8392 blueprint of a bundle definition file, the command autobundle can be used
8393 on the CPAN shell command line. This command writes a bundle definition
8394 file for all modules that are installed for the currently running perl
8395 interpreter. It's recommended to run this command only once and from then
8396 on maintain the file manually under a private name, say
8397 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
8399 cpan> install Bundle::my_bundle
8401 then answer a few questions and then go out for a coffee.
8403 Maintaining a bundle definition file means keeping track of two
8404 things: dependencies and interactivity. CPAN.pm sometimes fails on
8405 calculating dependencies because not all modules define all MakeMaker
8406 attributes correctly, so a bundle definition file should specify
8407 prerequisites as early as possible. On the other hand, it's a bit
8408 annoying that many distributions need some interactive configuring. So
8409 what I try to accomplish in my private bundle file is to have the
8410 packages that need to be configured early in the file and the gentle
8411 ones later, so I can go out after a few minutes and leave CPAN.pm
8414 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
8416 Thanks to Graham Barr for contributing the following paragraphs about
8417 the interaction between perl, and various firewall configurations. For
8418 further information on firewalls, it is recommended to consult the
8419 documentation that comes with the ncftp program. If you are unable to
8420 go through the firewall with a simple Perl setup, it is very likely
8421 that you can configure ncftp so that it works for your firewall.
8423 =head2 Three basic types of firewalls
8425 Firewalls can be categorized into three basic types.
8431 This is where the firewall machine runs a web server and to access the
8432 outside world you must do it via the web server. If you set environment
8433 variables like http_proxy or ftp_proxy to a values beginning with http://
8434 or in your web browser you have to set proxy information then you know
8435 you are running an http firewall.
8437 To access servers outside these types of firewalls with perl (even for
8438 ftp) you will need to use LWP.
8442 This where the firewall machine runs an ftp server. This kind of
8443 firewall will only let you access ftp servers outside the firewall.
8444 This is usually done by connecting to the firewall with ftp, then
8445 entering a username like "user@outside.host.com"
8447 To access servers outside these type of firewalls with perl you
8448 will need to use Net::FTP.
8450 =item One way visibility
8452 I say one way visibility as these firewalls try to make themselves look
8453 invisible to the users inside the firewall. An FTP data connection is
8454 normally created by sending the remote server your IP address and then
8455 listening for the connection. But the remote server will not be able to
8456 connect to you because of the firewall. So for these types of firewall
8457 FTP connections need to be done in a passive mode.
8459 There are two that I can think off.
8465 If you are using a SOCKS firewall you will need to compile perl and link
8466 it with the SOCKS library, this is what is normally called a 'socksified'
8467 perl. With this executable you will be able to connect to servers outside
8468 the firewall as if it is not there.
8472 This is the firewall implemented in the Linux kernel, it allows you to
8473 hide a complete network behind one IP address. With this firewall no
8474 special compiling is needed as you can access hosts directly.
8476 For accessing ftp servers behind such firewalls you usually need to
8477 set the environment variable C<FTP_PASSIVE> or the config variable
8478 ftp_passive to a true value.
8484 =head2 Configuring lynx or ncftp for going through a firewall
8486 If you can go through your firewall with e.g. lynx, presumably with a
8489 /usr/local/bin/lynx -pscott:tiger
8491 then you would configure CPAN.pm with the command
8493 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
8495 That's all. Similarly for ncftp or ftp, you would configure something
8498 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
8500 Your mileage may vary...
8508 I installed a new version of module X but CPAN keeps saying,
8509 I have the old version installed
8511 Most probably you B<do> have the old version installed. This can
8512 happen if a module installs itself into a different directory in the
8513 @INC path than it was previously installed. This is not really a
8514 CPAN.pm problem, you would have the same problem when installing the
8515 module manually. The easiest way to prevent this behaviour is to add
8516 the argument C<UNINST=1> to the C<make install> call, and that is why
8517 many people add this argument permanently by configuring
8519 o conf make_install_arg UNINST=1
8523 So why is UNINST=1 not the default?
8525 Because there are people who have their precise expectations about who
8526 may install where in the @INC path and who uses which @INC array. In
8527 fine tuned environments C<UNINST=1> can cause damage.
8531 I want to clean up my mess, and install a new perl along with
8532 all modules I have. How do I go about it?
8534 Run the autobundle command for your old perl and optionally rename the
8535 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
8536 with the Configure option prefix, e.g.
8538 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
8540 Install the bundle file you produced in the first step with something like
8542 cpan> install Bundle::mybundle
8548 When I install bundles or multiple modules with one command
8549 there is too much output to keep track of.
8551 You may want to configure something like
8553 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
8554 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
8556 so that STDOUT is captured in a file for later inspection.
8561 I am not root, how can I install a module in a personal directory?
8563 First of all, you will want to use your own configuration, not the one
8564 that your root user installed. If you do not have permission to write
8565 in the cpan directory that root has configured, you will be asked if
8566 you want to create your own config. Answering "yes" will bring you into
8567 CPAN's configuration stage, using the system config for all defaults except
8568 things that have to do with CPAN's work directory, saving your choices to
8569 your MyConfig.pm file.
8571 You can also manually initiate this process with the following command:
8573 % perl -MCPAN -e 'mkmyconfig'
8579 from the CPAN shell.
8581 You will most probably also want to configure something like this:
8583 o conf makepl_arg "LIB=~/myperl/lib \
8584 INSTALLMAN1DIR=~/myperl/man/man1 \
8585 INSTALLMAN3DIR=~/myperl/man/man3"
8587 You can make this setting permanent like all C<o conf> settings with
8590 You will have to add ~/myperl/man to the MANPATH environment variable
8591 and also tell your perl programs to look into ~/myperl/lib, e.g. by
8594 use lib "$ENV{HOME}/myperl/lib";
8596 or setting the PERL5LIB environment variable.
8598 While we're speaking about $ENV{HOME}, it might be worth mentioning,
8599 that for Windows we use the File::HomeDir module that provides an
8600 equivalent to the concept of the home directory on Unix.
8602 Another thing you should bear in mind is that the UNINST parameter can
8603 be dnagerous when you are installing into a private area because you
8604 might accidentally remove modules that other people depend on that are
8605 not using the private area.
8609 How to get a package, unwrap it, and make a change before building it?
8611 Have a look at the C<look> (!) command.
8615 I installed a Bundle and had a couple of fails. When I
8616 retried, everything resolved nicely. Can this be fixed to work
8619 The reason for this is that CPAN does not know the dependencies of all
8620 modules when it starts out. To decide about the additional items to
8621 install, it just uses data found in the META.yml file or the generated
8622 Makefile. An undetected missing piece breaks the process. But it may
8623 well be that your Bundle installs some prerequisite later than some
8624 depending item and thus your second try is able to resolve everything.
8625 Please note, CPAN.pm does not know the dependency tree in advance and
8626 cannot sort the queue of things to install in a topologically correct
8627 order. It resolves perfectly well IF all modules declare the
8628 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
8629 the C<requires> stanza of Module::Build. For bundles which fail and
8630 you need to install often, it is recommended to sort the Bundle
8631 definition file manually.
8635 In our intranet we have many modules for internal use. How
8636 can I integrate these modules with CPAN.pm but without uploading
8637 the modules to CPAN?
8639 Have a look at the CPAN::Site module.
8643 When I run CPAN's shell, I get an error message about things in my
8644 /etc/inputrc (or ~/.inputrc) file.
8646 These are readline issues and can only be fixed by studying readline
8647 configuration on your architecture and adjusting the referenced file
8648 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
8649 and edit them. Quite often harmless changes like uppercasing or
8650 lowercasing some arguments solves the problem.
8654 Some authors have strange characters in their names.
8656 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
8657 expecting ISO-8859-1 charset, a converter can be activated by setting
8658 term_is_latin to a true value in your config file. One way of doing so
8661 cpan> o conf term_is_latin 1
8663 If other charset support is needed, please file a bugreport against
8664 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
8665 the support or maybe UTF-8 terminals become widely available.
8669 When an install fails for some reason and then I correct the error
8670 condition and retry, CPAN.pm refuses to install the module, saying
8671 C<Already tried without success>.
8673 Use the force pragma like so
8675 force install Foo::Bar
8677 This does a bit more than really needed because it untars the
8678 distribution again and runs make and test and only then install.
8680 Or, if you find this is too fast and you would prefer to do smaller
8685 first and then continue as always. C<Force get> I<forgets> previous
8692 and then 'make install' directly in the subshell.
8694 Or you leave the CPAN shell and start it again.
8696 For the really curious, by accessing internals directly, you I<could>
8698 !delete CPAN::Shell->expandany("Foo::Bar")->distribution->{install}
8700 but this is neither guaranteed to work in the future nor is it a
8705 How do I install a "DEVELOPER RELEASE" of a module?
8707 By default, CPAN will install the latest non-developer release of a
8708 module. If you want to install a dev release, you have to specify the
8709 partial path starting with the author id to the tarball you wish to
8712 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
8714 Note that you can use the C<ls> command to get this path listed.
8718 How do I install a module and all its dependencies from the commandline,
8719 without being prompted for anything, despite my CPAN configuration
8722 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
8723 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
8724 asked any questions at all (assuming the modules you are installing are
8725 nice about obeying that variable as well):
8727 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
8731 How do I create a Module::Build based Build.PL derived from an
8732 ExtUtils::MakeMaker focused Makefile.PL?
8734 http://search.cpan.org/search?query=Module::Build::Convert
8736 http://accognoscere.org/papers/perl-module-build-convert/module-build-convert.html
8743 Please report bugs via http://rt.cpan.org/
8745 Before submitting a bug, please make sure that the traditional method
8746 of building a Perl module package from a shell by following the
8747 installation instructions of that package still works in your
8750 =head1 SECURITY ADVICE
8752 This software enables you to upgrade software on your computer and so
8753 is inherently dangerous because the newly installed software may
8754 contain bugs and may alter the way your computer works or even make it
8755 unusable. Please consider backing up your data before every upgrade.
8759 Andreas Koenig C<< <andk@cpan.org> >>
8763 This program is free software; you can redistribute it and/or
8764 modify it under the same terms as Perl itself.
8766 See L<http://www.perl.com/perl/misc/Artistic.html>
8770 Kawai,Takanori provides a Japanese translation of this manpage at
8771 http://member.nifty.ne.jp/hippo2000/perltips/CPAN.htm
8775 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)