1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 $CPAN::VERSION = '1.87_63';
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 for ($CPAN::Config->{term_ornaments}) { # alias
265 if (not defined $last_term_ornaments
266 or $_ != $last_term_ornaments
268 local $Term::ReadLine::termcap_nowarn = 1;
269 $term->ornaments($_);
270 $last_term_ornaments = $_;
273 undef $last_term_ornaments;
277 soft_chdir_with_alternatives(\@cwd);
280 sub soft_chdir_with_alternatives ($) {
282 while (not chdir $cwd->[0]) {
284 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
285 Trying to chdir to "$cwd->[1]" instead.
289 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
294 package CPAN::CacheMgr;
296 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
301 use vars qw($Ua $Thesite $ThesiteURL $Themethod);
302 @CPAN::FTP::ISA = qw(CPAN::Debug);
304 package CPAN::LWP::UserAgent;
306 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
307 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
309 package CPAN::Complete;
311 @CPAN::Complete::ISA = qw(CPAN::Debug);
312 @CPAN::Complete::COMMANDS = sort qw(
313 ! a b d h i m o q r u
337 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03);
338 @CPAN::Index::ISA = qw(CPAN::Debug);
341 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
344 package CPAN::InfoObj;
346 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
348 package CPAN::Author;
350 @CPAN::Author::ISA = qw(CPAN::InfoObj);
352 package CPAN::Distribution;
354 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
356 package CPAN::Bundle;
358 @CPAN::Bundle::ISA = qw(CPAN::Module);
360 package CPAN::Module;
362 @CPAN::Module::ISA = qw(CPAN::InfoObj);
364 package CPAN::Exception::RecursiveDependency;
366 use overload '""' => "as_string";
373 for my $dep (@$deps) {
375 last if $seen{$dep}++;
377 bless { deps => \@deps }, $class;
382 "\nRecursive dependency detected:\n " .
383 join("\n => ", @{$self->{deps}}) .
384 ".\nCannot continue.\n";
387 package CPAN::Prompt; use overload '""' => "as_string";
388 use vars qw($prompt);
390 $CPAN::CurrentCommandId ||= 0;
395 if ($CPAN::Config->{commandnumber_in_prompt}) {
396 sprintf "cpan[%d]> ", $CPAN::CurrentCommandId;
402 package CPAN::URL; use overload '""' => "as_string", fallback => 1;
403 # accessors: TEXT(the url string), FROM(DEF=>defaultlist,USER=>urllist),
404 # planned are things like age or quality
406 my($class,%args) = @_;
418 $self->{TEXT} = $set;
423 package CPAN::Distrostatus;
424 use overload '""' => "as_string",
427 my($class,$arg) = @_;
430 FAILED => substr($arg,0,2) eq "NO",
431 COMMANDID => $CPAN::CurrentCommandId,
434 sub commandid { shift->{COMMANDID} }
435 sub failed { shift->{FAILED} }
439 $self->{TEXT} = $set;
450 use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY);
451 @CPAN::Shell::ISA = qw(CPAN::Debug);
452 $COLOR_REGISTERED ||= 0;
454 #-> sub CPAN::Shell::AUTOLOAD ;
456 my($autoload) = $AUTOLOAD;
457 my $class = shift(@_);
458 # warn "autoload[$autoload] class[$class]";
459 $autoload =~ s/.*:://;
460 if ($autoload =~ /^w/) {
461 if ($CPAN::META->has_inst('CPAN::WAIT')) {
462 CPAN::WAIT->$autoload(@_);
464 $CPAN::Frontend->mywarn(qq{
465 Commands starting with "w" require CPAN::WAIT to be installed.
466 Please consider installing CPAN::WAIT to use the fulltext index.
467 For this you just need to type
472 $CPAN::Frontend->mywarn(qq{Unknown shell command '$autoload @_'. }.
481 # One use of the queue is to determine if we should or shouldn't
482 # announce the availability of a new CPAN module
484 # Now we try to use it for dependency tracking. For that to happen
485 # we need to draw a dependency tree and do the leaves first. This can
486 # easily be reached by running CPAN.pm recursively, but we don't want
487 # to waste memory and run into deep recursion. So what we can do is
490 # CPAN::Queue is the package where the queue is maintained. Dependencies
491 # often have high priority and must be brought to the head of the queue,
492 # possibly by jumping the queue if they are already there. My first code
493 # attempt tried to be extremely correct. Whenever a module needed
494 # immediate treatment, I either unshifted it to the front of the queue,
495 # or, if it was already in the queue, I spliced and let it bypass the
496 # others. This became a too correct model that made it impossible to put
497 # an item more than once into the queue. Why would you need that? Well,
498 # you need temporary duplicates as the manager of the queue is a loop
501 # (1) looks at the first item in the queue without shifting it off
503 # (2) cares for the item
505 # (3) removes the item from the queue, *even if its agenda failed and
506 # even if the item isn't the first in the queue anymore* (that way
507 # protecting against never ending queues)
509 # So if an item has prerequisites, the installation fails now, but we
510 # want to retry later. That's easy if we have it twice in the queue.
512 # I also expect insane dependency situations where an item gets more
513 # than two lives in the queue. Simplest example is triggered by 'install
514 # Foo Foo Foo'. People make this kind of mistakes and I don't want to
515 # get in the way. I wanted the queue manager to be a dumb servant, not
516 # one that knows everything.
518 # Who would I tell in this model that the user wants to be asked before
519 # processing? I can't attach that information to the module object,
520 # because not modules are installed but distributions. So I'd have to
521 # tell the distribution object that it should ask the user before
522 # processing. Where would the question be triggered then? Most probably
523 # in CPAN::Distribution::rematein.
524 # Hope that makes sense, my head is a bit off:-) -- AK
531 my $self = bless { qmod => $s }, $class;
536 # CPAN::Queue::first ;
542 # CPAN::Queue::delete_first ;
544 my($class,$what) = @_;
546 for my $i (0..$#All) {
547 if ( $All[$i]->{qmod} eq $what ) {
554 # CPAN::Queue::jumpqueue ;
558 CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
559 join(",",map {$_->{qmod}} @All),
562 WHAT: for my $what (reverse @what) {
564 for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
565 CPAN->debug("i[$All[$i]]what[$what]") if $CPAN::DEBUG;
566 if ($All[$i]->{qmod} eq $what){
568 if ($jumped > 100) { # one's OK if e.g. just
569 # processing now; more are OK if
570 # user typed it several times
571 $CPAN::Frontend->mywarn(
572 qq{Object [$what] queued more than 100 times, ignoring}
578 my $obj = bless { qmod => $what }, $class;
581 CPAN->debug(sprintf("after jumpqueue All[%s] what[%s]",
582 join(",",map {$_->{qmod}} @All),
587 # CPAN::Queue::exists ;
589 my($self,$what) = @_;
590 my @all = map { $_->{qmod} } @All;
591 my $exists = grep { $_->{qmod} eq $what } @All;
592 # warn "in exists what[$what] all[@all] exists[$exists]";
596 # CPAN::Queue::delete ;
599 @All = grep { $_->{qmod} ne $mod } @All;
602 # CPAN::Queue::nullify_queue ;
612 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
614 # from here on only subs.
615 ################################################################################
617 sub suggest_myconfig () {
618 SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
619 $CPAN::Frontend->myprint("You don't seem to have a user ".
620 "configuration (MyConfig.pm) yet.\n");
621 my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ".
622 "user configuration now? (Y/n)",
625 CPAN::Shell->mkmyconfig();
628 $CPAN::Frontend->mydie("OK, giving up.");
633 #-> sub CPAN::all_objects ;
635 my($mgr,$class) = @_;
636 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
637 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
639 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
641 *all = \&all_objects;
643 # Called by shell, not in batch mode. In batch mode I see no risk in
644 # having many processes updating something as installations are
645 # continually checked at runtime. In shell mode I suspect it is
646 # unintentional to open more than one shell at a time
648 #-> sub CPAN::checklock ;
651 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
652 if (-f $lockfile && -M _ > 0) {
653 my $fh = FileHandle->new($lockfile) or
654 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
655 my $otherpid = <$fh>;
656 my $otherhost = <$fh>;
658 if (defined $otherpid && $otherpid) {
661 if (defined $otherhost && $otherhost) {
664 my $thishost = hostname();
665 if (defined $otherhost && defined $thishost &&
666 $otherhost ne '' && $thishost ne '' &&
667 $otherhost ne $thishost) {
668 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
669 "reports other host $otherhost and other ".
670 "process $otherpid.\n".
671 "Cannot proceed.\n"));
673 elsif (defined $otherpid && $otherpid) {
674 return if $$ == $otherpid; # should never happen
675 $CPAN::Frontend->mywarn(
677 There seems to be running another CPAN process (pid $otherpid). Contacting...
679 if (kill 0, $otherpid) {
680 $CPAN::Frontend->mydie(qq{Other job is running.
681 You may want to kill it and delete the lockfile, maybe. On UNIX try:
685 } elsif (-w $lockfile) {
687 CPAN::Shell::colorable_makemaker_prompt
688 (qq{Other job not responding. Shall I overwrite }.
689 qq{the lockfile '$lockfile'? (Y/n)},"y");
690 $CPAN::Frontend->myexit("Ok, bye\n")
691 unless $ans =~ /^y/i;
694 qq{Lockfile '$lockfile' not writeable by you. }.
695 qq{Cannot proceed.\n}.
697 qq{ rm '$lockfile'\n}.
698 qq{ and then rerun us.\n}
702 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
703 "reports other process with ID ".
704 "$otherpid. Cannot proceed.\n"));
707 my $dotcpan = $CPAN::Config->{cpan_home};
708 eval { File::Path::mkpath($dotcpan);};
710 # A special case at least for Jarkko.
715 $symlinkcpan = readlink $dotcpan;
716 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
717 eval { File::Path::mkpath($symlinkcpan); };
721 $CPAN::Frontend->mywarn(qq{
722 Working directory $symlinkcpan created.
726 unless (-d $dotcpan) {
728 Your configuration suggests "$dotcpan" as your
729 CPAN.pm working directory. I could not create this directory due
730 to this error: $firsterror\n};
732 As "$dotcpan" is a symlink to "$symlinkcpan",
733 I tried to create that, but I failed with this error: $seconderror
736 Please make sure the directory exists and is writable.
738 $CPAN::Frontend->myprint($mess);
739 return suggest_myconfig;
741 } # $@ after eval mkpath $dotcpan
743 unless ($fh = FileHandle->new(">$lockfile")) {
744 if ($! =~ /Permission/) {
745 $CPAN::Frontend->myprint(qq{
747 Your configuration suggests that CPAN.pm should use a working
749 $CPAN::Config->{cpan_home}
750 Unfortunately we could not create the lock file
752 due to permission problems.
754 Please make sure that the configuration variable
755 \$CPAN::Config->{cpan_home}
756 points to a directory where you can write a .lock file. You can set
757 this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
760 return suggest_myconfig;
763 $fh->print($$, "\n");
764 $fh->print(hostname(), "\n");
765 $self->{LOCK} = $lockfile;
769 $CPAN::Frontend->mydie("Got SIGTERM, leaving");
774 $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
775 print "Caught SIGINT\n";
779 # From: Larry Wall <larry@wall.org>
780 # Subject: Re: deprecating SIGDIE
781 # To: perl5-porters@perl.org
782 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
784 # The original intent of __DIE__ was only to allow you to substitute one
785 # kind of death for another on an application-wide basis without respect
786 # to whether you were in an eval or not. As a global backstop, it should
787 # not be used any more lightly (or any more heavily :-) than class
788 # UNIVERSAL. Any attempt to build a general exception model on it should
789 # be politely squashed. Any bug that causes every eval {} to have to be
790 # modified should be not so politely squashed.
792 # Those are my current opinions. It is also my optinion that polite
793 # arguments degenerate to personal arguments far too frequently, and that
794 # when they do, it's because both people wanted it to, or at least didn't
795 # sufficiently want it not to.
799 # global backstop to cleanup if we should really die
800 $SIG{__DIE__} = \&cleanup;
801 $self->debug("Signal handler set.") if $CPAN::DEBUG;
804 #-> sub CPAN::DESTROY ;
806 &cleanup; # need an eval?
809 #-> sub CPAN::anycwd ;
812 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
817 sub cwd {Cwd::cwd();}
819 #-> sub CPAN::getcwd ;
820 sub getcwd {Cwd::getcwd();}
822 #-> sub CPAN::fastcwd ;
823 sub fastcwd {Cwd::fastcwd();}
825 #-> sub CPAN::backtickcwd ;
826 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
828 #-> sub CPAN::find_perl ;
830 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
831 my $pwd = $CPAN::iCwd = CPAN::anycwd();
832 my $candidate = File::Spec->catfile($pwd,$^X);
833 $perl ||= $candidate if MM->maybe_command($candidate);
836 my ($component,$perl_name);
837 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
838 PATH_COMPONENT: foreach $component (File::Spec->path(),
839 $Config::Config{'binexp'}) {
840 next unless defined($component) && $component;
841 my($abs) = File::Spec->catfile($component,$perl_name);
842 if (MM->maybe_command($abs)) {
854 #-> sub CPAN::exists ;
856 my($mgr,$class,$id) = @_;
857 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
859 ### Carp::croak "exists called without class argument" unless $class;
861 $id =~ s/:+/::/g if $class eq "CPAN::Module";
862 exists $META->{readonly}{$class}{$id} or
863 exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
866 #-> sub CPAN::delete ;
868 my($mgr,$class,$id) = @_;
869 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
870 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
873 #-> sub CPAN::has_usable
874 # has_inst is sometimes too optimistic, we should replace it with this
875 # has_usable whenever a case is given
877 my($self,$mod,$message) = @_;
878 return 1 if $HAS_USABLE->{$mod};
879 my $has_inst = $self->has_inst($mod,$message);
880 return unless $has_inst;
883 LWP => [ # we frequently had "Can't locate object
884 # method "new" via package "LWP::UserAgent" at
885 # (eval 69) line 2006
887 sub {require LWP::UserAgent},
888 sub {require HTTP::Request},
889 sub {require URI::URL},
892 sub {require Net::FTP},
893 sub {require Net::Config},
896 sub {require File::HomeDir;
897 unless (File::HomeDir->VERSION >= 0.52){
898 for ("Will not use File::HomeDir, need 0.52\n") {
899 $CPAN::Frontend->mywarn($_);
906 if ($usable->{$mod}) {
907 for my $c (0..$#{$usable->{$mod}}) {
908 my $code = $usable->{$mod}[$c];
909 my $ret = eval { &$code() };
910 $ret = "" unless defined $ret;
912 # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
917 return $HAS_USABLE->{$mod} = 1;
920 #-> sub CPAN::has_inst
922 my($self,$mod,$message) = @_;
923 Carp::croak("CPAN->has_inst() called without an argument")
925 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
926 keys %{$CPAN::Config->{dontload_hash}||{}},
927 @{$CPAN::Config->{dontload_list}||[]};
928 if (defined $message && $message eq "no" # afair only used by Nox
932 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
940 # checking %INC is wrong, because $INC{LWP} may be true
941 # although $INC{"URI/URL.pm"} may have failed. But as
942 # I really want to say "bla loaded OK", I have to somehow
944 ### warn "$file in %INC"; #debug
946 } elsif (eval { require $file }) {
947 # eval is good: if we haven't yet read the database it's
948 # perfect and if we have installed the module in the meantime,
949 # it tries again. The second require is only a NOOP returning
950 # 1 if we had success, otherwise it's retrying
952 $CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
953 if ($mod eq "CPAN::WAIT") {
954 push @CPAN::Shell::ISA, 'CPAN::WAIT';
957 } elsif ($mod eq "Net::FTP") {
958 $CPAN::Frontend->mywarn(qq{
959 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
961 install Bundle::libnet
963 }) unless $Have_warned->{"Net::FTP"}++;
964 $CPAN::Frontend->mysleep(3);
965 } elsif ($mod eq "Digest::SHA"){
966 if ($Have_warned->{"Digest::SHA"}++) {
967 $CPAN::Frontend->myprint(qq{CPAN: checksum security checks disabled}.
968 qq{because Digest::SHA not installed.\n});
970 $CPAN::Frontend->mywarn(qq{
971 CPAN: checksum security checks disabled because Digest::SHA not installed.
972 Please consider installing the Digest::SHA module.
975 $CPAN::Frontend->mysleep(2);
977 } elsif ($mod eq "Module::Signature"){
978 if (not $CPAN::Config->{check_sigs}) {
979 # they do not want us:-(
980 } elsif (not $Have_warned->{"Module::Signature"}++) {
981 # No point in complaining unless the user can
982 # reasonably install and use it.
983 if (eval { require Crypt::OpenPGP; 1 } ||
985 defined $CPAN::Config->{'gpg'}
987 $CPAN::Config->{'gpg'} =~ /\S/
990 $CPAN::Frontend->mywarn(qq{
991 CPAN: Module::Signature security checks disabled because Module::Signature
992 not installed. Please consider installing the Module::Signature module.
993 You may also need to be able to connect over the Internet to the public
994 keyservers like pgp.mit.edu (port 11371).
997 $CPAN::Frontend->mysleep(2);
1001 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
1006 #-> sub CPAN::instance ;
1008 my($mgr,$class,$id) = @_;
1009 CPAN::Index->reload;
1011 # unsafe meta access, ok?
1012 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
1013 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
1021 #-> sub CPAN::cleanup ;
1023 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
1024 local $SIG{__DIE__} = '';
1029 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
1030 $ineval = 1, last if
1031 $subroutine eq '(eval)';
1033 return if $ineval && !$CPAN::End;
1034 return unless defined $META->{LOCK};
1035 return unless -f $META->{LOCK};
1037 unlink $META->{LOCK};
1039 # Carp::cluck("DEBUGGING");
1040 $CPAN::Frontend->myprint("Lockfile removed.\n");
1043 #-> sub CPAN::savehist
1046 my($histfile,$histsize);
1047 unless ($histfile = $CPAN::Config->{'histfile'}){
1048 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
1051 $histsize = $CPAN::Config->{'histsize'} || 100;
1053 unless ($CPAN::term->can("GetHistory")) {
1054 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
1060 my @h = $CPAN::term->GetHistory;
1061 splice @h, 0, @h-$histsize if @h>$histsize;
1062 my($fh) = FileHandle->new;
1063 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
1064 local $\ = local $, = "\n";
1070 my($self,$what) = @_;
1071 $self->{is_tested}{$what} = 1;
1075 my($self,$what) = @_;
1076 delete $self->{is_tested}{$what};
1081 $self->{is_tested} ||= {};
1082 return unless %{$self->{is_tested}};
1083 my $env = $ENV{PERL5LIB};
1084 $env = $ENV{PERLLIB} unless defined $env;
1086 push @env, $env if defined $env and length $env;
1087 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1088 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1089 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1092 package CPAN::CacheMgr;
1095 #-> sub CPAN::CacheMgr::as_string ;
1097 eval { require Data::Dumper };
1099 return shift->SUPER::as_string;
1101 return Data::Dumper::Dumper(shift);
1105 #-> sub CPAN::CacheMgr::cachesize ;
1110 #-> sub CPAN::CacheMgr::tidyup ;
1113 return unless -d $self->{ID};
1114 while ($self->{DU} > $self->{'MAX'} ) {
1115 my($toremove) = shift @{$self->{FIFO}};
1116 $CPAN::Frontend->myprint(sprintf(
1117 "Deleting from cache".
1118 ": $toremove (%.1f>%.1f MB)\n",
1119 $self->{DU}, $self->{'MAX'})
1121 return if $CPAN::Signal;
1122 $self->force_clean_cache($toremove);
1123 return if $CPAN::Signal;
1127 #-> sub CPAN::CacheMgr::dir ;
1132 #-> sub CPAN::CacheMgr::entries ;
1134 my($self,$dir) = @_;
1135 return unless defined $dir;
1136 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1137 $dir ||= $self->{ID};
1138 my($cwd) = CPAN::anycwd();
1139 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1140 my $dh = DirHandle->new(File::Spec->curdir)
1141 or Carp::croak("Couldn't opendir $dir: $!");
1144 next if $_ eq "." || $_ eq "..";
1146 push @entries, File::Spec->catfile($dir,$_);
1148 push @entries, File::Spec->catdir($dir,$_);
1150 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1153 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1154 sort { -M $b <=> -M $a} @entries;
1157 #-> sub CPAN::CacheMgr::disk_usage ;
1159 my($self,$dir) = @_;
1160 return if exists $self->{SIZE}{$dir};
1161 return if $CPAN::Signal;
1165 unless (chmod 0755, $dir) {
1166 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1167 "permission to change the permission; cannot ".
1168 "estimate disk usage of '$dir'\n");
1169 $CPAN::Frontend->mysleep(5);
1174 $CPAN::Frontend->mywarn("Directory '$dir' has gone. Cannot continue.\n");
1175 $CPAN::Frontend->mysleep(2);
1180 $File::Find::prune++ if $CPAN::Signal;
1182 if ($^O eq 'MacOS') {
1184 my $cat = Mac::Files::FSpGetCatInfo($_);
1185 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1189 unless (chmod 0755, $_) {
1190 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1191 "the permission to change the permission; ".
1192 "can only partially estimate disk usage ".
1194 $CPAN::Frontend->mysleep(5);
1205 return if $CPAN::Signal;
1206 $self->{SIZE}{$dir} = $Du/1024/1024;
1207 push @{$self->{FIFO}}, $dir;
1208 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1209 $self->{DU} += $Du/1024/1024;
1213 #-> sub CPAN::CacheMgr::force_clean_cache ;
1214 sub force_clean_cache {
1215 my($self,$dir) = @_;
1216 return unless -e $dir;
1217 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1219 File::Path::rmtree($dir);
1220 $self->{DU} -= $self->{SIZE}{$dir};
1221 delete $self->{SIZE}{$dir};
1224 #-> sub CPAN::CacheMgr::new ;
1231 ID => $CPAN::Config->{'build_dir'},
1232 MAX => $CPAN::Config->{'build_cache'},
1233 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1236 File::Path::mkpath($self->{ID});
1237 my $dh = DirHandle->new($self->{ID});
1238 bless $self, $class;
1241 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1243 CPAN->debug($debug) if $CPAN::DEBUG;
1247 #-> sub CPAN::CacheMgr::scan_cache ;
1250 return if $self->{SCAN} eq 'never';
1251 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1252 unless $self->{SCAN} eq 'atstart';
1253 $CPAN::Frontend->myprint(
1254 sprintf("Scanning cache %s for sizes\n",
1257 for $e ($self->entries($self->{ID})) {
1258 next if $e eq ".." || $e eq ".";
1259 $self->disk_usage($e);
1260 return if $CPAN::Signal;
1265 package CPAN::Shell;
1268 #-> sub CPAN::Shell::h ;
1270 my($class,$about) = @_;
1271 if (defined $about) {
1272 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1274 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1275 $CPAN::Frontend->myprint(qq{
1276 Display Information $filler (ver $CPAN::VERSION)
1277 command argument description
1278 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1279 i WORD or /REGEXP/ about any of the above
1280 ls AUTHOR or GLOB about files in the author's directory
1281 (with WORD being a module, bundle or author name or a distribution
1282 name of the form AUTHOR/DISTRIBUTION)
1284 Download, Test, Make, Install...
1285 get download clean make clean
1286 make make (implies get) look open subshell in dist directory
1287 test make test (implies make) readme display these README files
1288 install make install (implies test) perldoc display POD documentation
1291 force COMMAND unconditionally do command
1292 notest COMMAND skip testing
1295 h,? display this menu ! perl-code eval a perl command
1296 r report module updates upgrade upgrade all modules
1297 o conf [opt] set and query options q quit the cpan shell
1298 reload cpan load CPAN.pm again reload index load newer indices
1299 autobundle Snapshot recent latest CPAN uploads});
1305 #-> sub CPAN::Shell::a ;
1307 my($self,@arg) = @_;
1308 # authors are always UPPERCASE
1310 $_ = uc $_ unless /=/;
1312 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1315 #-> sub CPAN::Shell::globls ;
1317 my($self,$s,$pragmas) = @_;
1318 # ls is really very different, but we had it once as an ordinary
1319 # command in the Shell (upto rev. 321) and we could not handle
1321 my(@accept,@preexpand);
1322 if ($s =~ /[\*\?\/]/) {
1323 if ($CPAN::META->has_inst("Text::Glob")) {
1324 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1325 my $rau = Text::Glob::glob_to_regex(uc $au);
1326 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1328 push @preexpand, map { $_->id . "/" . $pathglob }
1329 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1331 my $rau = Text::Glob::glob_to_regex(uc $s);
1332 push @preexpand, map { $_->id }
1333 CPAN::Shell->expand_by_method('CPAN::Author',
1338 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1341 push @preexpand, uc $s;
1344 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1345 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1350 my $silent = @accept>1;
1351 my $last_alpha = "";
1353 for my $a (@accept){
1354 my($author,$pathglob);
1355 if ($a =~ m|(.*?)/(.*)|) {
1358 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1360 $a2) or die "No author found for $a2";
1362 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1364 $a) or die "No author found for $a";
1367 my $alpha = substr $author->id, 0, 1;
1369 if ($alpha eq $last_alpha) {
1373 $last_alpha = $alpha;
1375 $CPAN::Frontend->myprint($ad);
1377 for my $pragma (@$pragmas) {
1378 if ($author->can($pragma)) {
1382 push @results, $author->ls($pathglob,$silent); # silent if
1385 for my $pragma (@$pragmas) {
1386 my $meth = "un$pragma";
1387 if ($author->can($meth)) {
1395 #-> sub CPAN::Shell::local_bundles ;
1397 my($self,@which) = @_;
1398 my($incdir,$bdir,$dh);
1399 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1400 my @bbase = "Bundle";
1401 while (my $bbase = shift @bbase) {
1402 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1403 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1404 if ($dh = DirHandle->new($bdir)) { # may fail
1406 for $entry ($dh->read) {
1407 next if $entry =~ /^\./;
1408 next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
1409 if (-d File::Spec->catdir($bdir,$entry)){
1410 push @bbase, "$bbase\::$entry";
1412 next unless $entry =~ s/\.pm(?!\n)\Z//;
1413 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1421 #-> sub CPAN::Shell::b ;
1423 my($self,@which) = @_;
1424 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1425 $self->local_bundles;
1426 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1429 #-> sub CPAN::Shell::d ;
1430 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1432 #-> sub CPAN::Shell::m ;
1433 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1435 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1438 #-> sub CPAN::Shell::i ;
1442 @args = '/./' unless @args;
1444 for my $type (qw/Bundle Distribution Module/) {
1445 push @result, $self->expand($type,@args);
1447 # Authors are always uppercase.
1448 push @result, $self->expand("Author", map { uc $_ } @args);
1450 my $result = @result == 1 ?
1451 $result[0]->as_string :
1453 "No objects found of any type for argument @args\n" :
1455 (map {$_->as_glimpse} @result),
1456 scalar @result, " items found\n",
1458 $CPAN::Frontend->myprint($result);
1461 #-> sub CPAN::Shell::o ;
1463 # CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o
1464 # conf' calls through to CPAN::HandleConfig::edit. 'o conf' should
1465 # have been called 'set' and 'o debug' maybe 'set debug' or 'debug'
1466 # 'o conf XXX' calls ->edit in CPAN/HandleConfig.pm
1468 my($self,$o_type,@o_what) = @_;
1471 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1472 if ($o_type eq 'conf') {
1473 if (!@o_what) { # print all things, "o conf"
1475 $CPAN::Frontend->myprint("\$CPAN::Config options from ");
1477 if (exists $INC{'CPAN/Config.pm'}) {
1478 push @from, $INC{'CPAN/Config.pm'};
1480 if (exists $INC{'CPAN/MyConfig.pm'}) {
1481 push @from, $INC{'CPAN/MyConfig.pm'};
1483 $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
1484 $CPAN::Frontend->myprint(":\n");
1485 for $k (sort keys %CPAN::HandleConfig::can) {
1486 $v = $CPAN::HandleConfig::can{$k};
1487 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
1489 $CPAN::Frontend->myprint("\n");
1490 for $k (sort keys %$CPAN::Config) {
1491 CPAN::HandleConfig->prettyprint($k);
1493 $CPAN::Frontend->myprint("\n");
1494 } elsif (!CPAN::HandleConfig->edit(@o_what)) {
1495 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
1498 } elsif ($o_type eq 'debug') {
1500 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1503 my($what) = shift @o_what;
1504 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1505 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1508 if ( exists $CPAN::DEBUG{$what} ) {
1509 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1510 } elsif ($what =~ /^\d/) {
1511 $CPAN::DEBUG = $what;
1512 } elsif (lc $what eq 'all') {
1514 for (values %CPAN::DEBUG) {
1517 $CPAN::DEBUG = $max;
1520 for (keys %CPAN::DEBUG) {
1521 next unless lc($_) eq lc($what);
1522 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1525 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1530 my $raw = "Valid options for debug are ".
1531 join(", ",sort(keys %CPAN::DEBUG), 'all').
1532 qq{ or a number. Completion works on the options. }.
1533 qq{Case is ignored.};
1535 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1536 $CPAN::Frontend->myprint("\n\n");
1539 $CPAN::Frontend->myprint("Options set for debugging:\n");
1541 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1542 $v = $CPAN::DEBUG{$k};
1543 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1544 if $v & $CPAN::DEBUG;
1547 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1550 $CPAN::Frontend->myprint(qq{
1552 conf set or get configuration variables
1553 debug set or get debugging options
1558 sub paintdots_onreload {
1561 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
1565 # $CPAN::Frontend->myprint(".($subr)");
1566 $CPAN::Frontend->myprint(".");
1573 #-> sub CPAN::Shell::reload ;
1575 my($self,$command,@arg) = @_;
1577 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1578 if ($command =~ /cpan/i) {
1580 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
1584 "CPAN/HandleConfig.pm",
1585 "CPAN/FirstTime.pm",
1590 if ($CPAN::Config->{test_report}) {
1591 push @relo, "CPAN/Reporter.pm";
1593 MFILE: for my $f (@relo) {
1594 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
1595 $self->reload_this($f) or $failed++;
1597 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1598 $failed++ unless $redef;
1600 $CPAN::Frontend->mywarn("\n$failed errors during reload. You better quit ".
1603 } elsif ($command =~ /index/) {
1604 CPAN::Index->force_reload;
1606 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
1607 index re-reads the index files\n});
1613 return 1 unless $INC{$f};
1614 my $pwd = CPAN::anycwd();
1615 CPAN->debug("reloading the whole '$f' from '$INC{$f}' while pwd='$pwd'")
1618 for my $inc (@INC) {
1619 $read = File::Spec->catfile($inc,split /\//, $f);
1626 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
1629 my $fh = FileHandle->new($read) or
1630 $CPAN::Frontend->mydie("Could not open $read: $!");
1634 CPAN->debug(sprintf("evaling [%s...]\n",substr($eval,0,64)))
1644 #-> sub CPAN::Shell::mkmyconfig ;
1646 my($self, $cpanpm, %args) = @_;
1647 require CPAN::FirstTime;
1648 my $home = CPAN::HandleConfig::home;
1649 $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
1650 File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
1651 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
1652 CPAN::HandleConfig::require_myconfig_or_config;
1653 $CPAN::Config ||= {};
1658 keep_source_where => undef,
1661 CPAN::FirstTime::init($cpanpm, %args);
1664 #-> sub CPAN::Shell::_binary_extensions ;
1665 sub _binary_extensions {
1666 my($self) = shift @_;
1667 my(@result,$module,%seen,%need,$headerdone);
1668 for $module ($self->expand('Module','/./')) {
1669 my $file = $module->cpan_file;
1670 next if $file eq "N/A";
1671 next if $file =~ /^Contact Author/;
1672 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
1673 next if $dist->isa_perl;
1674 next unless $module->xs_file;
1676 $CPAN::Frontend->myprint(".");
1677 push @result, $module;
1679 # print join " | ", @result;
1680 $CPAN::Frontend->myprint("\n");
1684 #-> sub CPAN::Shell::recompile ;
1686 my($self) = shift @_;
1687 my($module,@module,$cpan_file,%dist);
1688 @module = $self->_binary_extensions();
1689 for $module (@module){ # we force now and compile later, so we
1691 $cpan_file = $module->cpan_file;
1692 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1694 $dist{$cpan_file}++;
1696 for $cpan_file (sort keys %dist) {
1697 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1698 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1700 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1701 # stop a package from recompiling,
1702 # e.g. IO-1.12 when we have perl5.003_10
1706 #-> sub CPAN::Shell::scripts ;
1708 my($self, $arg) = @_;
1709 $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n");
1711 for my $req (qw( HTML::LinkExtor Sort::Versions List::Util )) {
1712 unless ($CPAN::META->has_inst($req)) {
1713 $CPAN::Frontend->mywarn(" $req not available\n");
1716 my $p = HTML::LinkExtor->new();
1717 my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html";
1718 unless (-f $indexfile) {
1719 $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n");
1721 $p->parse_file($indexfile);
1724 if ($arg =~ s|^/(.+)/$|$1|) {
1725 $qrarg = eval 'qr/$arg/'; # hide construct from 5.004
1727 for my $l ($p->links) {
1728 my $tag = shift @$l;
1729 next unless $tag eq "a";
1731 my $href = $att{href};
1732 next unless $href =~ s|^\.\./authors/id/./../||;
1735 if ($href =~ $qrarg) {
1739 if ($href =~ /\Q$arg\E/) {
1747 # now filter for the latest version if there is more than one of a name
1753 $stems{$stem} ||= [];
1754 push @{$stems{$stem}}, $href;
1756 for (sort keys %stems) {
1758 if (@{$stems{$_}} > 1) {
1759 $highest = List::Util::reduce {
1760 Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b
1763 $highest = $stems{$_}[0];
1765 $CPAN::Frontend->myprint("$highest\n");
1769 #-> sub CPAN::Shell::upgrade ;
1771 my($self) = shift @_;
1772 $self->install($self->r);
1775 #-> sub CPAN::Shell::_u_r_common ;
1777 my($self) = shift @_;
1778 my($what) = shift @_;
1779 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1780 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
1781 $what && $what =~ /^[aru]$/;
1783 @args = '/./' unless @args;
1784 my(@result,$module,%seen,%need,$headerdone,
1785 $version_undefs,$version_zeroes);
1786 $version_undefs = $version_zeroes = 0;
1787 my $sprintf = "%s%-25s%s %9s %9s %s\n";
1788 my @expand = $self->expand('Module',@args);
1789 my $expand = scalar @expand;
1790 if (0) { # Looks like noise to me, was very useful for debugging
1791 # for metadata cache
1792 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
1794 MODULE: for $module (@expand) {
1795 my $file = $module->cpan_file;
1796 next MODULE unless defined $file; # ??
1797 $file =~ s|^./../||;
1798 my($latest) = $module->cpan_version;
1799 my($inst_file) = $module->inst_file;
1801 return if $CPAN::Signal;
1804 $have = $module->inst_version;
1805 } elsif ($what eq "r") {
1806 $have = $module->inst_version;
1808 if ($have eq "undef"){
1810 } elsif ($have == 0){
1813 next MODULE unless CPAN::Version->vgt($latest, $have);
1814 # to be pedantic we should probably say:
1815 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
1816 # to catch the case where CPAN has a version 0 and we have a version undef
1817 } elsif ($what eq "u") {
1823 } elsif ($what eq "r") {
1825 } elsif ($what eq "u") {
1829 return if $CPAN::Signal; # this is sometimes lengthy
1832 push @result, sprintf "%s %s\n", $module->id, $have;
1833 } elsif ($what eq "r") {
1834 push @result, $module->id;
1835 next MODULE if $seen{$file}++;
1836 } elsif ($what eq "u") {
1837 push @result, $module->id;
1838 next MODULE if $seen{$file}++;
1839 next MODULE if $file =~ /^Contact/;
1841 unless ($headerdone++){
1842 $CPAN::Frontend->myprint("\n");
1843 $CPAN::Frontend->myprint(sprintf(
1846 "Package namespace",
1858 $CPAN::META->has_inst("Term::ANSIColor")
1860 $module->description
1862 $color_on = Term::ANSIColor::color("green");
1863 $color_off = Term::ANSIColor::color("reset");
1865 $CPAN::Frontend->myprint(sprintf $sprintf,
1872 $need{$module->id}++;
1876 $CPAN::Frontend->myprint("No modules found for @args\n");
1877 } elsif ($what eq "r") {
1878 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
1882 if ($version_zeroes) {
1883 my $s_has = $version_zeroes > 1 ? "s have" : " has";
1884 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
1885 qq{a version number of 0\n});
1887 if ($version_undefs) {
1888 my $s_has = $version_undefs > 1 ? "s have" : " has";
1889 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
1890 qq{parseable version number\n});
1896 #-> sub CPAN::Shell::r ;
1898 shift->_u_r_common("r",@_);
1901 #-> sub CPAN::Shell::u ;
1903 shift->_u_r_common("u",@_);
1906 #-> sub CPAN::Shell::failed ;
1908 my($self,$only_id,$silent) = @_;
1910 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
1912 NAY: for my $nosayer (
1920 next unless exists $d->{$nosayer};
1922 $d->{$nosayer}->can("failed") ?
1923 $d->{$nosayer}->failed :
1924 $d->{$nosayer} =~ /^NO/
1926 next NAY if $only_id && $only_id != (
1927 $d->{$nosayer}->can("commandid")
1929 $d->{$nosayer}->commandid
1931 $CPAN::CurrentCommandId
1936 next DIST unless $failed;
1940 # " %-45s: %s %s\n",
1943 $d->{$failed}->can("failed") ?
1945 $d->{$failed}->commandid,
1948 $d->{$failed}->text,
1958 my $scope = $only_id ? "command" : "session";
1960 my $print = join "",
1961 map { sprintf " %-45s: %s %s\n", @$_[1,2,3] }
1962 sort { $a->[0] <=> $b->[0] } @failed;
1963 $CPAN::Frontend->myprint("Failed during this $scope:\n$print");
1964 } elsif (!$only_id || !$silent) {
1965 $CPAN::Frontend->myprint("Nothing failed in this $scope\n");
1969 # XXX intentionally undocumented because completely bogus, unportable,
1972 #-> sub CPAN::Shell::status ;
1975 require Devel::Size;
1976 my $ps = FileHandle->new;
1977 open $ps, "/proc/$$/status";
1980 next unless /VmSize:\s+(\d+)/;
1984 $CPAN::Frontend->mywarn(sprintf(
1985 "%-27s %6d\n%-27s %6d\n",
1989 Devel::Size::total_size($CPAN::META)/1024,
1991 for my $k (sort keys %$CPAN::META) {
1992 next unless substr($k,0,4) eq "read";
1993 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
1994 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
1995 warn sprintf " %-25s %6d %6d\n",
1997 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
1998 scalar keys %{$CPAN::META->{$k}{$k2}};
2003 #-> sub CPAN::Shell::autobundle ;
2006 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
2007 my(@bundle) = $self->_u_r_common("a",@_);
2008 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2009 File::Path::mkpath($todir);
2010 unless (-d $todir) {
2011 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
2014 my($y,$m,$d) = (localtime)[5,4,3];
2018 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
2019 my($to) = File::Spec->catfile($todir,"$me.pm");
2021 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
2022 $to = File::Spec->catfile($todir,"$me.pm");
2024 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
2026 "package Bundle::$me;\n\n",
2027 "\$VERSION = '0.01';\n\n",
2031 "Bundle::$me - Snapshot of installation on ",
2032 $Config::Config{'myhostname'},
2035 "\n\n=head1 SYNOPSIS\n\n",
2036 "perl -MCPAN -e 'install Bundle::$me'\n\n",
2037 "=head1 CONTENTS\n\n",
2038 join("\n", @bundle),
2039 "\n\n=head1 CONFIGURATION\n\n",
2041 "\n\n=head1 AUTHOR\n\n",
2042 "This Bundle has been generated automatically ",
2043 "by the autobundle routine in CPAN.pm.\n",
2046 $CPAN::Frontend->myprint("\nWrote bundle file
2050 #-> sub CPAN::Shell::expandany ;
2053 CPAN->debug("s[$s]") if $CPAN::DEBUG;
2054 if ($s =~ m|/|) { # looks like a file
2055 $s = CPAN::Distribution->normalize($s);
2056 return $CPAN::META->instance('CPAN::Distribution',$s);
2057 # Distributions spring into existence, not expand
2058 } elsif ($s =~ m|^Bundle::|) {
2059 $self->local_bundles; # scanning so late for bundles seems
2060 # both attractive and crumpy: always
2061 # current state but easy to forget
2063 return $self->expand('Bundle',$s);
2065 return $self->expand('Module',$s)
2066 if $CPAN::META->exists('CPAN::Module',$s);
2071 #-> sub CPAN::Shell::expand ;
2074 my($type,@args) = @_;
2075 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
2076 my $class = "CPAN::$type";
2077 my $methods = ['id'];
2078 for my $meth (qw(name)) {
2079 next if $] < 5.00303; # no "can"
2080 next unless $class->can($meth);
2081 push @$methods, $meth;
2083 $self->expand_by_method($class,$methods,@args);
2086 sub expand_by_method {
2088 my($class,$methods,@args) = @_;
2091 my($regex,$command);
2092 if ($arg =~ m|^/(.*)/$|) {
2094 } elsif ($arg =~ m/=/) {
2098 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
2100 defined $regex ? $regex : "UNDEFINED",
2101 defined $command ? $command : "UNDEFINED",
2103 if (defined $regex) {
2105 $CPAN::META->all_objects($class)
2108 # BUG, we got an empty object somewhere
2109 require Data::Dumper;
2110 CPAN->debug(sprintf(
2111 "Bug in CPAN: Empty id on obj[%s][%s]",
2113 Data::Dumper::Dumper($obj)
2117 for my $method (@$methods) {
2118 if ($obj->$method() =~ /$regex/i) {
2124 } elsif ($command) {
2125 die "equal sign in command disabled (immature interface), ".
2127 ! \$CPAN::Shell::ADVANCED_QUERY=1
2128 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
2129 that may go away anytime.\n"
2130 unless $ADVANCED_QUERY;
2131 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
2132 my($matchcrit) = $criterion =~ m/^~(.+)/;
2136 $CPAN::META->all_objects($class)
2138 my $lhs = $self->$method() or next; # () for 5.00503
2140 push @m, $self if $lhs =~ m/$matchcrit/;
2142 push @m, $self if $lhs eq $criterion;
2147 if ( $class eq 'CPAN::Bundle' ) {
2148 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
2149 } elsif ($class eq "CPAN::Distribution") {
2150 $xarg = CPAN::Distribution->normalize($arg);
2154 if ($CPAN::META->exists($class,$xarg)) {
2155 $obj = $CPAN::META->instance($class,$xarg);
2156 } elsif ($CPAN::META->exists($class,$arg)) {
2157 $obj = $CPAN::META->instance($class,$arg);
2164 @m = sort {$a->id cmp $b->id} @m;
2165 if ( $CPAN::DEBUG ) {
2166 my $wantarray = wantarray;
2167 my $join_m = join ",", map {$_->id} @m;
2168 $self->debug("wantarray[$wantarray]join_m[$join_m]");
2170 return wantarray ? @m : $m[0];
2173 #-> sub CPAN::Shell::format_result ;
2176 my($type,@args) = @_;
2177 @args = '/./' unless @args;
2178 my(@result) = $self->expand($type,@args);
2179 my $result = @result == 1 ?
2180 $result[0]->as_string :
2182 "No objects of type $type found for argument @args\n" :
2184 (map {$_->as_glimpse} @result),
2185 scalar @result, " items found\n",
2190 #-> sub CPAN::Shell::report_fh ;
2192 my $installation_report_fh;
2193 my $previously_noticed = 0;
2196 return $installation_report_fh if $installation_report_fh;
2197 if ($CPAN::META->has_inst("File::Temp")) {
2198 $installation_report_fh
2200 template => 'cpan_install_XXXX',
2205 unless ( $installation_report_fh ) {
2206 warn("Couldn't open installation report file; " .
2207 "no report file will be generated."
2208 ) unless $previously_noticed++;
2214 # The only reason for this method is currently to have a reliable
2215 # debugging utility that reveals which output is going through which
2216 # channel. No, I don't like the colors ;-)
2218 # to turn colordebugging on, write
2219 # cpan> o conf colorize_output 1
2221 #-> sub CPAN::Shell::print_ornamented ;
2223 my $print_ornamented_have_warned = 0;
2224 sub colorize_output {
2225 my $colorize_output = $CPAN::Config->{colorize_output};
2226 if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) {
2227 unless ($print_ornamented_have_warned++) {
2228 # no myprint/mywarn within myprint/mywarn!
2229 warn "Colorize_output is set to true but Term::ANSIColor is not
2230 installed. To activate colorized output, please install Term::ANSIColor.\n\n";
2232 $colorize_output = 0;
2234 return $colorize_output;
2239 sub print_ornamented {
2240 my($self,$what,$ornament) = @_;
2241 return unless defined $what;
2243 local $| = 1; # Flush immediately
2244 if ( $CPAN::Be_Silent ) {
2245 print {report_fh()} $what;
2248 my $swhat = "$what"; # stringify if it is an object
2249 if ($CPAN::Config->{term_is_latin}){
2252 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
2255 my $longest = 0; # Does list::util work on 5.004?
2256 for $line (split /\n/, $swhat) {
2257 $longest = length($line) if length($line) > $longest;
2259 $longest = 78 if $longest > 78; # yes, arbitrary, who wants it set-able?
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 $demobug = 0; # (=0) works, (=1) has some obscure bugs and
2267 # breaks 30shell.t, (=2) has some obvious
2268 # bugs but passes 30shell.t
2269 if ($demobug == 1) {
2270 my $nl = chomp $swhat ? "\n" : "";
2271 while (length $swhat) {
2274 $swhat =~ s/(.*\n?)//m;
2278 while (length $swhat) {
2279 my $c = substr($swhat,0,1);
2280 $swhat = substr($swhat,1);
2288 # my($nl) = chomp $line ? "\n" : "";
2289 # ->debug verboten within print_ornamented ==> recursion!
2290 # warn("line[$line]ornament[$ornament]sprintf[$sprintf]\n") if $CPAN::DEBUG;
2292 sprintf("%-*s",$longest,$line),
2293 Term::ANSIColor::color("reset"),
2294 $line =~ /\n/ ? "" : $nl;
2296 } elsif ($demobug == 2) {
2297 my $block = join "\n",
2303 Term::ANSIColor::color("reset"),
2306 split /[\r ]*\n/, $swhat;
2311 Term::ANSIColor::color("reset");
2318 # where is myprint/mywarn/Frontend/etc. documented? We need guidelines
2319 # where to use what! I think, we send everything to STDOUT and use
2320 # print for normal/good news and warn for news that need more
2321 # attention. Yes, this is our working contract for now.
2323 my($self,$what) = @_;
2325 $self->print_ornamented($what, $CPAN::Config->{colorize_print}||'bold blue');
2329 my($self,$what) = @_;
2330 $self->myprint($what);
2335 my($self,$what) = @_;
2336 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red');
2339 # only to be used for shell commands
2341 my($self,$what) = @_;
2342 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red');
2344 # If it is the shell, we want that the following die to be silent,
2345 # but if it is not the shell, we would need a 'die $what'. We need
2346 # to take care that only shell commands use mydie. Is this
2352 # sub CPAN::Shell::colorable_makemaker_prompt
2353 sub colorable_makemaker_prompt {
2355 if (CPAN::Shell->colorize_output) {
2356 my $ornament = $CPAN::Config->{colorize_print}||'bold blue';
2357 my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
2360 my $ans = ExtUtils::MakeMaker::prompt($foo,$bar);
2361 if (CPAN::Shell->colorize_output) {
2362 print Term::ANSIColor::color('reset');
2367 # use this only for unrecoverable errors!
2368 sub unrecoverable_error {
2369 my($self,$what) = @_;
2370 my @lines = split /\n/, $what;
2372 for my $l (@lines) {
2373 $longest = length $l if length $l > $longest;
2375 $longest = 62 if $longest > 62;
2376 for my $l (@lines) {
2382 if (length $l < 66) {
2383 $l = pack "A66 A*", $l, "<==";
2387 unshift @lines, "\n";
2388 $self->mydie(join "", @lines);
2392 my($self, $sleep) = @_;
2397 return if -t STDOUT;
2398 my $odef = select STDERR;
2405 #-> sub CPAN::Shell::rematein ;
2406 # RE-adme||MA-ke||TE-st||IN-stall
2409 my($meth,@some) = @_;
2411 while($meth =~ /^(force|notest)$/) {
2412 push @pragma, $meth;
2413 $meth = shift @some or
2414 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
2418 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
2420 # Here is the place to set "test_count" on all involved parties to
2421 # 0. We then can pass this counter on to the involved
2422 # distributions and those can refuse to test if test_count > X. In
2423 # the first stab at it we could use a 1 for "X".
2425 # But when do I reset the distributions to start with 0 again?
2426 # Jost suggested to have a random or cycling interaction ID that
2427 # we pass through. But the ID is something that is just left lying
2428 # around in addition to the counter, so I'd prefer to set the
2429 # counter to 0 now, and repeat at the end of the loop. But what
2430 # about dependencies? They appear later and are not reset, they
2431 # enter the queue but not its copy. How do they get a sensible
2434 # construct the queue
2436 STHING: foreach $s (@some) {
2439 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
2441 } elsif ($s =~ m|^/|) { # looks like a regexp
2442 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
2444 $CPAN::Frontend->mysleep(2);
2446 } elsif ($meth eq "ls") {
2447 $self->globls($s,\@pragma);
2450 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
2451 $obj = CPAN::Shell->expandany($s);
2454 $obj->color_cmd_tmps(0,1);
2455 CPAN::Queue->new($obj->id);
2457 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
2458 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
2459 if ($meth =~ /^(dump|ls)$/) {
2462 $CPAN::Frontend->mywarn(
2464 "Don't be silly, you can't $meth ",
2468 $CPAN::Frontend->mysleep(2);
2472 ->mywarn(qq{Warning: Cannot $meth $s, }.
2473 qq{don\'t know what it is.
2478 to find objects with matching identifiers.
2480 $CPAN::Frontend->mysleep(2);
2484 # queuerunner (please be warned: when I started to change the
2485 # queue to hold objects instead of names, I made one or two
2486 # mistakes and never found which. I reverted back instead)
2487 while ($s = CPAN::Queue->first) {
2490 $obj = $s; # I do not believe, we would survive if this happened
2492 $obj = CPAN::Shell->expandany($s);
2494 for my $pragma (@pragma) {
2497 ($] < 5.00303 || $obj->can($pragma))){
2498 ### compatibility with 5.003
2499 $obj->$pragma($meth); # the pragma "force" in
2500 # "CPAN::Distribution" must know
2501 # what we are intending
2504 if ($]>=5.00303 && $obj->can('called_for')) {
2505 $obj->called_for($s);
2508 qq{pragma[@pragma]meth[$meth]obj[$obj]as_string[$obj->{ID}]}
2512 CPAN::Queue->delete($s);
2514 CPAN->debug("failed");
2518 CPAN::Queue->delete_first($s);
2520 for my $obj (@qcopy) {
2521 $obj->color_cmd_tmps(0,0);
2522 delete $obj->{incommandcolor};
2526 #-> sub CPAN::Shell::recent ;
2530 CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
2535 # set up the dispatching methods
2537 for my $command (qw(
2552 *$command = sub { shift->rematein($command, @_); };
2556 package CPAN::LWP::UserAgent;
2560 return if $SETUPDONE;
2561 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2562 require LWP::UserAgent;
2563 @ISA = qw(Exporter LWP::UserAgent);
2566 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
2570 sub get_basic_credentials {
2571 my($self, $realm, $uri, $proxy) = @_;
2572 if ($USER && $PASSWD) {
2573 return ($USER, $PASSWD);
2576 ($USER,$PASSWD) = $self->get_proxy_credentials();
2578 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
2580 return($USER,$PASSWD);
2583 sub get_proxy_credentials {
2585 my ($user, $password);
2586 if ( defined $CPAN::Config->{proxy_user} &&
2587 defined $CPAN::Config->{proxy_pass}) {
2588 $user = $CPAN::Config->{proxy_user};
2589 $password = $CPAN::Config->{proxy_pass};
2590 return ($user, $password);
2592 my $username_prompt = "\nProxy authentication needed!
2593 (Note: to permanently configure username and password run
2594 o conf proxy_user your_username
2595 o conf proxy_pass your_password
2597 ($user, $password) =
2598 _get_username_and_password_from_user($username_prompt);
2599 return ($user,$password);
2602 sub get_non_proxy_credentials {
2604 my ($user,$password);
2605 if ( defined $CPAN::Config->{username} &&
2606 defined $CPAN::Config->{password}) {
2607 $user = $CPAN::Config->{username};
2608 $password = $CPAN::Config->{password};
2609 return ($user, $password);
2611 my $username_prompt = "\nAuthentication needed!
2612 (Note: to permanently configure username and password run
2613 o conf username your_username
2614 o conf password your_password
2617 ($user, $password) =
2618 _get_username_and_password_from_user($username_prompt);
2619 return ($user,$password);
2622 sub _get_username_and_password_from_user {
2624 my $username_message = shift;
2625 my ($username,$password);
2627 ExtUtils::MakeMaker->import(qw(prompt));
2628 $username = prompt($username_message);
2629 if ($CPAN::META->has_inst("Term::ReadKey")) {
2630 Term::ReadKey::ReadMode("noecho");
2633 $CPAN::Frontend->mywarn(
2634 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
2637 $password = prompt("Password:");
2639 if ($CPAN::META->has_inst("Term::ReadKey")) {
2640 Term::ReadKey::ReadMode("restore");
2642 $CPAN::Frontend->myprint("\n\n");
2643 return ($username,$password);
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.
2661 # mirror(): Its purpose is to deal with proxy authentication. When we
2662 # call SUPER::mirror, we relly call the mirror method in
2663 # LWP::UserAgent. LWP::UserAgent will then call
2664 # $self->get_basic_credentials or some equivalent and this will be
2665 # $self->dispatched to our own get_basic_credentials method.
2667 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2669 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2670 # although we have gone through our get_basic_credentials, the proxy
2671 # server refuses to connect. This could be a case where the username or
2672 # password has changed in the meantime, so I'm trying once again without
2673 # $USER and $PASSWD to give the get_basic_credentials routine another
2674 # chance to set $USER and $PASSWD.
2677 my($self,$url,$aslocal) = @_;
2678 my $result = $self->SUPER::mirror($url,$aslocal);
2679 if ($result->code == 407) {
2682 $result = $self->SUPER::mirror($url,$aslocal);
2690 #-> sub CPAN::FTP::ftp_get ;
2692 my($class,$host,$dir,$file,$target) = @_;
2694 qq[Going to fetch file [$file] from dir [$dir]
2695 on host [$host] as local [$target]\n]
2697 my $ftp = Net::FTP->new($host);
2699 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
2702 return 0 unless defined $ftp;
2703 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
2704 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
2705 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
2706 my $msg = $ftp->message;
2707 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
2710 unless ( $ftp->cwd($dir) ){
2711 my $msg = $ftp->message;
2712 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
2716 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
2717 unless ( $ftp->get($file,$target) ){
2718 my $msg = $ftp->message;
2719 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
2722 $ftp->quit; # it's ok if this fails
2726 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
2728 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
2729 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
2731 # > *** 1562,1567 ****
2732 # > --- 1562,1580 ----
2733 # > return 1 if substr($url,0,4) eq "file";
2734 # > return 1 unless $url =~ m|://([^/]+)|;
2736 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
2738 # > + $proxy =~ m|://([^/:]+)|;
2740 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
2741 # > + if ($noproxy) {
2742 # > + if ($host !~ /$noproxy$/) {
2743 # > + $host = $proxy;
2746 # > + $host = $proxy;
2749 # > require Net::Ping;
2750 # > return 1 unless $Net::Ping::VERSION >= 2;
2754 #-> sub CPAN::FTP::localize ;
2756 my($self,$file,$aslocal,$force) = @_;
2758 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
2759 unless defined $aslocal;
2760 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
2763 if ($^O eq 'MacOS') {
2764 # Comment by AK on 2000-09-03: Uniq short filenames would be
2765 # available in CHECKSUMS file
2766 my($name, $path) = File::Basename::fileparse($aslocal, '');
2767 if (length($name) > 31) {
2778 my $size = 31 - length($suf);
2779 while (length($name) > $size) {
2783 $aslocal = File::Spec->catfile($path, $name);
2787 if (-f $aslocal && -r _ && !($force & 1)){
2789 if ($size = -s $aslocal) {
2790 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
2793 # empty file from a previous unsuccessful attempt to download it
2795 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
2796 "could not remove.");
2801 rename $aslocal, "$aslocal.bak";
2805 my($aslocal_dir) = File::Basename::dirname($aslocal);
2806 File::Path::mkpath($aslocal_dir);
2807 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
2808 qq{directory "$aslocal_dir".
2809 I\'ll continue, but if you encounter problems, they may be due
2810 to insufficient permissions.\n}) unless -w $aslocal_dir;
2812 # Inheritance is not easier to manage than a few if/else branches
2813 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2815 CPAN::LWP::UserAgent->config;
2816 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
2818 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
2822 $Ua->proxy('ftp', $var)
2823 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
2824 $Ua->proxy('http', $var)
2825 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
2828 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
2830 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
2831 # > use ones that require basic autorization.
2833 # > Example of when I use it manually in my own stuff:
2835 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
2836 # > $req->proxy_authorization_basic("username","password");
2837 # > $res = $ua->request($req);
2841 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
2845 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
2846 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
2849 # Try the list of urls for each single object. We keep a record
2850 # where we did get a file from
2851 my(@reordered,$last);
2852 $CPAN::Config->{urllist} ||= [];
2853 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
2854 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
2855 $CPAN::Config->{urllist} = [];
2857 $last = $#{$CPAN::Config->{urllist}};
2858 if ($force & 2) { # local cpans probably out of date, don't reorder
2859 @reordered = (0..$last);
2863 (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
2865 (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
2867 defined($ThesiteURL)
2869 ($CPAN::Config->{urllist}[$b] eq $ThesiteURL)
2871 ($CPAN::Config->{urllist}[$a] eq $ThesiteURL)
2876 $self->debug("Themethod[$Themethod]") if $CPAN::DEBUG;
2878 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
2880 @levels = qw/easy hard hardest/;
2882 @levels = qw/easy/ if $^O eq 'MacOS';
2884 local $ENV{FTP_PASSIVE} =
2885 exists $CPAN::Config->{ftp_passive} ?
2886 $CPAN::Config->{ftp_passive} : 1;
2887 for $levelno (0..$#levels) {
2888 my $level = $levels[$levelno];
2889 my $method = "host$level";
2890 my @host_seq = $level eq "easy" ?
2891 @reordered : 0..$last; # reordered has CDROM up front
2892 my @urllist = map { $CPAN::Config->{urllist}[$_] } @host_seq;
2893 for my $u (@urllist) {
2894 if ($u->can("text")) {
2895 $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
2897 $u .= "/" unless substr($u,-1) eq "/";
2898 $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
2901 for my $u (@CPAN::Defaultsites) {
2902 push @urllist, $u unless grep { $_ eq $u } @urllist;
2904 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
2905 my $ret = $self->$method(\@urllist,$file,$aslocal);
2907 $Themethod = $level;
2909 # utime $now, $now, $aslocal; # too bad, if we do that, we
2910 # might alter a local mirror
2911 $self->debug("level[$level]") if $CPAN::DEBUG;
2915 last if $CPAN::Signal; # need to cleanup
2918 unless ($CPAN::Signal) {
2921 if (@{$CPAN::Config->{urllist}}) {
2923 qq{Please check, if the URLs I found in your configuration file \(}.
2924 join(", ", @{$CPAN::Config->{urllist}}).
2927 push @mess, qq{Your urllist is empty!};
2929 push @mess, qq{The urllist can be edited.},
2930 qq{E.g. with 'o conf urllist push ftp://myurl/'};
2931 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
2932 $CPAN::Frontend->mywarn("Could not fetch $file\n");
2933 $CPAN::Frontend->mysleep(2);
2936 rename "$aslocal.bak", $aslocal;
2937 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
2938 $self->ls($aslocal));
2944 # package CPAN::FTP;
2946 my($self,$host_seq,$file,$aslocal) = @_;
2948 HOSTEASY: for $ro_url (@$host_seq) {
2949 my $url .= "$ro_url$file";
2950 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
2951 if ($url =~ /^file:/) {
2953 if ($CPAN::META->has_inst('URI::URL')) {
2954 my $u = URI::URL->new($url);
2956 } else { # works only on Unix, is poorly constructed, but
2957 # hopefully better than nothing.
2958 # RFC 1738 says fileurl BNF is
2959 # fileurl = "file://" [ host | "localhost" ] "/" fpath
2960 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
2962 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
2963 $l =~ s|^file:||; # assume they
2967 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
2969 $self->debug("local file[$l]") if $CPAN::DEBUG;
2970 if ( -f $l && -r _) {
2971 $ThesiteURL = $ro_url;
2974 if ($l =~ /(.+)\.gz$/) {
2976 if ( -f $ungz && -r _) {
2977 $ThesiteURL = $ro_url;
2981 # Maybe mirror has compressed it?
2983 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
2984 CPAN::Tarzip->new("$l.gz")->gunzip($aslocal);
2986 $ThesiteURL = $ro_url;
2991 if ($CPAN::META->has_usable('LWP')) {
2992 $CPAN::Frontend->myprint("Fetching with LWP:
2996 CPAN::LWP::UserAgent->config;
2997 eval { $Ua = CPAN::LWP::UserAgent->new; };
2999 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
3002 my $res = $Ua->mirror($url, $aslocal);
3003 if ($res->is_success) {
3004 $ThesiteURL = $ro_url;
3006 utime $now, $now, $aslocal; # download time is more
3007 # important than upload
3010 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3011 my $gzurl = "$url.gz";
3012 $CPAN::Frontend->myprint("Fetching with LWP:
3015 $res = $Ua->mirror($gzurl, "$aslocal.gz");
3016 if ($res->is_success &&
3017 CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)
3019 $ThesiteURL = $ro_url;
3023 $CPAN::Frontend->myprint(sprintf(
3024 "LWP failed with code[%s] message[%s]\n",
3028 # Alan Burlison informed me that in firewall environments
3029 # Net::FTP can still succeed where LWP fails. So we do not
3030 # skip Net::FTP anymore when LWP is available.
3033 $ro_url->can("text")
3035 $ro_url->{FROM} eq "USER"
3037 my $ret = $self->hosthard([$ro_url],$file,$aslocal);
3038 return $ret if $ret;
3040 $CPAN::Frontend->mywarn(" LWP not available\n");
3042 return if $CPAN::Signal;
3043 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3044 # that's the nice and easy way thanks to Graham
3045 my($host,$dir,$getfile) = ($1,$2,$3);
3046 if ($CPAN::META->has_usable('Net::FTP')) {
3048 $CPAN::Frontend->myprint("Fetching with Net::FTP:
3051 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
3052 "aslocal[$aslocal]") if $CPAN::DEBUG;
3053 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
3054 $ThesiteURL = $ro_url;
3057 if ($aslocal !~ /\.gz(?!\n)\Z/) {
3058 my $gz = "$aslocal.gz";
3059 $CPAN::Frontend->myprint("Fetching with Net::FTP
3062 if (CPAN::FTP->ftp_get($host,
3066 CPAN::Tarzip->new($gz)->gunzip($aslocal)
3068 $ThesiteURL = $ro_url;
3075 return if $CPAN::Signal;
3079 # package CPAN::FTP;
3081 my($self,$host_seq,$file,$aslocal) = @_;
3083 # Came back if Net::FTP couldn't establish connection (or
3084 # failed otherwise) Maybe they are behind a firewall, but they
3085 # gave us a socksified (or other) ftp program...
3088 my($devnull) = $CPAN::Config->{devnull} || "";
3090 my($aslocal_dir) = File::Basename::dirname($aslocal);
3091 File::Path::mkpath($aslocal_dir);
3092 HOSTHARD: for $ro_url (@$host_seq) {
3093 my $url = "$ro_url$file";
3094 my($proto,$host,$dir,$getfile);
3096 # Courtesy Mark Conty mark_conty@cargill.com change from
3097 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3099 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
3100 # proto not yet used
3101 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
3103 next HOSTHARD; # who said, we could ftp anything except ftp?
3105 next HOSTHARD if $proto eq "file"; # file URLs would have had
3106 # success above. Likely a bogus URL
3108 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
3110 # Try the most capable first and leave ncftp* for last as it only
3112 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
3113 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
3114 next unless defined $funkyftp;
3115 next if $funkyftp =~ /^\s*$/;
3117 my($asl_ungz, $asl_gz);
3118 ($asl_ungz = $aslocal) =~ s/\.gz//;
3119 $asl_gz = "$asl_ungz.gz";
3121 my($src_switch) = "";
3123 my($stdout_redir) = " > $asl_ungz";
3125 $src_switch = " -source";
3126 } elsif ($f eq "ncftp"){
3127 $src_switch = " -c";
3128 } elsif ($f eq "wget"){
3129 $src_switch = " -O $asl_ungz";
3131 } elsif ($f eq 'curl'){
3132 $src_switch = ' -L -f -s -S --netrc-optional';
3135 if ($f eq "ncftpget"){
3136 $chdir = "cd $aslocal_dir && ";
3139 $CPAN::Frontend->myprint(
3141 Trying with "$funkyftp$src_switch" to get
3145 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
3146 $self->debug("system[$system]") if $CPAN::DEBUG;
3147 my($wstatus) = system($system);
3149 # lynx returns 0 when it fails somewhere
3151 my $content = do { local *FH; open FH, $asl_ungz or die; local $/; <FH> };
3152 if ($content =~ /^<.*<title>[45]/si) {
3153 $CPAN::Frontend->mywarn(qq{
3154 No success, the file that lynx has has downloaded looks like an error message:
3157 $CPAN::Frontend->mysleep(1);
3161 $CPAN::Frontend->myprint(qq{
3162 No success, the file that lynx has has downloaded is an empty file.
3167 if ($wstatus == 0) {
3170 } elsif ($asl_ungz ne $aslocal) {
3171 # test gzip integrity
3172 if (CPAN::Tarzip->new($asl_ungz)->gtest) {
3173 # e.g. foo.tar is gzipped --> foo.tar.gz
3174 rename $asl_ungz, $aslocal;
3176 CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz);
3179 $ThesiteURL = $ro_url;
3181 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3183 -f $asl_ungz && -s _ == 0;
3184 my $gz = "$aslocal.gz";
3185 my $gzurl = "$url.gz";
3186 $CPAN::Frontend->myprint(
3188 Trying with "$funkyftp$src_switch" to get
3191 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
3192 $self->debug("system[$system]") if $CPAN::DEBUG;
3194 if (($wstatus = system($system)) == 0
3198 # test gzip integrity
3199 my $ct = CPAN::Tarzip->new($asl_gz);
3201 $ct->gunzip($aslocal);
3203 # somebody uncompressed file for us?
3204 rename $asl_ungz, $aslocal;
3206 $ThesiteURL = $ro_url;
3209 unlink $asl_gz if -f $asl_gz;
3212 my $estatus = $wstatus >> 8;
3213 my $size = -f $aslocal ?
3214 ", left\n$aslocal with size ".-s _ :
3215 "\nWarning: expected file [$aslocal] doesn't exist";
3216 $CPAN::Frontend->myprint(qq{
3217 System call "$system"
3218 returned status $estatus (wstat $wstatus)$size
3221 return if $CPAN::Signal;
3222 } # transfer programs
3226 # package CPAN::FTP;
3228 my($self,$host_seq,$file,$aslocal) = @_;
3231 my($aslocal_dir) = File::Basename::dirname($aslocal);
3232 File::Path::mkpath($aslocal_dir);
3233 my $ftpbin = $CPAN::Config->{ftp};
3234 unless (length $ftpbin && MM->maybe_command($ftpbin)) {
3235 $CPAN::Frontend->myprint("No external ftp command available\n\n");
3238 $CPAN::Frontend->mywarn(qq{
3239 As a last ressort we now switch to the external ftp command '$ftpbin'
3242 Doing so often leads to problems that are hard to diagnose.
3244 If you're victim of such problems, please consider unsetting the ftp
3245 config variable with
3251 $CPAN::Frontend->mysleep(2);
3252 HOSTHARDEST: for $ro_url (@$host_seq) {
3253 my $url = "$ro_url$file";
3254 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
3255 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3258 my($host,$dir,$getfile) = ($1,$2,$3);
3260 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
3261 $ctime,$blksize,$blocks) = stat($aslocal);
3262 $timestamp = $mtime ||= 0;
3263 my($netrc) = CPAN::FTP::netrc->new;
3264 my($netrcfile) = $netrc->netrc;
3265 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
3266 my $targetfile = File::Basename::basename($aslocal);
3272 map("cd $_", split /\//, $dir), # RFC 1738
3274 "get $getfile $targetfile",
3278 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
3279 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
3280 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
3282 $netrc->contains($host))) if $CPAN::DEBUG;
3283 if ($netrc->protected) {
3284 my $dialog = join "", map { " $_\n" } @dialog;
3286 if ($netrc->contains($host)) {
3287 $netrc_explain = "Relying that your .netrc entry for '$host' ".
3288 "manages the login";
3290 $netrc_explain = "Relying that your default .netrc entry ".
3291 "manages the login";
3293 $CPAN::Frontend->myprint(qq{
3294 Trying with external ftp to get
3297 Going to send the dialog
3301 $self->talk_ftp("$ftpbin$verbose $host",
3303 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3304 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3306 if ($mtime > $timestamp) {
3307 $CPAN::Frontend->myprint("GOT $aslocal\n");
3308 $ThesiteURL = $ro_url;
3311 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
3313 return if $CPAN::Signal;
3315 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
3316 qq{correctly protected.\n});
3319 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
3320 nor does it have a default entry\n");
3323 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
3324 # then and login manually to host, using e-mail as
3326 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
3330 "user anonymous $Config::Config{'cf_email'}"
3332 my $dialog = join "", map { " $_\n" } @dialog;
3333 $CPAN::Frontend->myprint(qq{
3334 Trying with external ftp to get
3336 Going to send the dialog
3340 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
3341 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3342 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3344 if ($mtime > $timestamp) {
3345 $CPAN::Frontend->myprint("GOT $aslocal\n");
3346 $ThesiteURL = $ro_url;
3349 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
3351 return if $CPAN::Signal;
3352 $CPAN::Frontend->mywarn("Can't access URL $url.\n\n");
3353 $CPAN::Frontend->mysleep(2);
3357 # package CPAN::FTP;
3359 my($self,$command,@dialog) = @_;
3360 my $fh = FileHandle->new;
3361 $fh->open("|$command") or die "Couldn't open ftp: $!";
3362 foreach (@dialog) { $fh->print("$_\n") }
3363 $fh->close; # Wait for process to complete
3365 my $estatus = $wstatus >> 8;
3366 $CPAN::Frontend->myprint(qq{
3367 Subprocess "|$command"
3368 returned status $estatus (wstat $wstatus)
3372 # find2perl needs modularization, too, all the following is stolen
3376 my($self,$name) = @_;
3377 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
3378 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
3380 my($perms,%user,%group);
3384 $blocks = int(($blocks + 1) / 2);
3387 $blocks = int(($sizemm + 1023) / 1024);
3390 if (-f _) { $perms = '-'; }
3391 elsif (-d _) { $perms = 'd'; }
3392 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
3393 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
3394 elsif (-p _) { $perms = 'p'; }
3395 elsif (-S _) { $perms = 's'; }
3396 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
3398 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
3399 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
3400 my $tmpmode = $mode;
3401 my $tmp = $rwx[$tmpmode & 7];
3403 $tmp = $rwx[$tmpmode & 7] . $tmp;
3405 $tmp = $rwx[$tmpmode & 7] . $tmp;
3406 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
3407 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
3408 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
3411 my $user = $user{$uid} || $uid; # too lazy to implement lookup
3412 my $group = $group{$gid} || $gid;
3414 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
3416 my($moname) = $moname[$mon];
3417 if (-M _ > 365.25 / 2) {
3418 $timeyear = $year + 1900;
3421 $timeyear = sprintf("%02d:%02d", $hour, $min);
3424 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
3438 package CPAN::FTP::netrc;
3441 # package CPAN::FTP::netrc;
3444 my $home = CPAN::HandleConfig::home;
3445 my $file = File::Spec->catfile($home,".netrc");
3447 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3448 $atime,$mtime,$ctime,$blksize,$blocks)
3453 my($fh,@machines,$hasdefault);
3455 $fh = FileHandle->new or die "Could not create a filehandle";
3457 if($fh->open($file)){
3458 $protected = ($mode & 077) == 0;
3460 NETRC: while (<$fh>) {
3461 my(@tokens) = split " ", $_;
3462 TOKEN: while (@tokens) {
3463 my($t) = shift @tokens;
3464 if ($t eq "default"){
3468 last TOKEN if $t eq "macdef";
3469 if ($t eq "machine") {
3470 push @machines, shift @tokens;
3475 $file = $hasdefault = $protected = "";
3479 'mach' => [@machines],
3481 'hasdefault' => $hasdefault,
3482 'protected' => $protected,
3486 # CPAN::FTP::netrc::hasdefault;
3487 sub hasdefault { shift->{'hasdefault'} }
3488 sub netrc { shift->{'netrc'} }
3489 sub protected { shift->{'protected'} }
3491 my($self,$mach) = @_;
3492 for ( @{$self->{'mach'}} ) {
3493 return 1 if $_ eq $mach;
3498 package CPAN::Complete;
3502 my($text, $line, $start, $end) = @_;
3503 my(@perlret) = cpl($text, $line, $start);
3504 # find longest common match. Can anybody show me how to peruse
3505 # T::R::Gnu to have this done automatically? Seems expensive.
3506 return () unless @perlret;
3507 my($newtext) = $text;
3508 for (my $i = length($text)+1;;$i++) {
3509 last unless length($perlret[0]) && length($perlret[0]) >= $i;
3510 my $try = substr($perlret[0],0,$i);
3511 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
3512 # warn "try[$try]tries[@tries]";
3513 if (@tries == @perlret) {
3519 ($newtext,@perlret);
3522 #-> sub CPAN::Complete::cpl ;
3524 my($word,$line,$pos) = @_;
3528 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3530 if ($line =~ s/^(force\s*)//) {
3535 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
3536 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
3538 } elsif ($line =~ /^(a|ls)\s/) {
3539 @return = cplx('CPAN::Author',uc($word));
3540 } elsif ($line =~ /^b\s/) {
3541 CPAN::Shell->local_bundles;
3542 @return = cplx('CPAN::Bundle',$word);
3543 } elsif ($line =~ /^d\s/) {
3544 @return = cplx('CPAN::Distribution',$word);
3545 } elsif ($line =~ m/^(
3546 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
3548 if ($word =~ /^Bundle::/) {
3549 CPAN::Shell->local_bundles;
3551 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3552 } elsif ($line =~ /^i\s/) {
3553 @return = cpl_any($word);
3554 } elsif ($line =~ /^reload\s/) {
3555 @return = cpl_reload($word,$line,$pos);
3556 } elsif ($line =~ /^o\s/) {
3557 @return = cpl_option($word,$line,$pos);
3558 } elsif ($line =~ m/^\S+\s/ ) {
3559 # fallback for future commands and what we have forgotten above
3560 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3567 #-> sub CPAN::Complete::cplx ;
3569 my($class, $word) = @_;
3570 # I believed for many years that this was sorted, today I
3571 # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
3572 # make it sorted again. Maybe sort was dropped when GNU-readline
3573 # support came in? The RCS file is difficult to read on that:-(
3574 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
3577 #-> sub CPAN::Complete::cpl_any ;
3581 cplx('CPAN::Author',$word),
3582 cplx('CPAN::Bundle',$word),
3583 cplx('CPAN::Distribution',$word),
3584 cplx('CPAN::Module',$word),
3588 #-> sub CPAN::Complete::cpl_reload ;
3590 my($word,$line,$pos) = @_;
3592 my(@words) = split " ", $line;
3593 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3594 my(@ok) = qw(cpan index);
3595 return @ok if @words == 1;
3596 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
3599 #-> sub CPAN::Complete::cpl_option ;
3601 my($word,$line,$pos) = @_;
3603 my(@words) = split " ", $line;
3604 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3605 my(@ok) = qw(conf debug);
3606 return @ok if @words == 1;
3607 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
3609 } elsif ($words[1] eq 'index') {
3611 } elsif ($words[1] eq 'conf') {
3612 return CPAN::HandleConfig::cpl(@_);
3613 } elsif ($words[1] eq 'debug') {
3614 return sort grep /^\Q$word\E/i,
3615 sort keys %CPAN::DEBUG, 'all';
3619 package CPAN::Index;
3622 #-> sub CPAN::Index::force_reload ;
3625 $CPAN::Index::LAST_TIME = 0;
3629 #-> sub CPAN::Index::reload ;
3631 my($cl,$force) = @_;
3634 # XXX check if a newer one is available. (We currently read it
3635 # from time to time)
3636 for ($CPAN::Config->{index_expire}) {
3637 $_ = 0.001 unless $_ && $_ > 0.001;
3639 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
3640 # debug here when CPAN doesn't seem to read the Metadata
3642 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
3644 unless ($CPAN::META->{PROTOCOL}) {
3645 $cl->read_metadata_cache;
3646 $CPAN::META->{PROTOCOL} ||= "1.0";
3648 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
3649 # warn "Setting last_time to 0";
3650 $LAST_TIME = 0; # No warning necessary
3652 return if $LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
3655 # IFF we are developing, it helps to wipe out the memory
3656 # between reloads, otherwise it is not what a user expects.
3657 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
3658 $CPAN::META = CPAN->new;
3662 local $LAST_TIME = $time;
3663 local $CPAN::META->{PROTOCOL} = PROTOCOL;
3665 my $needshort = $^O eq "dos";
3667 $cl->rd_authindex($cl
3669 "authors/01mailrc.txt.gz",
3671 File::Spec->catfile('authors', '01mailrc.gz') :
3672 File::Spec->catfile('authors', '01mailrc.txt.gz'),
3675 $debug = "timing reading 01[".($t2 - $time)."]";
3677 return if $CPAN::Signal; # this is sometimes lengthy
3678 $cl->rd_modpacks($cl
3680 "modules/02packages.details.txt.gz",
3682 File::Spec->catfile('modules', '02packag.gz') :
3683 File::Spec->catfile('modules', '02packages.details.txt.gz'),
3686 $debug .= "02[".($t2 - $time)."]";
3688 return if $CPAN::Signal; # this is sometimes lengthy
3691 "modules/03modlist.data.gz",
3693 File::Spec->catfile('modules', '03mlist.gz') :
3694 File::Spec->catfile('modules', '03modlist.data.gz'),
3696 $cl->write_metadata_cache;
3698 $debug .= "03[".($t2 - $time)."]";
3700 CPAN->debug($debug) if $CPAN::DEBUG;
3703 $CPAN::META->{PROTOCOL} = PROTOCOL;
3706 #-> sub CPAN::Index::reload_x ;
3708 my($cl,$wanted,$localname,$force) = @_;
3709 $force |= 2; # means we're dealing with an index here
3710 CPAN::HandleConfig->load; # we should guarantee loading wherever we rely
3712 $localname ||= $wanted;
3713 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
3717 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
3720 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
3721 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
3722 qq{day$s. I\'ll use that.});
3725 $force |= 1; # means we're quite serious about it.
3727 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
3730 #-> sub CPAN::Index::rd_authindex ;
3732 my($cl, $index_target) = @_;
3734 return unless defined $index_target;
3735 $CPAN::Frontend->myprint("Going to read $index_target\n");
3737 tie *FH, 'CPAN::Tarzip', $index_target;
3740 push @lines, split /\012/ while <FH>;
3742 my($userid,$fullname,$email) =
3743 m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
3744 next unless $userid && $fullname && $email;
3746 # instantiate an author object
3747 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
3748 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
3749 return if $CPAN::Signal;
3754 my($self,$dist) = @_;
3755 $dist = $self->{'id'} unless defined $dist;
3756 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
3760 #-> sub CPAN::Index::rd_modpacks ;
3762 my($self, $index_target) = @_;
3764 return unless defined $index_target;
3765 $CPAN::Frontend->myprint("Going to read $index_target\n");
3766 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3769 while ($_ = $fh->READLINE) {
3771 my @ls = map {"$_\n"} split /\n/, $_;
3772 unshift @ls, "\n" x length($1) if /^(\n+)/;
3776 my($line_count,$last_updated);
3778 my $shift = shift(@lines);
3779 last if $shift =~ /^\s*$/;
3780 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
3781 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
3783 if (not defined $line_count) {
3785 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
3786 Please check the validity of the index file by comparing it to more
3787 than one CPAN mirror. I'll continue but problems seem likely to
3791 $CPAN::Frontend->mysleep(5);
3792 } elsif ($line_count != scalar @lines) {
3794 $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
3795 contains a Line-Count header of %d but I see %d lines there. Please
3796 check the validity of the index file by comparing it to more than one
3797 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
3798 $index_target, $line_count, scalar(@lines));
3801 if (not defined $last_updated) {
3803 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
3804 Please check the validity of the index file by comparing it to more
3805 than one CPAN mirror. I'll continue but problems seem likely to
3809 $CPAN::Frontend->mysleep(5);
3813 ->myprint(sprintf qq{ Database was generated on %s\n},
3815 $DATE_OF_02 = $last_updated;
3818 if ($CPAN::META->has_inst('HTTP::Date')) {
3820 $age -= HTTP::Date::str2time($last_updated);
3822 $CPAN::Frontend->mywarn(" HTTP::Date not available\n");
3823 require Time::Local;
3824 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
3825 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
3826 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
3833 qq{Warning: This index file is %d days old.
3834 Please check the host you chose as your CPAN mirror for staleness.
3835 I'll continue but problems seem likely to happen.\a\n},
3838 } elsif ($age < -1) {
3842 qq{Warning: Your system date is %d days behind this index file!
3844 Timestamp index file: %s
3845 Please fix your system time, problems with the make command expected.\n},
3855 # A necessity since we have metadata_cache: delete what isn't
3857 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
3858 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
3862 # before 1.56 we split into 3 and discarded the rest. From
3863 # 1.57 we assign remaining text to $comment thus allowing to
3864 # influence isa_perl
3865 my($mod,$version,$dist,$comment) = split " ", $_, 4;
3866 my($bundle,$id,$userid);
3868 if ($mod eq 'CPAN' &&
3870 CPAN::Queue->exists('Bundle::CPAN') ||
3871 CPAN::Queue->exists('CPAN')
3875 if ($version > $CPAN::VERSION){
3876 $CPAN::Frontend->mywarn(qq{
3877 New CPAN.pm version (v$version) available.
3878 [Currently running version is v$CPAN::VERSION]
3879 You might want to try
3882 to both upgrade CPAN.pm and run the new version without leaving
3883 the current session.
3886 $CPAN::Frontend->mysleep(2);
3887 $CPAN::Frontend->myprint(qq{\n});
3889 last if $CPAN::Signal;
3890 } elsif ($mod =~ /^Bundle::(.*)/) {
3895 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
3896 # Let's make it a module too, because bundles have so much
3897 # in common with modules.
3899 # Changed in 1.57_63: seems like memory bloat now without
3900 # any value, so commented out
3902 # $CPAN::META->instance('CPAN::Module',$mod);
3906 # instantiate a module object
3907 $id = $CPAN::META->instance('CPAN::Module',$mod);
3911 # Although CPAN prohibits same name with different version the
3912 # indexer may have changed the version for the same distro
3913 # since the last time ("Force Reindexing" feature)
3914 if ($id->cpan_file ne $dist
3916 $id->cpan_version ne $version
3918 $userid = $id->userid || $self->userid($dist);
3920 'CPAN_USERID' => $userid,
3921 'CPAN_VERSION' => $version,
3922 'CPAN_FILE' => $dist,
3926 # instantiate a distribution object
3927 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
3928 # we do not need CONTAINSMODS unless we do something with
3929 # this dist, so we better produce it on demand.
3931 ## my $obj = $CPAN::META->instance(
3932 ## 'CPAN::Distribution' => $dist
3934 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
3936 $CPAN::META->instance(
3937 'CPAN::Distribution' => $dist
3939 'CPAN_USERID' => $userid,
3940 'CPAN_COMMENT' => $comment,
3944 for my $name ($mod,$dist) {
3945 CPAN->debug("exists name[$name]") if $CPAN::DEBUG;
3946 $exists{$name} = undef;
3949 return if $CPAN::Signal;
3953 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
3954 for my $o ($CPAN::META->all_objects($class)) {
3955 next if exists $exists{$o->{ID}};
3956 $CPAN::META->delete($class,$o->{ID});
3957 CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
3964 #-> sub CPAN::Index::rd_modlist ;
3966 my($cl,$index_target) = @_;
3967 return unless defined $index_target;
3968 $CPAN::Frontend->myprint("Going to read $index_target\n");
3969 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3973 while ($_ = $fh->READLINE) {
3975 my @ls = map {"$_\n"} split /\n/, $_;
3976 unshift @ls, "\n" x length($1) if /^(\n+)/;
3980 my $shift = shift(@eval);
3981 if ($shift =~ /^Date:\s+(.*)/){
3982 return if $DATE_OF_03 eq $1;
3985 last if $shift =~ /^\s*$/;
3988 push @eval, q{CPAN::Modulelist->data;};
3990 my($comp) = Safe->new("CPAN::Safe1");
3991 my($eval) = join("", @eval);
3992 my $ret = $comp->reval($eval);
3993 Carp::confess($@) if $@;
3994 return if $CPAN::Signal;
3996 my $obj = $CPAN::META->instance("CPAN::Module",$_);
3997 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
3998 $obj->set(%{$ret->{$_}});
3999 return if $CPAN::Signal;
4003 #-> sub CPAN::Index::write_metadata_cache ;
4004 sub write_metadata_cache {
4006 return unless $CPAN::Config->{'cache_metadata'};
4007 return unless $CPAN::META->has_usable("Storable");
4009 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
4010 CPAN::Distribution)) {
4011 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
4013 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4014 $cache->{last_time} = $LAST_TIME;
4015 $cache->{DATE_OF_02} = $DATE_OF_02;
4016 $cache->{PROTOCOL} = PROTOCOL;
4017 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
4018 eval { Storable::nstore($cache, $metadata_file) };
4019 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4022 #-> sub CPAN::Index::read_metadata_cache ;
4023 sub read_metadata_cache {
4025 return unless $CPAN::Config->{'cache_metadata'};
4026 return unless $CPAN::META->has_usable("Storable");
4027 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4028 return unless -r $metadata_file and -f $metadata_file;
4029 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
4031 eval { $cache = Storable::retrieve($metadata_file) };
4032 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4033 if (!$cache || ref $cache ne 'HASH'){
4037 if (exists $cache->{PROTOCOL}) {
4038 if (PROTOCOL > $cache->{PROTOCOL}) {
4039 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
4040 "with protocol v%s, requiring v%s\n",
4047 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
4048 "with protocol v1.0\n");
4053 while(my($class,$v) = each %$cache) {
4054 next unless $class =~ /^CPAN::/;
4055 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
4056 while (my($id,$ro) = each %$v) {
4057 $CPAN::META->{readwrite}{$class}{$id} ||=
4058 $class->new(ID=>$id, RO=>$ro);
4063 unless ($clcnt) { # sanity check
4064 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
4067 if ($idcnt < 1000) {
4068 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
4069 "in $metadata_file\n");
4072 $CPAN::META->{PROTOCOL} ||=
4073 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
4074 # does initialize to some protocol
4075 $LAST_TIME = $cache->{last_time};
4076 $DATE_OF_02 = $cache->{DATE_OF_02};
4077 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
4078 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
4082 package CPAN::InfoObj;
4087 exists $self->{RO} and return $self->{RO};
4092 my $ro = $self->ro or return "N/A"; # N/A for bundles found locally
4093 return $ro->{CPAN_USERID} || "N/A";
4096 sub id { shift->{ID}; }
4098 #-> sub CPAN::InfoObj::new ;
4100 my $this = bless {}, shift;
4105 # The set method may only be used by code that reads index data or
4106 # otherwise "objective" data from the outside world. All session
4107 # related material may do anything else with instance variables but
4108 # must not touch the hash under the RO attribute. The reason is that
4109 # the RO hash gets written to Metadata file and is thus persistent.
4111 #-> sub CPAN::InfoObj::safe_chdir ;
4113 my($self,$todir) = @_;
4114 # we die if we cannot chdir and we are debuggable
4115 Carp::confess("safe_chdir called without todir argument")
4116 unless defined $todir and length $todir;
4118 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4122 unless (-x $todir) {
4123 unless (chmod 0755, $todir) {
4124 my $cwd = CPAN::anycwd();
4125 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
4126 "permission to change the permission; cannot ".
4127 "chdir to '$todir'\n");
4128 $CPAN::Frontend->mysleep(5);
4129 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4130 qq{to todir[$todir]: $!});
4134 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
4137 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4140 my $cwd = CPAN::anycwd();
4141 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4142 qq{to todir[$todir] (a chmod has been issued): $!});
4147 #-> sub CPAN::InfoObj::set ;
4149 my($self,%att) = @_;
4150 my $class = ref $self;
4152 # This must be ||=, not ||, because only if we write an empty
4153 # reference, only then the set method will write into the readonly
4154 # area. But for Distributions that spring into existence, maybe
4155 # because of a typo, we do not like it that they are written into
4156 # the readonly area and made permanent (at least for a while) and
4157 # that is why we do not "allow" other places to call ->set.
4158 unless ($self->id) {
4159 CPAN->debug("Bug? Empty ID, rejecting");
4162 my $ro = $self->{RO} =
4163 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
4165 while (my($k,$v) = each %att) {
4170 #-> sub CPAN::InfoObj::as_glimpse ;
4174 my $class = ref($self);
4175 $class =~ s/^CPAN:://;
4176 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
4180 #-> sub CPAN::InfoObj::as_string ;
4184 my $class = ref($self);
4185 $class =~ s/^CPAN:://;
4186 push @m, $class, " id = $self->{ID}\n";
4188 unless ($ro = $self->ro) {
4189 $CPAN::Frontend->mydie("Unknown object $self->{ID}");
4191 for (sort keys %$ro) {
4192 # next if m/^(ID|RO)$/;
4194 if ($_ eq "CPAN_USERID") {
4196 $extra .= $self->fullname;
4197 my $email; # old perls!
4198 if ($email = $CPAN::META->instance("CPAN::Author",
4201 $extra .= " <$email>";
4203 $extra .= " <no email>";
4206 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
4207 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
4210 next unless defined $ro->{$_};
4211 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
4213 for (sort keys %$self) {
4214 next if m/^(ID|RO)$/;
4215 if (ref($self->{$_}) eq "ARRAY") {
4216 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
4217 } elsif (ref($self->{$_}) eq "HASH") {
4221 join(" ",sort keys %{$self->{$_}}),
4224 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
4230 #-> sub CPAN::InfoObj::fullname ;
4233 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
4236 #-> sub CPAN::InfoObj::dump ;
4239 unless ($CPAN::META->has_inst("Data::Dumper")) {
4240 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
4242 local $Data::Dumper::Sortkeys;
4243 $Data::Dumper::Sortkeys = 1;
4244 $CPAN::Frontend->myprint(Data::Dumper::Dumper($self));
4247 package CPAN::Author;
4250 #-> sub CPAN::Author::force
4256 #-> sub CPAN::Author::force
4259 delete $self->{force};
4262 #-> sub CPAN::Author::id
4265 my $id = $self->{ID};
4266 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
4270 #-> sub CPAN::Author::as_glimpse ;
4274 my $class = ref($self);
4275 $class =~ s/^CPAN:://;
4276 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
4284 #-> sub CPAN::Author::fullname ;
4286 shift->ro->{FULLNAME};
4290 #-> sub CPAN::Author::email ;
4291 sub email { shift->ro->{EMAIL}; }
4293 #-> sub CPAN::Author::ls ;
4296 my $glob = shift || "";
4297 my $silent = shift || 0;
4300 # adapted from CPAN::Distribution::verifyCHECKSUM ;
4301 my(@csf); # chksumfile
4302 @csf = $self->id =~ /(.)(.)(.*)/;
4303 $csf[1] = join "", @csf[0,1];
4304 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
4306 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
4307 unless (grep {$_->[2] eq $csf[1]} @dl) {
4308 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
4311 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
4312 unless (grep {$_->[2] eq $csf[2]} @dl) {
4313 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
4316 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
4318 if ($CPAN::META->has_inst("Text::Glob")) {
4319 my $rglob = Text::Glob::glob_to_regex($glob);
4320 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
4322 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
4325 $CPAN::Frontend->myprint(join "", map {
4326 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
4327 } sort { $a->[2] cmp $b->[2] } @dl);
4331 # returns an array of arrays, the latter contain (size,mtime,filename)
4332 #-> sub CPAN::Author::dir_listing ;
4335 my $chksumfile = shift;
4336 my $recursive = shift;
4337 my $may_ftp = shift;
4340 File::Spec->catfile($CPAN::Config->{keep_source_where},
4341 "authors", "id", @$chksumfile);
4345 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
4346 # hazard. (Without GPG installed they are not that much better,
4348 $fh = FileHandle->new;
4349 if (open($fh, $lc_want)) {
4350 my $line = <$fh>; close $fh;
4351 unlink($lc_want) unless $line =~ /PGP/;
4355 # connect "force" argument with "index_expire".
4356 my $force = $self->{force};
4357 if (my @stat = stat $lc_want) {
4358 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
4362 $lc_file = CPAN::FTP->localize(
4363 "authors/id/@$chksumfile",
4368 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
4369 $chksumfile->[-1] .= ".gz";
4370 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
4373 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
4374 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
4380 $lc_file = $lc_want;
4381 # we *could* second-guess and if the user has a file: URL,
4382 # then we could look there. But on the other hand, if they do
4383 # have a file: URL, wy did they choose to set
4384 # $CPAN::Config->{show_upload_date} to false?
4387 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
4388 $fh = FileHandle->new;
4390 if (open $fh, $lc_file){
4393 $eval =~ s/\015?\012/\n/g;
4395 my($comp) = Safe->new();
4396 $cksum = $comp->reval($eval);
4398 rename $lc_file, "$lc_file.bad";
4399 Carp::confess($@) if $@;
4401 } elsif ($may_ftp) {
4402 Carp::carp "Could not open '$lc_file' for reading.";
4404 # Maybe should warn: "You may want to set show_upload_date to a true value"
4408 for $f (sort keys %$cksum) {
4409 if (exists $cksum->{$f}{isdir}) {
4411 my(@dir) = @$chksumfile;
4413 push @dir, $f, "CHECKSUMS";
4415 [$_->[0], $_->[1], "$f/$_->[2]"]
4416 } $self->dir_listing(\@dir,1,$may_ftp);
4418 push @result, [ 0, "-", $f ];
4422 ($cksum->{$f}{"size"}||0),
4423 $cksum->{$f}{"mtime"}||"---",
4431 package CPAN::Distribution;
4437 my $ro = $self->ro or return;
4441 # CPAN::Distribution::undelay
4444 delete $self->{later};
4447 # add the A/AN/ stuff
4448 # CPAN::Distribution::normalize
4451 $s = $self->id unless defined $s;
4455 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
4457 return $s if $s =~ m:^N/A|^Contact Author: ;
4458 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
4459 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
4460 CPAN->debug("s[$s]") if $CPAN::DEBUG;
4465 #-> sub CPAN::Distribution::author ;
4468 my($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
4469 CPAN::Shell->expand("Author",$authorid);
4472 # tries to get the yaml from CPAN instead of the distro itself:
4473 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
4476 my $meta = $self->pretty_id;
4477 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
4478 my(@ls) = CPAN::Shell->globls($meta);
4479 my $norm = $self->normalize($meta);
4483 File::Spec->catfile(
4484 $CPAN::Config->{keep_source_where},
4489 $self->debug("Doing localize") if $CPAN::DEBUG;
4490 unless ($local_file =
4491 CPAN::FTP->localize("authors/id/$norm",
4493 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
4495 if ($CPAN::META->has_inst("YAML")) {
4496 my $yaml = YAML::LoadFile($local_file);
4499 $CPAN::Frontend->mydie("Yaml not installed, cannot parse '$local_file'\n");
4506 return $id unless $id =~ m|^./../|;
4510 # mark as dirty/clean
4511 #-> sub CPAN::Distribution::color_cmd_tmps ;
4512 sub color_cmd_tmps {
4514 my($depth) = shift || 0;
4515 my($color) = shift || 0;
4516 my($ancestors) = shift || [];
4517 # a distribution needs to recurse into its prereq_pms
4519 return if exists $self->{incommandcolor}
4520 && $self->{incommandcolor}==$color;
4522 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
4524 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
4525 my $prereq_pm = $self->prereq_pm;
4526 if (defined $prereq_pm) {
4527 PREREQ: for my $pre (keys %$prereq_pm) {
4529 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
4530 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
4531 $CPAN::Frontend->mysleep(2);
4534 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
4538 delete $self->{sponsored_mods};
4539 delete $self->{badtestcnt};
4541 $self->{incommandcolor} = $color;
4544 #-> sub CPAN::Distribution::as_string ;
4547 $self->containsmods;
4549 $self->SUPER::as_string(@_);
4552 #-> sub CPAN::Distribution::containsmods ;
4555 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
4556 my $dist_id = $self->{ID};
4557 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
4558 my $mod_file = $mod->cpan_file or next;
4559 my $mod_id = $mod->{ID} or next;
4560 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
4562 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
4564 keys %{$self->{CONTAINSMODS}};
4567 #-> sub CPAN::Distribution::upload_date ;
4570 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
4571 my(@local_wanted) = split(/\//,$self->id);
4572 my $filename = pop @local_wanted;
4573 push @local_wanted, "CHECKSUMS";
4574 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
4575 return unless $author;
4576 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
4578 my($dirent) = grep { $_->[2] eq $filename } @dl;
4579 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
4580 return unless $dirent->[1];
4581 return $self->{UPLOAD_DATE} = $dirent->[1];
4584 #-> sub CPAN::Distribution::uptodate ;
4588 foreach $c ($self->containsmods) {
4589 my $obj = CPAN::Shell->expandany($c);
4590 unless ($obj->uptodate){
4591 my $id = $self->pretty_id;
4592 $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG;
4599 #-> sub CPAN::Distribution::called_for ;
4602 $self->{CALLED_FOR} = $id if defined $id;
4603 return $self->{CALLED_FOR};
4606 #-> sub CPAN::Distribution::get ;
4611 exists $self->{'build_dir'} and push @e,
4612 "Is already unwrapped into directory $self->{'build_dir'}";
4613 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4615 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
4618 # Get the file on local disk
4623 File::Spec->catfile(
4624 $CPAN::Config->{keep_source_where},
4627 split(/\//,$self->id)
4630 $self->debug("Doing localize") if $CPAN::DEBUG;
4631 unless ($local_file =
4632 CPAN::FTP->localize("authors/id/$self->{ID}",
4635 if ($CPAN::Index::DATE_OF_02) {
4636 $note = "Note: Current database in memory was generated ".
4637 "on $CPAN::Index::DATE_OF_02\n";
4639 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
4641 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4642 $self->{localfile} = $local_file;
4643 return if $CPAN::Signal;
4648 if ($CPAN::META->has_inst("Digest::SHA")) {
4649 $self->debug("Digest::SHA is installed, verifying");
4650 $self->verifyCHECKSUM;
4652 $self->debug("Digest::SHA is NOT installed");
4654 return if $CPAN::Signal;
4657 # Create a clean room and go there
4659 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
4660 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
4661 $self->safe_chdir($builddir);
4662 $self->debug("Removing tmp") if $CPAN::DEBUG;
4663 File::Path::rmtree("tmp");
4664 unless (mkdir "tmp", 0755) {
4665 $CPAN::Frontend->unrecoverable_error(<<EOF);
4666 Couldn't mkdir '$builddir/tmp': $!
4668 Cannot continue: Please find the reason why I cannot make the
4671 and fix the problem, then retry.
4676 $self->safe_chdir($sub_wd);
4679 $self->safe_chdir("tmp");
4684 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4685 my $ct = CPAN::Tarzip->new($local_file);
4686 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
4687 $self->{was_uncompressed}++ unless $ct->gtest();
4688 $self->untar_me($ct);
4689 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
4690 $self->unzip_me($ct);
4692 $self->{was_uncompressed}++ unless $ct->gtest();
4693 $self->debug("calling pm2dir for local_file[$local_file]")
4695 $local_file = $self->handle_singlefile($local_file);
4697 # $self->{archived} = "NO";
4698 # $self->safe_chdir($sub_wd);
4702 # we are still in the tmp directory!
4703 # Let's check if the package has its own directory.
4704 my $dh = DirHandle->new(File::Spec->curdir)
4705 or Carp::croak("Couldn't opendir .: $!");
4706 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
4708 my ($distdir,$packagedir);
4709 if (@readdir == 1 && -d $readdir[0]) {
4710 $distdir = $readdir[0];
4711 $packagedir = File::Spec->catdir($builddir,$distdir);
4712 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
4714 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
4716 File::Path::rmtree($packagedir);
4717 unless (File::Copy::move($distdir,$packagedir)) {
4718 $CPAN::Frontend->unrecoverable_error(<<EOF);
4719 Couldn't move '$distdir' to '$packagedir': $!
4721 Cannot continue: Please find the reason why I cannot move
4722 $builddir/tmp/$distdir
4725 and fix the problem, then retry
4729 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
4736 my $userid = $self->cpan_userid;
4738 CPAN->debug("no userid? self[$self]");
4741 my $pragmatic_dir = $userid . '000';
4742 $pragmatic_dir =~ s/\W_//g;
4743 $pragmatic_dir++ while -d "../$pragmatic_dir";
4744 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
4745 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
4746 File::Path::mkpath($packagedir);
4748 for $f (@readdir) { # is already without "." and ".."
4749 my $to = File::Spec->catdir($packagedir,$f);
4750 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
4754 $self->safe_chdir($sub_wd);
4758 $self->{'build_dir'} = $packagedir;
4759 $self->safe_chdir($builddir);
4760 File::Path::rmtree("tmp");
4762 $self->safe_chdir($packagedir);
4763 if ($CPAN::Config->{check_sigs}) {
4764 if ($CPAN::META->has_inst("Module::Signature")) {
4765 if (-f "SIGNATURE") {
4766 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
4767 my $rv = Module::Signature::verify();
4768 if ($rv != Module::Signature::SIGNATURE_OK() and
4769 $rv != Module::Signature::SIGNATURE_MISSING()) {
4770 $CPAN::Frontend->myprint(
4771 qq{\nSignature invalid for }.
4772 qq{distribution file. }.
4773 qq{Please investigate.\n\n}.
4775 $CPAN::META->instance(
4782 sprintf(qq{I'd recommend removing %s. Its signature
4783 is invalid. Maybe you have configured your 'urllist' with
4784 a bad URL. Please check this array with 'o conf urllist', and
4785 retry. For more information, try opening a subshell with
4793 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
4794 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
4795 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
4797 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
4798 $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
4801 $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n});
4804 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
4807 $self->safe_chdir($builddir);
4808 return if $CPAN::Signal;
4811 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
4812 my($mpl_exists) = -f $mpl;
4813 unless ($mpl_exists) {
4814 # NFS has been reported to have racing problems after the
4815 # renaming of a directory in some environments.
4817 $CPAN::Frontend->mysleep(1);
4818 my $mpldh = DirHandle->new($packagedir)
4819 or Carp::croak("Couldn't opendir $packagedir: $!");
4820 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
4823 my $prefer_installer = "eumm"; # eumm|mb
4824 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
4825 if ($mpl_exists) { # they *can* choose
4826 if ($CPAN::META->has_inst("Module::Build")) {
4827 $prefer_installer = $CPAN::Config->{prefer_installer};
4830 $prefer_installer = "mb";
4833 if (lc($prefer_installer) eq "mb") {
4834 $self->{modulebuild} = 1;
4835 } elsif (! $mpl_exists) {
4836 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
4840 my($configure) = File::Spec->catfile($packagedir,"Configure");
4841 if (-f $configure) {
4842 # do we have anything to do?
4843 $self->{'configure'} = $configure;
4844 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
4845 $CPAN::Frontend->mywarn(qq{
4846 Package comes with a Makefile and without a Makefile.PL.
4847 We\'ll try to build it with that Makefile then.
4849 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
4850 $CPAN::Frontend->mysleep(2);
4852 my $cf = $self->called_for || "unknown";
4857 $cf =~ s|[/\\:]||g; # risk of filesystem damage
4858 $cf = "unknown" unless length($cf);
4859 $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
4860 (The test -f "$mpl" returned false.)
4861 Writing one on our own (setting NAME to $cf)\a\n});
4862 $self->{had_no_makefile_pl}++;
4863 $CPAN::Frontend->mysleep(3);
4865 # Writing our own Makefile.PL
4868 if ($self->{archived} eq "maybe_pl"){
4869 my $fh = FileHandle->new;
4870 my $script_file = File::Spec->catfile($packagedir,$local_file);
4871 $fh->open($script_file)
4872 or Carp::croak("Could not open $script_file: $!");
4874 # name parsen und prereq
4875 my($state) = "poddir";
4876 my($name, $prereq) = ("", "");
4878 if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
4881 } elsif ($1 eq 'PREREQUISITES') {
4884 } elsif ($state =~ m{^(name|prereq)$}) {
4889 } elsif ($state eq "name") {
4894 } elsif ($state eq "prereq") {
4897 } elsif (/^=cut\b/) {
4904 s{.*<}{}; # strip X<...>
4908 $prereq = join " ", split /\s+/, $prereq;
4909 my($PREREQ_PM) = join("\n", map {
4910 s{.*<}{}; # strip X<...>
4912 if (/[\s\'\"]/) { # prose?
4914 s/[^\w:]$//; # period?
4915 " "x28 . "'$_' => 0,";
4917 } split /\s*,\s*/, $prereq);
4920 EXE_FILES => ['$name'],
4926 my $to_file = File::Spec->catfile($packagedir, $name);
4927 rename $script_file, $to_file
4928 or die "Can't rename $script_file to $to_file: $!";
4931 my $fh = FileHandle->new;
4933 or Carp::croak("Could not open >$mpl: $!");
4935 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
4936 # because there was no Makefile.PL supplied.
4937 # Autogenerated on: }.scalar localtime().qq{
4939 use ExtUtils::MakeMaker;
4941 NAME => q[$cf],$script
4951 # CPAN::Distribution::untar_me ;
4954 $self->{archived} = "tar";
4956 $self->{unwrapped} = "YES";
4958 $self->{unwrapped} = "NO";
4962 # CPAN::Distribution::unzip_me ;
4965 $self->{archived} = "zip";
4967 $self->{unwrapped} = "YES";
4969 $self->{unwrapped} = "NO";
4974 sub handle_singlefile {
4975 my($self,$local_file) = @_;
4977 if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ){
4978 $self->{archived} = "pm";
4980 $self->{archived} = "maybe_pl";
4983 my $to = File::Basename::basename($local_file);
4984 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
4985 if (CPAN::Tarzip->new($local_file)->gunzip($to)) {
4986 $self->{unwrapped} = "YES";
4988 $self->{unwrapped} = "NO";
4991 File::Copy::cp($local_file,".");
4992 $self->{unwrapped} = "YES";
4997 #-> sub CPAN::Distribution::new ;
4999 my($class,%att) = @_;
5001 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
5003 my $this = { %att };
5004 return bless $this, $class;
5007 #-> sub CPAN::Distribution::look ;
5011 if ($^O eq 'MacOS') {
5012 $self->Mac::BuildTools::look;
5016 if ( $CPAN::Config->{'shell'} ) {
5017 $CPAN::Frontend->myprint(qq{
5018 Trying to open a subshell in the build directory...
5021 $CPAN::Frontend->myprint(qq{
5022 Your configuration does not define a value for subshells.
5023 Please define it with "o conf shell <your shell>"
5027 my $dist = $self->id;
5029 unless ($dir = $self->dir) {
5032 unless ($dir ||= $self->dir) {
5033 $CPAN::Frontend->mywarn(qq{
5034 Could not determine which directory to use for looking at $dist.
5038 my $pwd = CPAN::anycwd();
5039 $self->safe_chdir($dir);
5040 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
5042 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
5043 $ENV{CPAN_SHELL_LEVEL} += 1;
5044 my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
5045 unless (system($shell) == 0) {
5047 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
5050 $self->safe_chdir($pwd);
5053 # CPAN::Distribution::cvs_import ;
5057 my $dir = $self->dir;
5059 my $package = $self->called_for;
5060 my $module = $CPAN::META->instance('CPAN::Module', $package);
5061 my $version = $module->cpan_version;
5063 my $userid = $self->cpan_userid;
5065 my $cvs_dir = (split /\//, $dir)[-1];
5066 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
5068 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
5070 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
5071 if ($cvs_site_perl) {
5072 $cvs_dir = "$cvs_site_perl/$cvs_dir";
5074 my $cvs_log = qq{"imported $package $version sources"};
5075 $version =~ s/\./_/g;
5077 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
5078 "$cvs_dir", $userid, "v$version");
5080 my $pwd = CPAN::anycwd();
5081 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
5083 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
5085 $CPAN::Frontend->myprint(qq{@cmd\n});
5086 system(@cmd) == 0 or
5088 $CPAN::Frontend->mydie("cvs import failed");
5089 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
5092 #-> sub CPAN::Distribution::readme ;
5095 my($dist) = $self->id;
5096 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
5097 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
5100 File::Spec->catfile(
5101 $CPAN::Config->{keep_source_where},
5104 split(/\//,"$sans.readme"),
5106 $self->debug("Doing localize") if $CPAN::DEBUG;
5107 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
5109 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
5111 if ($^O eq 'MacOS') {
5112 Mac::BuildTools::launch_file($local_file);
5116 my $fh_pager = FileHandle->new;
5117 local($SIG{PIPE}) = "IGNORE";
5118 my $pager = $CPAN::Config->{'pager'} || "cat";
5119 $fh_pager->open("|$pager")
5120 or die "Could not open pager $pager\: $!";
5121 my $fh_readme = FileHandle->new;
5122 $fh_readme->open($local_file)
5123 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
5124 $CPAN::Frontend->myprint(qq{
5129 $fh_pager->print(<$fh_readme>);
5133 #-> sub CPAN::Distribution::verifyCHECKSUM ;
5134 sub verifyCHECKSUM {
5138 $self->{CHECKSUM_STATUS} ||= "";
5139 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
5140 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5142 my($lc_want,$lc_file,@local,$basename);
5143 @local = split(/\//,$self->id);
5145 push @local, "CHECKSUMS";
5147 File::Spec->catfile($CPAN::Config->{keep_source_where},
5148 "authors", "id", @local);
5150 if (my $size = -s $lc_want) {
5151 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
5152 if ($self->CHECKSUM_check_file($lc_want,1)) {
5153 return $self->{CHECKSUM_STATUS} = "OK";
5156 $lc_file = CPAN::FTP->localize("authors/id/@local",
5159 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
5160 $local[-1] .= ".gz";
5161 $lc_file = CPAN::FTP->localize("authors/id/@local",
5164 $lc_file =~ s/\.gz(?!\n)\Z//;
5165 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
5170 if ($self->CHECKSUM_check_file($lc_file)) {
5171 return $self->{CHECKSUM_STATUS} = "OK";
5175 #-> sub CPAN::Distribution::SIG_check_file ;
5176 sub SIG_check_file {
5177 my($self,$chk_file) = @_;
5178 my $rv = eval { Module::Signature::_verify($chk_file) };
5180 if ($rv == Module::Signature::SIGNATURE_OK()) {
5181 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
5182 return $self->{SIG_STATUS} = "OK";
5184 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
5185 qq{distribution file. }.
5186 qq{Please investigate.\n\n}.
5188 $CPAN::META->instance(
5193 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
5194 is invalid. Maybe you have configured your 'urllist' with
5195 a bad URL. Please check this array with 'o conf urllist', and
5198 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
5202 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
5204 # sloppy is 1 when we have an old checksums file that maybe is good
5207 sub CHECKSUM_check_file {
5208 my($self,$chk_file,$sloppy) = @_;
5209 my($cksum,$file,$basename);
5212 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
5213 if ($CPAN::Config->{check_sigs}) {
5214 if ($CPAN::META->has_inst("Module::Signature") and Module::Signature->VERSION >= 0.26) {
5215 $self->debug("Module::Signature is installed, verifying");
5216 $self->SIG_check_file($chk_file);
5218 $self->debug("Module::Signature is NOT installed");
5222 $file = $self->{localfile};
5223 $basename = File::Basename::basename($file);
5224 my $fh = FileHandle->new;
5225 if (open $fh, $chk_file){
5228 $eval =~ s/\015?\012/\n/g;
5230 my($comp) = Safe->new();
5231 $cksum = $comp->reval($eval);
5233 rename $chk_file, "$chk_file.bad";
5234 Carp::confess($@) if $@;
5237 Carp::carp "Could not open $chk_file for reading";
5240 if (! ref $cksum or ref $cksum ne "HASH") {
5241 $CPAN::Frontend->mywarn(qq{
5242 Warning: checksum file '$chk_file' broken.
5244 When trying to read that file I expected to get a hash reference
5245 for further processing, but got garbage instead.
5247 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
5248 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
5249 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
5251 } elsif (exists $cksum->{$basename}{sha256}) {
5252 $self->debug("Found checksum for $basename:" .
5253 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
5257 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
5259 $fh = CPAN::Tarzip->TIEHANDLE($file);
5262 my $dg = Digest::SHA->new(256);
5265 while ($fh->READ($ref, 4096) > 0){
5268 my $hexdigest = $dg->hexdigest;
5269 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
5273 $CPAN::Frontend->myprint("Checksum for $file ok\n");
5274 return $self->{CHECKSUM_STATUS} = "OK";
5276 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
5277 qq{distribution file. }.
5278 qq{Please investigate.\n\n}.
5280 $CPAN::META->instance(
5285 my $wrap = qq{I\'d recommend removing $file. Its
5286 checksum is incorrect. Maybe you have configured your 'urllist' with
5287 a bad URL. Please check this array with 'o conf urllist', and
5290 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
5292 # former versions just returned here but this seems a
5293 # serious threat that deserves a die
5295 # $CPAN::Frontend->myprint("\n\n");
5299 # close $fh if fileno($fh);
5302 unless ($self->{CHECKSUM_STATUS}) {
5303 $CPAN::Frontend->mywarn(qq{
5304 Warning: No checksum for $basename in $chk_file.
5306 The cause for this may be that the file is very new and the checksum
5307 has not yet been calculated, but it may also be that something is
5308 going awry right now.
5310 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes");
5311 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
5313 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
5318 #-> sub CPAN::Distribution::eq_CHECKSUM ;
5320 my($self,$fh,$expect) = @_;
5321 if ($CPAN::META->has_inst("Digest::SHA")) {
5322 my $dg = Digest::SHA->new(256);
5324 while (read($fh, $data, 4096)){
5327 my $hexdigest = $dg->hexdigest;
5328 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
5329 return $hexdigest eq $expect;
5334 #-> sub CPAN::Distribution::force ;
5336 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
5337 # effect by autoinspection, not by inspecting a global variable. One
5338 # of the reason why this was chosen to work that way was the treatment
5339 # of dependencies. They should not automatically inherit the force
5340 # status. But this has the downside that ^C and die() will return to
5341 # the prompt but will not be able to reset the force_update
5342 # attributes. We try to correct for it currently in the read_metadata
5343 # routine, and immediately before we check for a Signal. I hope this
5344 # works out in one of v1.57_53ff
5346 # "Force get forgets previous error conditions"
5348 #-> sub CPAN::Distribution::force ;
5350 my($self, $method) = @_;
5352 CHECKSUM_STATUS archived build_dir localfile make install unwrapped
5353 writemakefile modulebuild make_test
5355 delete $self->{$att};
5357 if ($method && $method =~ /make|test|install/) {
5358 $self->{"force_update"}++; # name should probably have been force_install
5363 my($self, $method) = @_;
5364 # warn "XDEBUG: set notest for $self $method";
5365 $self->{"notest"}++; # name should probably have been force_install
5370 # warn "XDEBUG: deleting notest";
5371 delete $self->{'notest'};
5374 #-> sub CPAN::Distribution::unforce ;
5377 delete $self->{'force_update'};
5380 #-> sub CPAN::Distribution::isa_perl ;
5383 my $file = File::Basename::basename($self->id);
5384 if ($file =~ m{ ^ perl
5397 } elsif ($self->cpan_comment
5399 $self->cpan_comment =~ /isa_perl\(.+?\)/){
5405 #-> sub CPAN::Distribution::perl ;
5410 carp __PACKAGE__ . "::perl was called without parameters.";
5412 return CPAN::HandleConfig->safe_quote($CPAN::Perl);
5416 #-> sub CPAN::Distribution::make ;
5419 my $make = $self->{modulebuild} ? "Build" : "make";
5420 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
5421 # Emergency brake if they said install Pippi and get newest perl
5422 if ($self->isa_perl) {
5424 $self->called_for ne $self->id &&
5425 ! $self->{force_update}
5427 # if we die here, we break bundles
5428 $CPAN::Frontend->mywarn(sprintf qq{
5429 The most recent version "%s" of the module "%s"
5430 comes with the current version of perl (%s).
5431 I\'ll build that only if you ask for something like
5436 $CPAN::META->instance(
5444 $self->{make} = CPAN::Distrostatus->new("NO isa perl");
5445 $CPAN::Frontend->mysleep(1);
5451 delete $self->{force_update};
5456 !$self->{archived} || $self->{archived} eq "NO" and push @e,
5457 "Is neither a tar nor a zip archive.";
5459 !$self->{unwrapped} || $self->{unwrapped} eq "NO" and push @e,
5460 "Had problems unarchiving. Please build manually";
5462 unless ($self->{force_update}) {
5463 exists $self->{signature_verify} and (
5464 $self->{signature_verify}->can("failed") ?
5465 $self->{signature_verify}->failed :
5466 $self->{signature_verify} =~ /^NO/
5468 and push @e, "Did not pass the signature test.";
5471 if (exists $self->{writemakefile} &&
5473 $self->{writemakefile}->can("failed") ?
5474 $self->{writemakefile}->failed :
5475 $self->{writemakefile} =~ /^NO/
5477 # XXX maybe a retry would be in order?
5478 my $err = $self->{writemakefile}->can("text") ?
5479 $self->{writemakefile}->text :
5480 $self->{writemakefile};
5482 $err ||= "Had some problem writing Makefile";
5483 $err .= ", won't make";
5487 defined $self->{make} and push @e,
5488 "Has already been processed within this session";
5490 if (exists $self->{later} and length($self->{later})) {
5491 if ($self->unsat_prereq) {
5492 push @e, $self->{later};
5493 # RT ticket 18438 raises doubts if the deletion of {later} is valid.
5494 # YAML-0.53 triggered the later hodge-podge here, but my margin notes
5495 # are not sufficient to be sure if we really must/may do the delete
5496 # here. SO I accept the suggested patch for now. If we trigger a bug
5497 # again, I must go into deep contemplation about the {later} flag.
5500 # delete $self->{later};
5504 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5507 delete $self->{force_update};
5510 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
5511 my $builddir = $self->dir or
5512 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
5513 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
5514 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
5516 if ($^O eq 'MacOS') {
5517 Mac::BuildTools::make($self);
5522 if ($self->{'configure'}) {
5523 $system = $self->{'configure'};
5524 } elsif ($self->{modulebuild}) {
5525 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5526 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
5528 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5530 # This needs a handler that can be turned on or off:
5531 # $switch = "-MExtUtils::MakeMaker ".
5532 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
5534 $system = sprintf("%s%s Makefile.PL%s",
5536 $switch ? " $switch" : "",
5537 $CPAN::Config->{makepl_arg} ? " $CPAN::Config->{makepl_arg}" : "",
5540 unless (exists $self->{writemakefile}) {
5541 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
5544 if ($CPAN::Config->{inactivity_timeout}) {
5546 alarm $CPAN::Config->{inactivity_timeout};
5547 local $SIG{CHLD}; # = sub { wait };
5548 if (defined($pid = fork)) {
5553 # note, this exec isn't necessary if
5554 # inactivity_timeout is 0. On the Mac I'd
5555 # suggest, we set it always to 0.
5559 $CPAN::Frontend->myprint("Cannot fork: $!");
5568 $CPAN::Frontend->myprint($err);
5569 $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
5574 $ret = system($system);
5576 $self->{writemakefile} = CPAN::Distrostatus
5577 ->new("NO '$system' returned status $ret");
5578 $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
5582 if (-f "Makefile" || -f "Build") {
5583 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
5584 delete $self->{make_clean}; # if cleaned before, enable next
5586 $self->{writemakefile} = CPAN::Distrostatus
5587 ->new(qq{NO -- Unknown reason.});
5591 delete $self->{force_update};
5594 if (my @prereq = $self->unsat_prereq){
5595 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5597 if ($self->{modulebuild}) {
5598 unless (-f "Build") {
5600 $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'".
5601 " in cwd[$cwd]. Danger, Will Robinson!");
5602 $CPAN::Frontend->mysleep(5);
5604 $system = sprintf "%s %s", $self->_build_command(), $CPAN::Config->{mbuild_arg};
5606 $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
5608 if (system($system) == 0) {
5609 $CPAN::Frontend->myprint(" $system -- OK\n");
5610 $self->{make} = CPAN::Distrostatus->new("YES");
5612 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
5613 $self->{make} = CPAN::Distrostatus->new("NO");
5614 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
5624 $CPAN::Config->{make} || $Config::Config{make} || 'make'
5627 # Old style call, without object. Deprecated
5628 Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
5630 safe_quote(undef, $CPAN::Config->{make} || $Config::Config{make} || 'make');
5634 #-> sub CPAN::Distribution::follow_prereqs ;
5635 sub follow_prereqs {
5637 my(@prereq) = grep {$_ ne "perl"} @_;
5638 return unless @prereq;
5640 $CPAN::Frontend->myprint("---- Unsatisfied dependencies detected ".
5641 "during [$id] -----\n");
5643 for my $p (@prereq) {
5644 $CPAN::Frontend->myprint(" $p\n");
5647 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
5649 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
5650 my $answer = CPAN::Shell::colorable_makemaker_prompt(
5651 "Shall I follow them and prepend them to the queue
5652 of modules we are processing right now?", "yes");
5653 $follow = $answer =~ /^\s*y/i;
5657 myprint(" Ignoring dependencies on modules @prereq\n");
5660 # color them as dirty
5661 for my $p (@prereq) {
5662 # warn "calling color_cmd_tmps(0,1)";
5663 CPAN::Shell->expandany($p)->color_cmd_tmps(0,1);
5665 CPAN::Queue->jumpqueue(@prereq,$id); # queue them and requeue yourself
5666 $self->{later} = "Delayed until after prerequisites";
5667 return 1; # signal success to the queuerunner
5671 #-> sub CPAN::Distribution::unsat_prereq ;
5674 my $prereq_pm = $self->prereq_pm or return;
5676 NEED: while (my($need_module, $need_version) = each %$prereq_pm) {
5677 my $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
5678 # we were too demanding:
5679 next if $nmo->uptodate;
5681 # if they have not specified a version, we accept any installed one
5682 if (not defined $need_version or
5683 $need_version eq "0" or
5684 $need_version eq "undef") {
5685 next if defined $nmo->inst_file;
5688 # We only want to install prereqs if either they're not installed
5689 # or if the installed version is too old. We cannot omit this
5690 # check, because if 'force' is in effect, nobody else will check.
5691 if (defined $nmo->inst_file) {
5692 my(@all_requirements) = split /\s*,\s*/, $need_version;
5695 RQ: for my $rq (@all_requirements) {
5696 if ($rq =~ s|>=\s*||) {
5697 } elsif ($rq =~ s|>\s*||) {
5699 if (CPAN::Version->vgt($nmo->inst_version,$rq)){
5703 } elsif ($rq =~ s|!=\s*||) {
5705 if (CPAN::Version->vcmp($nmo->inst_version,$rq)){
5711 } elsif ($rq =~ m|<=?\s*|) {
5713 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])");
5717 if (! CPAN::Version->vgt($rq, $nmo->inst_version)){
5720 CPAN->debug(sprintf "id[%s]inst_file[%s]inst_version[%s]rq[%s]ok[%d]",
5724 CPAN::Version->readable($rq),
5728 next NEED if $ok == @all_requirements;
5731 if ($self->{sponsored_mods}{$need_module}++){
5732 # We have already sponsored it and for some reason it's still
5733 # not available. So we do nothing. Or what should we do?
5734 # if we push it again, we have a potential infinite loop
5737 push @need, $need_module;
5742 #-> sub CPAN::Distribution::read_yaml ;
5745 return $self->{yaml_content} if exists $self->{yaml_content};
5746 my $build_dir = $self->{build_dir};
5747 my $yaml = File::Spec->catfile($build_dir,"META.yml");
5748 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
5749 return unless -f $yaml;
5750 if ($CPAN::META->has_inst("YAML")) {
5751 eval { $self->{yaml_content} = YAML::LoadFile($yaml); };
5753 $CPAN::Frontend->mywarn("Error while parsing META.yml: $@");
5756 if (not exists $self->{yaml_content}{dynamic_config}
5757 or $self->{yaml_content}{dynamic_config}
5759 $self->{yaml_content} = undef;
5762 $self->debug("yaml_content[$self->{yaml_content}]") if $CPAN::DEBUG;
5763 return $self->{yaml_content};
5766 #-> sub CPAN::Distribution::prereq_pm ;
5769 return $self->{prereq_pm} if
5770 exists $self->{prereq_pm_detected} && $self->{prereq_pm_detected};
5771 return unless $self->{writemakefile} # no need to have succeeded
5772 # but we must have run it
5773 || $self->{modulebuild};
5775 if (my $yaml = $self->read_yaml) {
5776 $req = $yaml->{requires};
5777 undef $req unless ref $req eq "HASH" && %$req;
5779 if ($yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
5780 my $eummv = do { local $^W = 0; $1+0; };
5781 if ($eummv < 6.2501) {
5782 # thanks to Slaven for digging that out: MM before
5783 # that could be wrong because it could reflect a
5790 while (my($k,$v) = each %{$req||{}}) {
5793 } elsif ($k =~ /[A-Za-z]/ &&
5795 $CPAN::META->exists("Module",$v)
5797 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
5798 "requires hash: $k => $v; I'll take both ".
5799 "key and value as a module name\n");
5800 $CPAN::Frontend->mysleep(1);
5806 $req = $areq if $do_replace;
5808 if ($yaml->{build_requires}
5809 && ref $yaml->{build_requires}
5810 && ref $yaml->{build_requires} eq "HASH") {
5811 while (my($k,$v) = each %{$yaml->{build_requires}}) {
5813 # merging of two "requires"-type values--what should we do?
5820 delete $req->{perl};
5824 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
5825 my $makefile = File::Spec->catfile($build_dir,"Makefile");
5829 $fh = FileHandle->new("<$makefile\0")) {
5832 last if /MakeMaker post_initialize section/;
5834 \s+PREREQ_PM\s+=>\s+(.+)
5837 # warn "Found prereq expr[$p]";
5839 # Regexp modified by A.Speer to remember actual version of file
5840 # PREREQ_PM hash key wants, then add to
5841 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){
5842 # In case a prereq is mentioned twice, complain.
5843 if ( defined $req->{$1} ) {
5844 warn "Warning: PREREQ_PM mentions $1 more than once, ".
5845 "last mention wins";
5851 } elsif (-f "Build") {
5852 if ($CPAN::META->has_inst("Module::Build")) {
5853 my $requires = Module::Build->current->requires();
5854 my $brequires = Module::Build->current->build_requires();
5855 $req = { %$requires, %$brequires };
5859 if (-f "Build.PL" && ! -f "Makefile.PL" && ! exists $req->{"Module::Build"}) {
5860 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
5861 "undeclared prerequisite.\n".
5862 " Adding it now as a prerequisite.\n"
5864 $CPAN::Frontend->mysleep(5);
5865 $req->{"Module::Build"} = 0;
5866 delete $self->{writemakefile};
5868 $self->{prereq_pm_detected}++;
5869 return $self->{prereq_pm} = $req;
5872 #-> sub CPAN::Distribution::test ;
5877 delete $self->{force_update};
5880 # warn "XDEBUG: checking for notest: $self->{notest} $self";
5881 if ($self->{notest}) {
5882 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
5886 my $make = $self->{modulebuild} ? "Build" : "make";
5887 $CPAN::Frontend->myprint("Running $make test\n");
5888 if (my @prereq = $self->unsat_prereq){
5889 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5893 unless (exists $self->{make} or exists $self->{later}) {
5895 "Make had some problems, won't test";
5898 exists $self->{make} and
5900 $self->{make}->can("failed") ?
5901 $self->{make}->failed :
5902 $self->{make} =~ /^NO/
5903 ) and push @e, "Can't test without successful make";
5905 exists $self->{build_dir} or push @e, "Has no own directory";
5906 $self->{badtestcnt} ||= 0;
5907 $self->{badtestcnt} > 0 and
5908 push @e, "Won't repeat unsuccessful test during this command";
5910 exists $self->{later} and length($self->{later}) and
5911 push @e, $self->{later};
5913 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5915 chdir $self->{'build_dir'} or
5916 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5917 $self->debug("Changed directory to $self->{'build_dir'}")
5920 if ($^O eq 'MacOS') {
5921 Mac::BuildTools::make_test($self);
5925 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
5927 : ($ENV{PERLLIB} || "");
5929 $CPAN::META->set_perl5lib;
5930 local $ENV{MAKEFLAGS}; # protect us from outer make calls
5933 if ($self->{modulebuild}) {
5934 $system = sprintf "%s test", $self->_build_command();
5936 $system = join " ", $self->_make_command(), "test";
5939 if ( $CPAN::Config->{test_report} &&
5940 $CPAN::META->has_inst("CPAN::Reporter") ) {
5941 $tests_ok = CPAN::Reporter::test($self, $system);
5943 $tests_ok = system($system) == 0;
5946 $CPAN::Frontend->myprint(" $system -- OK\n");
5947 $CPAN::META->is_tested($self->{'build_dir'});
5948 $self->{make_test} = CPAN::Distrostatus->new("YES");
5950 $self->{make_test} = CPAN::Distrostatus->new("NO");
5951 $self->{badtestcnt}++;
5952 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
5956 #-> sub CPAN::Distribution::clean ;
5959 my $make = $self->{modulebuild} ? "Build" : "make";
5960 $CPAN::Frontend->myprint("Running $make clean\n");
5961 unless (exists $self->{archived}) {
5962 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
5963 "/untarred, nothing done\n");
5966 unless (exists $self->{build_dir}) {
5967 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
5972 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
5973 push @e, "make clean already called once";
5974 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5976 chdir $self->{'build_dir'} or
5977 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5978 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
5980 if ($^O eq 'MacOS') {
5981 Mac::BuildTools::make_clean($self);
5986 if ($self->{modulebuild}) {
5987 unless (-f "Build") {
5989 $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}".
5990 " in cwd[$cwd]. Danger, Will Robinson!");
5991 $CPAN::Frontend->mysleep(5);
5993 $system = sprintf "%s clean", $self->_build_command();
5995 $system = join " ", $self->_make_command(), "clean";
5997 if (system($system) == 0) {
5998 $CPAN::Frontend->myprint(" $system -- OK\n");
6002 # Jost Krieger pointed out that this "force" was wrong because
6003 # it has the effect that the next "install" on this distribution
6004 # will untar everything again. Instead we should bring the
6005 # object's state back to where it is after untarring.
6016 $self->{make_clean} = CPAN::Distrostatus->new("YES");
6019 # Hmmm, what to do if make clean failed?
6021 $self->{make_clean} = CPAN::Distrostatus->new("NO");
6022 $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n});
6024 # 2006-02-27: seems silly to me to force a make now
6025 # $self->force("make"); # so that this directory won't be used again
6030 #-> sub CPAN::Distribution::install ;
6035 delete $self->{force_update};
6038 my $make = $self->{modulebuild} ? "Build" : "make";
6039 $CPAN::Frontend->myprint("Running $make install\n");
6042 exists $self->{build_dir} or push @e, "Has no own directory";
6044 unless (exists $self->{make} or exists $self->{later}) {
6046 "Make had some problems, won't install";
6049 exists $self->{make} and
6051 $self->{make}->can("failed") ?
6052 $self->{make}->failed :
6053 $self->{make} =~ /^NO/
6055 push @e, "make had returned bad status, install seems impossible";
6057 if (exists $self->{make_test} and
6059 $self->{make_test}->can("failed") ?
6060 $self->{make_test}->failed :
6061 $self->{make_test} =~ /^NO/
6063 if ($self->{force_update}) {
6064 $self->{make_test}->text("FAILED but failure ignored because ".
6065 "'force' in effect");
6067 push @e, "make test had returned bad status, ".
6068 "won't install without force"
6071 if (exists $self->{'install'}) {
6072 if ($self->{'install'}->can("text") ?
6073 $self->{'install'}->text eq "YES" :
6074 $self->{'install'} =~ /^YES/
6076 push @e, "Already done";
6078 # comment in Todo on 2006-02-11; maybe retry?
6079 push @e, "Already tried without success";
6083 exists $self->{later} and length($self->{later}) and
6084 push @e, $self->{later};
6086 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6088 chdir $self->{'build_dir'} or
6089 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
6090 $self->debug("Changed directory to $self->{'build_dir'}")
6093 if ($^O eq 'MacOS') {
6094 Mac::BuildTools::make_install($self);
6099 if ($self->{modulebuild}) {
6100 my($mbuild_install_build_command) =
6101 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
6102 $CPAN::Config->{mbuild_install_build_command} ?
6103 $CPAN::Config->{mbuild_install_build_command} :
6104 $self->_build_command();
6105 $system = sprintf("%s install %s",
6106 $mbuild_install_build_command,
6107 $CPAN::Config->{mbuild_install_arg},
6110 my($make_install_make_command) = $CPAN::Config->{make_install_make_command} ||
6111 $self->_make_command();
6112 $system = sprintf("%s install %s",
6113 $make_install_make_command,
6114 $CPAN::Config->{make_install_arg},
6118 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
6119 my($pipe) = FileHandle->new("$system $stderr |");
6122 print $_; # intentionally NOT use Frontend->myprint because it
6123 # looks irritating when we markup in color what we
6124 # just pass through from an external program
6129 $CPAN::Frontend->myprint(" $system -- OK\n");
6130 $CPAN::META->is_installed($self->{build_dir});
6131 return $self->{install} = CPAN::Distrostatus->new("YES");
6133 $self->{install} = CPAN::Distrostatus->new("NO");
6134 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
6136 $makeout =~ /permission/s
6139 ! $CPAN::Config->{make_install_make_command}
6140 || $CPAN::Config->{make_install_make_command} eq $CPAN::Config->{make}
6143 $CPAN::Frontend->myprint(
6145 qq{ You may have to su }.
6146 qq{to root to install the package\n}.
6147 qq{ (Or you may want to run something like\n}.
6148 qq{ o conf make_install_make_command 'sudo make'\n}.
6149 qq{ to raise your permissions.}
6153 delete $self->{force_update};
6156 #-> sub CPAN::Distribution::dir ;
6158 shift->{'build_dir'};
6161 #-> sub CPAN::Distribution::perldoc ;
6165 my($dist) = $self->id;
6166 my $package = $self->called_for;
6168 $self->_display_url( $CPAN::Defaultdocs . $package );
6171 #-> sub CPAN::Distribution::_check_binary ;
6173 my ($dist,$shell,$binary) = @_;
6176 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
6180 $pid = open README, "which $binary|"
6181 or $CPAN::Frontend->mydie(qq{Could not fork 'which $binary': $!});
6185 close README or die "Could not run 'which $binary': $!";
6187 $CPAN::Frontend->myprint(qq{ + $out \n})
6188 if $CPAN::DEBUG && $out;
6193 #-> sub CPAN::Distribution::_display_url ;
6195 my($self,$url) = @_;
6196 my($res,$saved_file,$pid,$out);
6198 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
6201 # should we define it in the config instead?
6202 my $html_converter = "html2text";
6204 my $web_browser = $CPAN::Config->{'lynx'} || undef;
6205 my $web_browser_out = $web_browser
6206 ? CPAN::Distribution->_check_binary($self,$web_browser)
6209 if ($web_browser_out) {
6210 # web browser found, run the action
6211 my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
6212 $CPAN::Frontend->myprint(qq{system[$browser $url]})
6214 $CPAN::Frontend->myprint(qq{
6217 with browser $browser
6219 $CPAN::Frontend->mysleep(1);
6220 system("$browser $url");
6221 if ($saved_file) { 1 while unlink($saved_file) }
6223 # web browser not found, let's try text only
6224 my $html_converter_out =
6225 CPAN::Distribution->_check_binary($self,$html_converter);
6226 $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
6228 if ($html_converter_out ) {
6229 # html2text found, run it
6230 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
6231 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
6232 unless defined($saved_file);
6235 $pid = open README, "$html_converter $saved_file |"
6236 or $CPAN::Frontend->mydie(qq{
6237 Could not fork '$html_converter $saved_file': $!});
6239 if ($CPAN::META->has_inst("File::Temp")) {
6240 $fh = File::Temp->new(
6241 template => 'cpan_htmlconvert_XXXX',
6245 $filename = $fh->filename;
6247 $filename = "cpan_htmlconvert_$$.txt";
6248 $fh = FileHandle->new();
6249 open $fh, ">$filename" or die;
6255 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
6256 my $tmpin = $fh->filename;
6257 $CPAN::Frontend->myprint(sprintf(qq{
6259 saved output to %s\n},
6267 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
6268 my $fh_pager = FileHandle->new;
6269 local($SIG{PIPE}) = "IGNORE";
6270 my $pager = $CPAN::Config->{'pager'} || "cat";
6271 $fh_pager->open("|pager")
6272 or $CPAN::Frontend->mydie(qq{
6273 Could not open pager $pager\: $!});
6274 $CPAN::Frontend->myprint(qq{
6279 $CPAN::Frontend->mysleep(1);
6280 $fh_pager->print(<FH>);
6283 # coldn't find the web browser or html converter
6284 $CPAN::Frontend->myprint(qq{
6285 You need to install lynx or $html_converter to use this feature.});
6290 #-> sub CPAN::Distribution::_getsave_url ;
6292 my($dist, $shell, $url) = @_;
6294 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
6298 if ($CPAN::META->has_inst("File::Temp")) {
6299 $fh = File::Temp->new(
6300 template => "cpan_getsave_url_XXXX",
6304 $filename = $fh->filename;
6306 $fh = FileHandle->new;
6307 $filename = "cpan_getsave_url_$$.html";
6309 my $tmpin = $filename;
6310 if ($CPAN::META->has_usable('LWP')) {
6311 $CPAN::Frontend->myprint("Fetching with LWP:
6315 CPAN::LWP::UserAgent->config;
6316 eval { $Ua = CPAN::LWP::UserAgent->new; };
6318 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
6322 $Ua->proxy('http', $var)
6323 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
6325 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
6328 my $req = HTTP::Request->new(GET => $url);
6329 $req->header('Accept' => 'text/html');
6330 my $res = $Ua->request($req);
6331 if ($res->is_success) {
6332 $CPAN::Frontend->myprint(" + request successful.\n")
6334 print $fh $res->content;
6336 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
6340 $CPAN::Frontend->myprint(sprintf(
6341 "LWP failed with code[%s], message[%s]\n",
6348 $CPAN::Frontend->mywarn(" LWP not available\n");
6353 # sub CPAN::Distribution::_build_command
6354 sub _build_command {
6356 if ($^O eq "MSWin32") { # special code needed at least up to
6357 # Module::Build 0.2611 and 0.2706; a fix
6358 # in M:B has been promised 2006-01-30
6360 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
6361 return "$perl ./Build";
6366 package CPAN::Bundle;
6371 $CPAN::Frontend->myprint($self->as_string);
6376 delete $self->{later};
6377 for my $c ( $self->contains ) {
6378 my $obj = CPAN::Shell->expandany($c) or next;
6383 # mark as dirty/clean
6384 #-> sub CPAN::Bundle::color_cmd_tmps ;
6385 sub color_cmd_tmps {
6387 my($depth) = shift || 0;
6388 my($color) = shift || 0;
6389 my($ancestors) = shift || [];
6390 # a module needs to recurse to its cpan_file, a distribution needs
6391 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
6393 return if exists $self->{incommandcolor}
6394 && $self->{incommandcolor}==$color;
6396 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
6398 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
6400 for my $c ( $self->contains ) {
6401 my $obj = CPAN::Shell->expandany($c) or next;
6402 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
6403 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
6406 delete $self->{badtestcnt};
6408 $self->{incommandcolor} = $color;
6411 #-> sub CPAN::Bundle::as_string ;
6415 # following line must be "=", not "||=" because we have a moving target
6416 $self->{INST_VERSION} = $self->inst_version;
6417 return $self->SUPER::as_string;
6420 #-> sub CPAN::Bundle::contains ;
6423 my($inst_file) = $self->inst_file || "";
6424 my($id) = $self->id;
6425 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
6426 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
6429 unless ($inst_file) {
6430 # Try to get at it in the cpan directory
6431 $self->debug("no inst_file") if $CPAN::DEBUG;
6433 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
6434 $cpan_file = $self->cpan_file;
6435 if ($cpan_file eq "N/A") {
6436 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
6437 Maybe stale symlink? Maybe removed during session? Giving up.\n");
6439 my $dist = $CPAN::META->instance('CPAN::Distribution',
6442 $self->debug("id[$dist->{ID}]") if $CPAN::DEBUG;
6443 my($todir) = $CPAN::Config->{'cpan_home'};
6444 my(@me,$from,$to,$me);
6445 @me = split /::/, $self->id;
6447 $me = File::Spec->catfile(@me);
6448 $from = $self->find_bundle_file($dist->{'build_dir'},join('/',@me));
6449 $to = File::Spec->catfile($todir,$me);
6450 File::Path::mkpath(File::Basename::dirname($to));
6451 File::Copy::copy($from, $to)
6452 or Carp::confess("Couldn't copy $from to $to: $!");
6456 my $fh = FileHandle->new;
6458 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
6460 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
6462 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
6463 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
6464 next unless $in_cont;
6469 push @result, (split " ", $_, 2)[0];
6472 delete $self->{STATUS};
6473 $self->{CONTAINS} = \@result;
6474 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
6476 $CPAN::Frontend->mywarn(qq{
6477 The bundle file "$inst_file" may be a broken
6478 bundlefile. It seems not to contain any bundle definition.
6479 Please check the file and if it is bogus, please delete it.
6480 Sorry for the inconvenience.
6486 #-> sub CPAN::Bundle::find_bundle_file
6487 # $where is in local format, $what is in unix format
6488 sub find_bundle_file {
6489 my($self,$where,$what) = @_;
6490 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
6491 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
6492 ### my $bu = File::Spec->catfile($where,$what);
6493 ### return $bu if -f $bu;
6494 my $manifest = File::Spec->catfile($where,"MANIFEST");
6495 unless (-f $manifest) {
6496 require ExtUtils::Manifest;
6497 my $cwd = CPAN::anycwd();
6498 $self->safe_chdir($where);
6499 ExtUtils::Manifest::mkmanifest();
6500 $self->safe_chdir($cwd);
6502 my $fh = FileHandle->new($manifest)
6503 or Carp::croak("Couldn't open $manifest: $!");
6505 my $bundle_filename = $what;
6506 $bundle_filename =~ s|Bundle.*/||;
6507 my $bundle_unixpath;
6510 my($file) = /(\S+)/;
6511 if ($file =~ m|\Q$what\E$|) {
6512 $bundle_unixpath = $file;
6513 # return File::Spec->catfile($where,$bundle_unixpath); # bad
6516 # retry if she managed to have no Bundle directory
6517 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
6519 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
6520 if $bundle_unixpath;
6521 Carp::croak("Couldn't find a Bundle file in $where");
6524 # needs to work quite differently from Module::inst_file because of
6525 # cpan_home/Bundle/ directory and the possibility that we have
6526 # shadowing effect. As it makes no sense to take the first in @INC for
6527 # Bundles, we parse them all for $VERSION and take the newest.
6529 #-> sub CPAN::Bundle::inst_file ;
6534 @me = split /::/, $self->id;
6537 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
6538 my $bfile = File::Spec->catfile($incdir, @me);
6539 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
6540 next unless -f $bfile;
6541 my $foundv = MM->parse_version($bfile);
6542 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
6543 $self->{INST_FILE} = $bfile;
6544 $self->{INST_VERSION} = $bestv = $foundv;
6550 #-> sub CPAN::Bundle::inst_version ;
6553 $self->inst_file; # finds INST_VERSION as side effect
6554 $self->{INST_VERSION};
6557 #-> sub CPAN::Bundle::rematein ;
6559 my($self,$meth) = @_;
6560 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
6561 my($id) = $self->id;
6562 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
6563 unless $self->inst_file || $self->cpan_file;
6565 for $s ($self->contains) {
6566 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
6567 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
6568 if ($type eq 'CPAN::Distribution') {
6569 $CPAN::Frontend->mywarn(qq{
6570 The Bundle }.$self->id.qq{ contains
6571 explicitly a file $s.
6573 $CPAN::Frontend->mysleep(3);
6575 # possibly noisy action:
6576 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
6577 my $obj = $CPAN::META->instance($type,$s);
6579 if ($obj->isa('CPAN::Bundle')
6581 exists $obj->{install_failed}
6583 ref($obj->{install_failed}) eq "HASH"
6585 for (keys %{$obj->{install_failed}}) {
6586 $self->{install_failed}{$_} = undef; # propagate faiure up
6589 $fail{$s} = 1; # the bundle itself may have succeeded but
6594 $success = $obj->can("uptodate") ? $obj->uptodate : 0;
6595 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
6597 delete $self->{install_failed}{$s};
6604 # recap with less noise
6605 if ( $meth eq "install" ) {
6608 my $raw = sprintf(qq{Bundle summary:
6609 The following items in bundle %s had installation problems:},
6612 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
6613 $CPAN::Frontend->myprint("\n");
6616 for $s ($self->contains) {
6618 $paragraph .= "$s ";
6619 $self->{install_failed}{$s} = undef;
6620 $reported{$s} = undef;
6623 my $report_propagated;
6624 for $s (sort keys %{$self->{install_failed}}) {
6625 next if exists $reported{$s};
6626 $paragraph .= "and the following items had problems
6627 during recursive bundle calls: " unless $report_propagated++;
6628 $paragraph .= "$s ";
6630 $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
6631 $CPAN::Frontend->myprint("\n");
6633 $self->{'install'} = 'YES';
6638 # If a bundle contains another that contains an xs_file we have here,
6639 # we just don't bother I suppose
6640 #-> sub CPAN::Bundle::xs_file
6645 #-> sub CPAN::Bundle::force ;
6646 sub force { shift->rematein('force',@_); }
6647 #-> sub CPAN::Bundle::notest ;
6648 sub notest { shift->rematein('notest',@_); }
6649 #-> sub CPAN::Bundle::get ;
6650 sub get { shift->rematein('get',@_); }
6651 #-> sub CPAN::Bundle::make ;
6652 sub make { shift->rematein('make',@_); }
6653 #-> sub CPAN::Bundle::test ;
6656 $self->{badtestcnt} ||= 0;
6657 $self->rematein('test',@_);
6659 #-> sub CPAN::Bundle::install ;
6662 $self->rematein('install',@_);
6664 #-> sub CPAN::Bundle::clean ;
6665 sub clean { shift->rematein('clean',@_); }
6667 #-> sub CPAN::Bundle::uptodate ;
6670 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
6672 foreach $c ($self->contains) {
6673 my $obj = CPAN::Shell->expandany($c);
6674 return 0 unless $obj->uptodate;
6679 #-> sub CPAN::Bundle::readme ;
6682 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
6683 No File found for bundle } . $self->id . qq{\n}), return;
6684 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
6685 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
6688 package CPAN::Module;
6692 # sub CPAN::Module::userid
6697 return $ro->{userid} || $ro->{CPAN_USERID};
6699 # sub CPAN::Module::description
6702 my $ro = $self->ro or return "";
6708 CPAN::Shell->expand("Distribution",$self->cpan_file);
6711 # sub CPAN::Module::undelay
6714 delete $self->{later};
6715 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
6720 # mark as dirty/clean
6721 #-> sub CPAN::Module::color_cmd_tmps ;
6722 sub color_cmd_tmps {
6724 my($depth) = shift || 0;
6725 my($color) = shift || 0;
6726 my($ancestors) = shift || [];
6727 # a module needs to recurse to its cpan_file
6729 return if exists $self->{incommandcolor}
6730 && $self->{incommandcolor}==$color;
6731 return if $depth>=1 && $self->uptodate;
6733 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
6735 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
6737 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
6738 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
6741 delete $self->{badtestcnt};
6743 $self->{incommandcolor} = $color;
6746 #-> sub CPAN::Module::as_glimpse ;
6750 my $class = ref($self);
6751 $class =~ s/^CPAN:://;
6755 $CPAN::Shell::COLOR_REGISTERED
6757 $CPAN::META->has_inst("Term::ANSIColor")
6761 $color_on = Term::ANSIColor::color("green");
6762 $color_off = Term::ANSIColor::color("reset");
6764 my $uptodateness = " ";
6765 if ($class eq "Bundle") {
6766 } elsif ($self->uptodate) {
6767 $uptodateness = "=";
6768 } elsif ($self->inst_version) {
6769 $uptodateness = "<";
6771 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
6777 ($self->distribution ?
6778 $self->distribution->pretty_id :
6785 #-> sub CPAN::Module::dslip_status
6789 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
6790 pre-alpha alpha beta released
6792 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
6793 developer comp.lang.perl.*
6795 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
6796 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
6798 object-oriented pragma
6800 @{$stat->{P}}{qw,p g l b a o d r n,} = qw,Standard-Perl
6804 distribution_allowed
6805 restricted_distribution
6807 for my $x (qw(d s l i p)) {
6808 $stat->{$x}{' '} = 'unknown';
6809 $stat->{$x}{'?'} = 'unknown';
6812 return +{} unless $ro && $ro->{statd};
6819 DV => $stat->{D}{$ro->{statd}},
6820 SV => $stat->{S}{$ro->{stats}},
6821 LV => $stat->{L}{$ro->{statl}},
6822 IV => $stat->{I}{$ro->{stati}},
6823 PV => $stat->{P}{$ro->{statp}},
6827 #-> sub CPAN::Module::as_string ;
6831 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
6832 my $class = ref($self);
6833 $class =~ s/^CPAN:://;
6835 push @m, $class, " id = $self->{ID}\n";
6836 my $sprintf = " %-12s %s\n";
6837 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
6838 if $self->description;
6839 my $sprintf2 = " %-12s %s (%s)\n";
6841 $userid = $self->userid;
6844 if ($author = CPAN::Shell->expand('Author',$userid)) {
6847 if ($m = $author->email) {
6854 $author->fullname . $email
6858 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
6859 if $self->cpan_version;
6860 if (my $cpan_file = $self->cpan_file){
6861 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
6862 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
6863 my $upload_date = $dist->upload_date;
6865 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
6869 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
6870 my $dslip = $self->dslip_status;
6874 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
6876 my $local_file = $self->inst_file;
6877 unless ($self->{MANPAGE}) {
6880 $manpage = $self->manpage_headline($local_file);
6882 # If we have already untarred it, we should look there
6883 my $dist = $CPAN::META->instance('CPAN::Distribution',
6885 # warn "dist[$dist]";
6886 # mff=manifest file; mfh=manifest handle
6891 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
6893 $mfh = FileHandle->new($mff)
6895 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
6896 my $lfre = $self->id; # local file RE
6899 my($lfl); # local file file
6901 my(@mflines) = <$mfh>;
6906 while (length($lfre)>5 and !$lfl) {
6907 ($lfl) = grep /$lfre/, @mflines;
6908 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
6911 $lfl =~ s/\s.*//; # remove comments
6912 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
6913 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
6914 # warn "lfl_abs[$lfl_abs]";
6916 $manpage = $self->manpage_headline($lfl_abs);
6920 $self->{MANPAGE} = $manpage if $manpage;
6923 for $item (qw/MANPAGE/) {
6924 push @m, sprintf($sprintf, $item, $self->{$item})
6925 if exists $self->{$item};
6927 for $item (qw/CONTAINS/) {
6928 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
6929 if exists $self->{$item} && @{$self->{$item}};
6931 push @m, sprintf($sprintf, 'INST_FILE',
6932 $local_file || "(not installed)");
6933 push @m, sprintf($sprintf, 'INST_VERSION',
6934 $self->inst_version) if $local_file;
6938 sub manpage_headline {
6939 my($self,$local_file) = @_;
6940 my(@local_file) = $local_file;
6941 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
6942 push @local_file, $local_file;
6944 for $locf (@local_file) {
6945 next unless -f $locf;
6946 my $fh = FileHandle->new($locf)
6947 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
6951 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
6952 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
6969 #-> sub CPAN::Module::cpan_file ;
6970 # Note: also inherited by CPAN::Bundle
6973 CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
6974 unless ($self->ro) {
6975 CPAN::Index->reload;
6978 if ($ro && defined $ro->{CPAN_FILE}){
6979 return $ro->{CPAN_FILE};
6981 my $userid = $self->userid;
6983 if ($CPAN::META->exists("CPAN::Author",$userid)) {
6984 my $author = $CPAN::META->instance("CPAN::Author",
6986 my $fullname = $author->fullname;
6987 my $email = $author->email;
6988 unless (defined $fullname && defined $email) {
6989 return sprintf("Contact Author %s",
6993 return "Contact Author $fullname <$email>";
6995 return "Contact Author $userid (Email address not available)";
7003 #-> sub CPAN::Module::cpan_version ;
7009 # Can happen with modules that are not on CPAN
7012 $ro->{CPAN_VERSION} = 'undef'
7013 unless defined $ro->{CPAN_VERSION};
7014 $ro->{CPAN_VERSION};
7017 #-> sub CPAN::Module::force ;
7020 $self->{'force_update'}++;
7025 # warn "XDEBUG: set notest for Module";
7026 $self->{'notest'}++;
7029 #-> sub CPAN::Module::rematein ;
7031 my($self,$meth) = @_;
7032 $CPAN::Frontend->myprint(sprintf("Running %s for module %s\n",
7035 my $cpan_file = $self->cpan_file;
7036 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
7037 $CPAN::Frontend->mywarn(sprintf qq{
7038 The module %s isn\'t available on CPAN.
7040 Either the module has not yet been uploaded to CPAN, or it is
7041 temporary unavailable. Please contact the author to find out
7042 more about the status. Try 'i %s'.
7049 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
7050 $pack->called_for($self->id);
7051 $pack->force($meth) if exists $self->{'force_update'};
7052 $pack->notest($meth) if exists $self->{'notest'};
7057 $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
7058 $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
7059 delete $self->{'force_update'};
7060 delete $self->{'notest'};
7066 #-> sub CPAN::Module::perldoc ;
7067 sub perldoc { shift->rematein('perldoc') }
7068 #-> sub CPAN::Module::readme ;
7069 sub readme { shift->rematein('readme') }
7070 #-> sub CPAN::Module::look ;
7071 sub look { shift->rematein('look') }
7072 #-> sub CPAN::Module::cvs_import ;
7073 sub cvs_import { shift->rematein('cvs_import') }
7074 #-> sub CPAN::Module::get ;
7075 sub get { shift->rematein('get',@_) }
7076 #-> sub CPAN::Module::make ;
7077 sub make { shift->rematein('make') }
7078 #-> sub CPAN::Module::test ;
7081 $self->{badtestcnt} ||= 0;
7082 $self->rematein('test',@_);
7084 #-> sub CPAN::Module::uptodate ;
7087 local($_); # protect against a bug in MakeMaker 6.17
7088 my($latest) = $self->cpan_version;
7090 my($inst_file) = $self->inst_file;
7092 if (defined $inst_file) {
7093 $have = $self->inst_version;
7098 ! CPAN::Version->vgt($latest, $have)
7100 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
7101 "latest[$latest] have[$have]") if $CPAN::DEBUG;
7106 #-> sub CPAN::Module::install ;
7112 not exists $self->{'force_update'}
7114 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
7116 $self->inst_version,
7122 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
7123 $CPAN::Frontend->mywarn(qq{
7124 \n\n\n ***WARNING***
7125 The module $self->{ID} has no active maintainer.\n\n\n
7127 $CPAN::Frontend->mysleep(5);
7129 $self->rematein('install') if $doit;
7131 #-> sub CPAN::Module::clean ;
7132 sub clean { shift->rematein('clean') }
7134 #-> sub CPAN::Module::inst_file ;
7138 @packpath = split /::/, $self->{ID};
7139 $packpath[-1] .= ".pm";
7140 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
7141 unshift @packpath, "Term", "ReadLine"; # historical reasons
7143 foreach $dir (@INC) {
7144 my $pmfile = File::Spec->catfile($dir,@packpath);
7152 #-> sub CPAN::Module::xs_file ;
7156 @packpath = split /::/, $self->{ID};
7157 push @packpath, $packpath[-1];
7158 $packpath[-1] .= "." . $Config::Config{'dlext'};
7159 foreach $dir (@INC) {
7160 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
7168 #-> sub CPAN::Module::inst_version ;
7171 my $parsefile = $self->inst_file or return;
7172 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
7175 $have = MM->parse_version($parsefile) || "undef";
7176 $have =~ s/^ //; # since the %vd hack these two lines here are needed
7177 $have =~ s/ $//; # trailing whitespace happens all the time
7179 # My thoughts about why %vd processing should happen here
7181 # Alt1 maintain it as string with leading v:
7182 # read index files do nothing
7183 # compare it use utility for compare
7184 # print it do nothing
7186 # Alt2 maintain it as what it is
7187 # read index files convert
7188 # compare it use utility because there's still a ">" vs "gt" issue
7189 # print it use CPAN::Version for print
7191 # Seems cleaner to hold it in memory as a string starting with a "v"
7193 # If the author of this module made a mistake and wrote a quoted
7194 # "v1.13" instead of v1.13, we simply leave it at that with the
7195 # effect that *we* will treat it like a v-tring while the rest of
7196 # perl won't. Seems sensible when we consider that any action we
7197 # could take now would just add complexity.
7199 $have = CPAN::Version->readable($have);
7201 $have =~ s/\s*//g; # stringify to float around floating point issues
7202 $have; # no stringify needed, \s* above matches always
7215 CPAN - query, download and build perl modules from CPAN sites
7221 perl -MCPAN -e shell;
7229 $mod = "Acme::Meta";
7231 CPAN::Shell->install($mod); # same thing
7232 CPAN::Shell->expandany($mod)->install; # same thing
7233 CPAN::Shell->expand("Module",$mod)->install; # same thing
7234 CPAN::Shell->expand("Module",$mod)
7235 ->distribution->install; # same thing
7239 $distro = "NWCLARK/Acme-Meta-0.01.tar.gz";
7240 install $distro; # same thing
7241 CPAN::Shell->install($distro); # same thing
7242 CPAN::Shell->expandany($distro)->install; # same thing
7243 CPAN::Shell->expand("Distribution",$distro)->install; # same thing
7247 This module will eventually be replaced by CPANPLUS. CPANPLUS is kind
7248 of a modern rewrite from ground up with greater extensibility and more
7249 features but no full compatibility. If you're new to CPAN.pm, you
7250 probably should investigate if CPANPLUS is the better choice for you.
7252 If you're already used to CPAN.pm you're welcome to continue using it.
7253 I intend to support it until somebody convinces me that there is a
7254 both superior and sufficiently compatible drop-in replacement.
7256 =head1 COMPATIBILITY
7258 CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
7259 newer versions. It is getting more and more difficult to get the
7260 minimal prerequisites working on older perls. It is close to
7261 impossible to get the whole Bundle::CPAN working there. If you're in
7262 the position to have only these old versions, be advised that CPAN is
7263 designed to work fine without the Bundle::CPAN installed.
7265 To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
7266 compatible with ancient perls and that File::Temp is listed as a
7267 prerequisite but CPAN has reasonable workarounds if it is missing.
7271 The CPAN module is designed to automate the make and install of perl
7272 modules and extensions. It includes some primitive searching
7273 capabilities and knows how to use Net::FTP or LWP (or some external
7274 download clients) to fetch the raw data from the net.
7276 Modules are fetched from one or more of the mirrored CPAN
7277 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
7280 The CPAN module also supports the concept of named and versioned
7281 I<bundles> of modules. Bundles simplify the handling of sets of
7282 related modules. See Bundles below.
7284 The package contains a session manager and a cache manager. There is
7285 no status retained between sessions. The session manager keeps track
7286 of what has been fetched, built and installed in the current
7287 session. The cache manager keeps track of the disk space occupied by
7288 the make processes and deletes excess space according to a simple FIFO
7291 All methods provided are accessible in a programmer style and in an
7292 interactive shell style.
7294 =head2 Interactive Mode
7296 The interactive mode is entered by running
7298 perl -MCPAN -e shell
7300 which puts you into a readline interface. You will have the most fun if
7301 you install Term::ReadKey and Term::ReadLine to enjoy both history and
7304 Once you are on the command line, type 'h' and the rest should be
7307 The function call C<shell> takes two optional arguments, one is the
7308 prompt, the second is the default initial command line (the latter
7309 only works if a real ReadLine interface module is installed).
7311 The most common uses of the interactive modes are
7315 =item Searching for authors, bundles, distribution files and modules
7317 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
7318 for each of the four categories and another, C<i> for any of the
7319 mentioned four. Each of the four entities is implemented as a class
7320 with slightly differing methods for displaying an object.
7322 Arguments you pass to these commands are either strings exactly matching
7323 the identification string of an object or regular expressions that are
7324 then matched case-insensitively against various attributes of the
7325 objects. The parser recognizes a regular expression only if you
7326 enclose it between two slashes.
7328 The principle is that the number of found objects influences how an
7329 item is displayed. If the search finds one item, the result is
7330 displayed with the rather verbose method C<as_string>, but if we find
7331 more than one, we display each object with the terse method
7334 =item make, test, install, clean modules or distributions
7336 These commands take any number of arguments and investigate what is
7337 necessary to perform the action. If the argument is a distribution
7338 file name (recognized by embedded slashes), it is processed. If it is
7339 a module, CPAN determines the distribution file in which this module
7340 is included and processes that, following any dependencies named in
7341 the module's META.yml or Makefile.PL (this behavior is controlled by
7342 the configuration parameter C<prerequisites_policy>.)
7344 Any C<make> or C<test> are run unconditionally. An
7346 install <distribution_file>
7348 also is run unconditionally. But for
7352 CPAN checks if an install is actually needed for it and prints
7353 I<module up to date> in the case that the distribution file containing
7354 the module doesn't need to be updated.
7356 CPAN also keeps track of what it has done within the current session
7357 and doesn't try to build a package a second time regardless if it
7358 succeeded or not. The C<force> pragma may precede another command
7359 (currently: C<make>, C<test>, or C<install>) and executes the
7360 command from scratch and tries to continue in case of some errors.
7364 cpan> install OpenGL
7365 OpenGL is up to date.
7366 cpan> force install OpenGL
7369 OpenGL-0.4/COPYRIGHT
7372 The C<notest> pragma may be set to skip the test part in the build
7377 cpan> notest install Tk
7379 A C<clean> command results in a
7383 being executed within the distribution file's working directory.
7385 =item get, readme, perldoc, look module or distribution
7387 C<get> downloads a distribution file without further action. C<readme>
7388 displays the README file of the associated distribution. C<Look> gets
7389 and untars (if not yet done) the distribution file, changes to the
7390 appropriate directory and opens a subshell process in that directory.
7391 C<perldoc> displays the pod documentation of the module in html or
7396 =item ls globbing_expression
7398 The first form lists all distribution files in and below an author's
7399 CPAN directory as they are stored in the CHECKUMS files distributed on
7400 CPAN. The listing goes recursive into all subdirectories.
7402 The second form allows to limit or expand the output with shell
7403 globbing as in the following examples:
7409 The last example is very slow and outputs extra progress indicators
7410 that break the alignment of the result.
7412 Note that globbing only lists directories explicitly asked for, for
7413 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
7414 regarded as a bug and may be changed in future versions.
7418 The C<failed> command reports all distributions that failed on one of
7419 C<make>, C<test> or C<install> for some reason in the currently
7420 running shell session.
7424 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>
7425 (but the directory can be configured via the C<cpan_home> config
7426 variable). The shell is a bit picky if you try to start another CPAN
7427 session. It dies immediately if there is a lockfile and the lock seems
7428 to belong to a running process. In case you want to run a second shell
7429 session, it is probably safest to maintain another directory, say
7430 C<~/.cpan-for-X/> and a C<~/.cpan-for-X/CPAN/MyConfig.pm> that
7431 contains the configuration options. Then you can start the second
7434 perl -I ~/.cpan-for-X -MCPAN::MyConfig -MCPAN -e shell
7438 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
7439 in the cpan-shell it is intended that you can press C<^C> anytime and
7440 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
7441 to clean up and leave the shell loop. You can emulate the effect of a
7442 SIGTERM by sending two consecutive SIGINTs, which usually means by
7443 pressing C<^C> twice.
7445 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
7446 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
7447 Build.PL> subprocess.
7453 The commands that are available in the shell interface are methods in
7454 the package CPAN::Shell. If you enter the shell command, all your
7455 input is split by the Text::ParseWords::shellwords() routine which
7456 acts like most shells do. The first word is being interpreted as the
7457 method to be called and the rest of the words are treated as arguments
7458 to this method. Continuation lines are supported if a line ends with a
7463 C<autobundle> writes a bundle file into the
7464 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
7465 a list of all modules that are both available from CPAN and currently
7466 installed within @INC. The name of the bundle file is based on the
7467 current date and a counter.
7471 recompile() is a very special command in that it takes no argument and
7472 runs the make/test/install cycle with brute force over all installed
7473 dynamically loadable extensions (aka XS modules) with 'force' in
7474 effect. The primary purpose of this command is to finish a network
7475 installation. Imagine, you have a common source tree for two different
7476 architectures. You decide to do a completely independent fresh
7477 installation. You start on one architecture with the help of a Bundle
7478 file produced earlier. CPAN installs the whole Bundle for you, but
7479 when you try to repeat the job on the second architecture, CPAN
7480 responds with a C<"Foo up to date"> message for all modules. So you
7481 invoke CPAN's recompile on the second architecture and you're done.
7483 Another popular use for C<recompile> is to act as a rescue in case your
7484 perl breaks binary compatibility. If one of the modules that CPAN uses
7485 is in turn depending on binary compatibility (so you cannot run CPAN
7486 commands), then you should try the CPAN::Nox module for recovery.
7490 The C<upgrade> command first runs an C<r> command and then installs
7491 the newest versions of all modules that were listed by that.
7495 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
7496 directory so that you can save your own preferences instead of the
7499 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
7501 Although it may be considered internal, the class hierarchy does matter
7502 for both users and programmer. CPAN.pm deals with above mentioned four
7503 classes, and all those classes share a set of methods. A classical
7504 single polymorphism is in effect. A metaclass object registers all
7505 objects of all kinds and indexes them with a string. The strings
7506 referencing objects have a separated namespace (well, not completely
7511 words containing a "/" (slash) Distribution
7512 words starting with Bundle:: Bundle
7513 everything else Module or Author
7515 Modules know their associated Distribution objects. They always refer
7516 to the most recent official release. Developers may mark their releases
7517 as unstable development versions (by inserting an underbar into the
7518 module version number which will also be reflected in the distribution
7519 name when you run 'make dist'), so the really hottest and newest
7520 distribution is not always the default. If a module Foo circulates
7521 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
7522 way to install version 1.23 by saying
7526 This would install the complete distribution file (say
7527 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
7528 like to install version 1.23_90, you need to know where the
7529 distribution file resides on CPAN relative to the authors/id/
7530 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
7531 so you would have to say
7533 install BAR/Foo-1.23_90.tar.gz
7535 The first example will be driven by an object of the class
7536 CPAN::Module, the second by an object of class CPAN::Distribution.
7538 =head2 Programmer's interface
7540 If you do not enter the shell, the available shell commands are both
7541 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
7542 functions in the calling package (C<install(...)>).
7544 There's currently only one class that has a stable interface -
7545 CPAN::Shell. All commands that are available in the CPAN shell are
7546 methods of the class CPAN::Shell. Each of the commands that produce
7547 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
7548 the IDs of all modules within the list.
7552 =item expand($type,@things)
7554 The IDs of all objects available within a program are strings that can
7555 be expanded to the corresponding real objects with the
7556 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
7557 list of CPAN::Module objects according to the C<@things> arguments
7558 given. In scalar context it only returns the first element of the
7561 =item expandany(@things)
7563 Like expand, but returns objects of the appropriate type, i.e.
7564 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
7565 CPAN::Distribution objects for distributions. Note: it does not expand
7566 to CPAN::Author objects.
7568 =item Programming Examples
7570 This enables the programmer to do operations that combine
7571 functionalities that are available in the shell.
7573 # install everything that is outdated on my disk:
7574 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
7576 # install my favorite programs if necessary:
7577 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
7578 my $obj = CPAN::Shell->expand('Module',$mod);
7582 # list all modules on my disk that have no VERSION number
7583 for $mod (CPAN::Shell->expand("Module","/./")){
7584 next unless $mod->inst_file;
7585 # MakeMaker convention for undefined $VERSION:
7586 next unless $mod->inst_version eq "undef";
7587 print "No VERSION in ", $mod->id, "\n";
7590 # find out which distribution on CPAN contains a module:
7591 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
7593 Or if you want to write a cronjob to watch The CPAN, you could list
7594 all modules that need updating. First a quick and dirty way:
7596 perl -e 'use CPAN; CPAN::Shell->r;'
7598 If you don't want to get any output in the case that all modules are
7599 up to date, you can parse the output of above command for the regular
7600 expression //modules are up to date// and decide to mail the output
7601 only if it doesn't match. Ick?
7603 If you prefer to do it more in a programmer style in one single
7604 process, maybe something like this suits you better:
7606 # list all modules on my disk that have newer versions on CPAN
7607 for $mod (CPAN::Shell->expand("Module","/./")){
7608 next unless $mod->inst_file;
7609 next if $mod->uptodate;
7610 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
7611 $mod->id, $mod->inst_version, $mod->cpan_version;
7614 If that gives you too much output every day, you maybe only want to
7615 watch for three modules. You can write
7617 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
7619 as the first line instead. Or you can combine some of the above
7622 # watch only for a new mod_perl module
7623 $mod = CPAN::Shell->expand("Module","mod_perl");
7624 exit if $mod->uptodate;
7625 # new mod_perl arrived, let me know all update recommendations
7630 =head2 Methods in the other Classes
7632 The programming interface for the classes CPAN::Module,
7633 CPAN::Distribution, CPAN::Bundle, and CPAN::Author is still considered
7634 beta and partially even alpha. In the following paragraphs only those
7635 methods are documented that have proven useful over a longer time and
7636 thus are unlikely to change.
7640 =item CPAN::Author::as_glimpse()
7642 Returns a one-line description of the author
7644 =item CPAN::Author::as_string()
7646 Returns a multi-line description of the author
7648 =item CPAN::Author::email()
7650 Returns the author's email address
7652 =item CPAN::Author::fullname()
7654 Returns the author's name
7656 =item CPAN::Author::name()
7658 An alias for fullname
7660 =item CPAN::Bundle::as_glimpse()
7662 Returns a one-line description of the bundle
7664 =item CPAN::Bundle::as_string()
7666 Returns a multi-line description of the bundle
7668 =item CPAN::Bundle::clean()
7670 Recursively runs the C<clean> method on all items contained in the bundle.
7672 =item CPAN::Bundle::contains()
7674 Returns a list of objects' IDs contained in a bundle. The associated
7675 objects may be bundles, modules or distributions.
7677 =item CPAN::Bundle::force($method,@args)
7679 Forces CPAN to perform a task that normally would have failed. Force
7680 takes as arguments a method name to be called and any number of
7681 additional arguments that should be passed to the called method. The
7682 internals of the object get the needed changes so that CPAN.pm does
7683 not refuse to take the action. The C<force> is passed recursively to
7684 all contained objects.
7686 =item CPAN::Bundle::get()
7688 Recursively runs the C<get> method on all items contained in the bundle
7690 =item CPAN::Bundle::inst_file()
7692 Returns the highest installed version of the bundle in either @INC or
7693 C<$CPAN::Config->{cpan_home}>. Note that this is different from
7694 CPAN::Module::inst_file.
7696 =item CPAN::Bundle::inst_version()
7698 Like CPAN::Bundle::inst_file, but returns the $VERSION
7700 =item CPAN::Bundle::uptodate()
7702 Returns 1 if the bundle itself and all its members are uptodate.
7704 =item CPAN::Bundle::install()
7706 Recursively runs the C<install> method on all items contained in the bundle
7708 =item CPAN::Bundle::make()
7710 Recursively runs the C<make> method on all items contained in the bundle
7712 =item CPAN::Bundle::readme()
7714 Recursively runs the C<readme> method on all items contained in the bundle
7716 =item CPAN::Bundle::test()
7718 Recursively runs the C<test> method on all items contained in the bundle
7720 =item CPAN::Distribution::as_glimpse()
7722 Returns a one-line description of the distribution
7724 =item CPAN::Distribution::as_string()
7726 Returns a multi-line description of the distribution
7728 =item CPAN::Distribution::author
7730 Returns the CPAN::Author object of the maintainer who uploaded this
7733 =item CPAN::Distribution::clean()
7735 Changes to the directory where the distribution has been unpacked and
7736 runs C<make clean> there.
7738 =item CPAN::Distribution::containsmods()
7740 Returns a list of IDs of modules contained in a distribution file.
7741 Only works for distributions listed in the 02packages.details.txt.gz
7742 file. This typically means that only the most recent version of a
7743 distribution is covered.
7745 =item CPAN::Distribution::cvs_import()
7747 Changes to the directory where the distribution has been unpacked and
7750 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
7754 =item CPAN::Distribution::dir()
7756 Returns the directory into which this distribution has been unpacked.
7758 =item CPAN::Distribution::force($method,@args)
7760 Forces CPAN to perform a task that normally would have failed. Force
7761 takes as arguments a method name to be called and any number of
7762 additional arguments that should be passed to the called method. The
7763 internals of the object get the needed changes so that CPAN.pm does
7764 not refuse to take the action.
7766 =item CPAN::Distribution::get()
7768 Downloads the distribution from CPAN and unpacks it. Does nothing if
7769 the distribution has already been downloaded and unpacked within the
7772 =item CPAN::Distribution::install()
7774 Changes to the directory where the distribution has been unpacked and
7775 runs the external command C<make install> there. If C<make> has not
7776 yet been run, it will be run first. A C<make test> will be issued in
7777 any case and if this fails, the install will be canceled. The
7778 cancellation can be avoided by letting C<force> run the C<install> for
7781 Note that install() gives no meaningful return value. See uptodate().
7783 =item CPAN::Distribution::isa_perl()
7785 Returns 1 if this distribution file seems to be a perl distribution.
7786 Normally this is derived from the file name only, but the index from
7787 CPAN can contain a hint to achieve a return value of true for other
7790 =item CPAN::Distribution::look()
7792 Changes to the directory where the distribution has been unpacked and
7793 opens a subshell there. Exiting the subshell returns.
7795 =item CPAN::Distribution::make()
7797 First runs the C<get> method to make sure the distribution is
7798 downloaded and unpacked. Changes to the directory where the
7799 distribution has been unpacked and runs the external commands C<perl
7800 Makefile.PL> or C<perl Build.PL> and C<make> there.
7802 =item CPAN::Distribution::perldoc()
7804 Downloads the pod documentation of the file associated with a
7805 distribution (in html format) and runs it through the external
7806 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
7807 isn't available, it converts it to plain text with external
7808 command html2text and runs it through the pager specified
7809 in C<$CPAN::Config->{pager}>
7811 =item CPAN::Distribution::prereq_pm()
7813 Returns the hash reference that has been announced by a distribution
7814 as the merge of the C<requires> element and the C<build_requires>
7815 element of the META.yml or the C<PREREQ_PM> hash in the
7816 C<Makefile.PL>. Note: works only after an attempt has been made to
7817 C<make> the distribution. Returns undef otherwise.
7819 =item CPAN::Distribution::readme()
7821 Downloads the README file associated with a distribution and runs it
7822 through the pager specified in C<$CPAN::Config->{pager}>.
7824 =item CPAN::Distribution::read_yaml()
7826 Returns the content of the META.yml of this distro as a hashref. Note:
7827 works only after an attempt has been made to C<make> the distribution.
7828 Returns undef otherwise.
7830 =item CPAN::Distribution::test()
7832 Changes to the directory where the distribution has been unpacked and
7833 runs C<make test> there.
7835 =item CPAN::Distribution::uptodate()
7837 Returns 1 if all the modules contained in the distribution are
7838 uptodate. Relies on containsmods.
7840 =item CPAN::Index::force_reload()
7842 Forces a reload of all indices.
7844 =item CPAN::Index::reload()
7846 Reloads all indices if they have not been read for more than
7847 C<$CPAN::Config->{index_expire}> days.
7849 =item CPAN::InfoObj::dump()
7851 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
7852 inherit this method. It prints the data structure associated with an
7853 object. Useful for debugging. Note: the data structure is considered
7854 internal and thus subject to change without notice.
7856 =item CPAN::Module::as_glimpse()
7858 Returns a one-line description of the module in four columns: The
7859 first column contains the word C<Module>, the second column consists
7860 of one character: an equals sign if this module is already installed
7861 and uptodate, a less-than sign if this module is installed but can be
7862 upgraded, and a space if the module is not installed. The third column
7863 is the name of the module and the fourth column gives maintainer or
7864 distribution information.
7866 =item CPAN::Module::as_string()
7868 Returns a multi-line description of the module
7870 =item CPAN::Module::clean()
7872 Runs a clean on the distribution associated with this module.
7874 =item CPAN::Module::cpan_file()
7876 Returns the filename on CPAN that is associated with the module.
7878 =item CPAN::Module::cpan_version()
7880 Returns the latest version of this module available on CPAN.
7882 =item CPAN::Module::cvs_import()
7884 Runs a cvs_import on the distribution associated with this module.
7886 =item CPAN::Module::description()
7888 Returns a 44 character description of this module. Only available for
7889 modules listed in The Module List (CPAN/modules/00modlist.long.html
7890 or 00modlist.long.txt.gz)
7892 =item CPAN::Module::distribution()
7894 Returns the CPAN::Distribution object that contains the current
7895 version of this module.
7897 =item CPAN::Module::dslip_status()
7899 Returns a hash reference. The keys of the hash are the letters C<D>,
7900 C<S>, C<L>, C<I>, and <P>, for development status, support level,
7901 language, interface and public licence respectively. The data for the
7902 DSLIP status are collected by pause.perl.org when authors register
7903 their namespaces. The values of the 5 hash elements are one-character
7904 words whose meaning is described in the table below. There are also 5
7905 hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
7906 verbose value of the 5 status variables.
7908 Where the 'DSLIP' characters have the following meanings:
7910 D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
7911 i - Idea, listed to gain consensus or as a placeholder
7912 c - under construction but pre-alpha (not yet released)
7913 a/b - Alpha/Beta testing
7915 M - Mature (no rigorous definition)
7916 S - Standard, supplied with Perl 5
7921 u - Usenet newsgroup comp.lang.perl.modules
7922 n - None known, try comp.lang.perl.modules
7923 a - abandoned; volunteers welcome to take over maintainance
7926 p - Perl-only, no compiler needed, should be platform independent
7927 c - C and perl, a C compiler will be needed
7928 h - Hybrid, written in perl with optional C code, no compiler needed
7929 + - C++ and perl, a C++ compiler will be needed
7930 o - perl and another language other than C or C++
7933 f - plain Functions, no references used
7934 h - hybrid, object and function interfaces available
7935 n - no interface at all (huh?)
7936 r - some use of unblessed References or ties
7937 O - Object oriented using blessed references and/or inheritance
7940 p - Standard-Perl: user may choose between GPL and Artistic
7941 g - GPL: GNU General Public License
7942 l - LGPL: "GNU Lesser General Public License" (previously known as
7943 "GNU Library General Public License")
7944 b - BSD: The BSD License
7945 a - Artistic license alone
7946 o - open source: appoved by www.opensource.org
7947 d - allows distribution without restrictions
7948 r - restricted distribtion
7949 n - no license at all
7951 =item CPAN::Module::force($method,@args)
7953 Forces CPAN to perform a task that normally would have failed. Force
7954 takes as arguments a method name to be called and any number of
7955 additional arguments that should be passed to the called method. The
7956 internals of the object get the needed changes so that CPAN.pm does
7957 not refuse to take the action.
7959 =item CPAN::Module::get()
7961 Runs a get on the distribution associated with this module.
7963 =item CPAN::Module::inst_file()
7965 Returns the filename of the module found in @INC. The first file found
7966 is reported just like perl itself stops searching @INC when it finds a
7969 =item CPAN::Module::inst_version()
7971 Returns the version number of the module in readable format.
7973 =item CPAN::Module::install()
7975 Runs an C<install> on the distribution associated with this module.
7977 =item CPAN::Module::look()
7979 Changes to the directory where the distribution associated with this
7980 module has been unpacked and opens a subshell there. Exiting the
7983 =item CPAN::Module::make()
7985 Runs a C<make> on the distribution associated with this module.
7987 =item CPAN::Module::manpage_headline()
7989 If module is installed, peeks into the module's manpage, reads the
7990 headline and returns it. Moreover, if the module has been downloaded
7991 within this session, does the equivalent on the downloaded module even
7992 if it is not installed.
7994 =item CPAN::Module::perldoc()
7996 Runs a C<perldoc> on this module.
7998 =item CPAN::Module::readme()
8000 Runs a C<readme> on the distribution associated with this module.
8002 =item CPAN::Module::test()
8004 Runs a C<test> on the distribution associated with this module.
8006 =item CPAN::Module::uptodate()
8008 Returns 1 if the module is installed and up-to-date.
8010 =item CPAN::Module::userid()
8012 Returns the author's ID of the module.
8016 =head2 Cache Manager
8018 Currently the cache manager only keeps track of the build directory
8019 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
8020 deletes complete directories below C<build_dir> as soon as the size of
8021 all directories there gets bigger than $CPAN::Config->{build_cache}
8022 (in MB). The contents of this cache may be used for later
8023 re-installations that you intend to do manually, but will never be
8024 trusted by CPAN itself. This is due to the fact that the user might
8025 use these directories for building modules on different architectures.
8027 There is another directory ($CPAN::Config->{keep_source_where}) where
8028 the original distribution files are kept. This directory is not
8029 covered by the cache manager and must be controlled by the user. If
8030 you choose to have the same directory as build_dir and as
8031 keep_source_where directory, then your sources will be deleted with
8032 the same fifo mechanism.
8036 A bundle is just a perl module in the namespace Bundle:: that does not
8037 define any functions or methods. It usually only contains documentation.
8039 It starts like a perl module with a package declaration and a $VERSION
8040 variable. After that the pod section looks like any other pod with the
8041 only difference being that I<one special pod section> exists starting with
8046 In this pod section each line obeys the format
8048 Module_Name [Version_String] [- optional text]
8050 The only required part is the first field, the name of a module
8051 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
8052 of the line is optional. The comment part is delimited by a dash just
8053 as in the man page header.
8055 The distribution of a bundle should follow the same convention as
8056 other distributions.
8058 Bundles are treated specially in the CPAN package. If you say 'install
8059 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
8060 the modules in the CONTENTS section of the pod. You can install your
8061 own Bundles locally by placing a conformant Bundle file somewhere into
8062 your @INC path. The autobundle() command which is available in the
8063 shell interface does that for you by including all currently installed
8064 modules in a snapshot bundle file.
8066 =head2 Prerequisites
8068 If you have a local mirror of CPAN and can access all files with
8069 "file:" URLs, then you only need a perl better than perl5.003 to run
8070 this module. Otherwise Net::FTP is strongly recommended. LWP may be
8071 required for non-UNIX systems or if your nearest CPAN site is
8072 associated with a URL that is not C<ftp:>.
8074 If you have neither Net::FTP nor LWP, there is a fallback mechanism
8075 implemented for an external ftp command or for an external lynx
8078 =head2 Finding packages and VERSION
8080 This module presumes that all packages on CPAN
8086 declare their $VERSION variable in an easy to parse manner. This
8087 prerequisite can hardly be relaxed because it consumes far too much
8088 memory to load all packages into the running program just to determine
8089 the $VERSION variable. Currently all programs that are dealing with
8090 version use something like this
8092 perl -MExtUtils::MakeMaker -le \
8093 'print MM->parse_version(shift)' filename
8095 If you are author of a package and wonder if your $VERSION can be
8096 parsed, please try the above method.
8100 come as compressed or gzipped tarfiles or as zip files and contain a
8101 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
8102 without much enthusiasm).
8108 The debugging of this module is a bit complex, because we have
8109 interferences of the software producing the indices on CPAN, of the
8110 mirroring process on CPAN, of packaging, of configuration, of
8111 synchronicity, and of bugs within CPAN.pm.
8113 For code debugging in interactive mode you can try "o debug" which
8114 will list options for debugging the various parts of the code. You
8115 should know that "o debug" has built-in completion support.
8117 For data debugging there is the C<dump> command which takes the same
8118 arguments as make/test/install and outputs the object's Data::Dumper
8121 =head2 Floppy, Zip, Offline Mode
8123 CPAN.pm works nicely without network too. If you maintain machines
8124 that are not networked at all, you should consider working with file:
8125 URLs. Of course, you have to collect your modules somewhere first. So
8126 you might use CPAN.pm to put together all you need on a networked
8127 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
8128 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
8129 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
8130 with this floppy. See also below the paragraph about CD-ROM support.
8132 =head1 CONFIGURATION
8134 When the CPAN module is used for the first time, a configuration
8135 dialog tries to determine a couple of site specific options. The
8136 result of the dialog is stored in a hash reference C< $CPAN::Config >
8137 in a file CPAN/Config.pm.
8139 The default values defined in the CPAN/Config.pm file can be
8140 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
8141 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
8142 added to the search path of the CPAN module before the use() or
8143 require() statements.
8145 The configuration dialog can be started any time later again by
8146 issuing the command C< o conf init > in the CPAN shell. A subset of
8147 the configuration dialog can be run by issuing C<o conf init WORD>
8148 where WORD is any valid config variable or a regular expression.
8150 Currently the following keys in the hash reference $CPAN::Config are
8153 build_cache size of cache for directories to build modules
8154 build_dir locally accessible directory to build modules
8155 cache_metadata use serializer to cache metadata
8156 commands_quote prefered character to use for quoting external
8157 commands when running them. Defaults to double
8158 quote on Windows, single tick everywhere else;
8159 can be set to space to disable quoting
8160 check_sigs if signatures should be verified
8161 cpan_home local directory reserved for this package
8162 dontload_list arrayref: modules in the list will not be
8163 loaded by the CPAN::has_inst() routine
8165 gzip location of external program gzip
8166 histfile file to maintain history between sessions
8167 histsize maximum number of lines to keep in histfile
8168 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
8169 after this many seconds inactivity. Set to 0 to
8171 index_expire after this many days refetch index files
8172 inhibit_startup_message
8173 if true, does not print the startup message
8174 keep_source_where directory in which to keep the source (if we do)
8175 make location of external make program
8176 make_arg arguments that should always be passed to 'make'
8177 make_install_make_command
8178 the make command for running 'make install', for
8180 make_install_arg same as make_arg for 'make install'
8181 makepl_arg arguments passed to 'perl Makefile.PL'
8182 mbuild_arg arguments passed to './Build'
8183 mbuild_install_arg arguments passed to './Build install'
8184 mbuild_install_build_command
8185 command to use instead of './Build' when we are
8186 in the install stage, for example 'sudo ./Build'
8187 mbuildpl_arg arguments passed to 'perl Build.PL'
8188 pager location of external program more (or any pager)
8189 prefer_installer legal values are MB and EUMM: if a module comes
8190 with both a Makefile.PL and a Build.PL, use the
8191 former (EUMM) or the latter (MB); if the module
8192 comes with only one of the two, that one will be
8194 prerequisites_policy
8195 what to do if you are missing module prerequisites
8196 ('follow' automatically, 'ask' me, or 'ignore')
8197 proxy_user username for accessing an authenticating proxy
8198 proxy_pass password for accessing an authenticating proxy
8199 scan_cache controls scanning of cache ('atstart' or 'never')
8200 tar location of external program tar
8201 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
8202 (and nonsense for characters outside latin range)
8203 test_report email test reports (if CPAN::Reporter is installed)
8204 unzip location of external program unzip
8205 urllist arrayref to nearby CPAN sites (or equivalent locations)
8206 wait_list arrayref to a wait server to try (See CPAN::WAIT)
8207 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
8208 ftp_proxy, } the three usual variables for configuring
8209 http_proxy, } proxy requests. Both as CPAN::Config variables
8210 no_proxy } and as environment variables configurable.
8212 You can set and query each of these options interactively in the cpan
8213 shell with the command set defined within the C<o conf> command:
8217 =item C<o conf E<lt>scalar optionE<gt>>
8219 prints the current value of the I<scalar option>
8221 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
8223 Sets the value of the I<scalar option> to I<value>
8225 =item C<o conf E<lt>list optionE<gt>>
8227 prints the current value of the I<list option> in MakeMaker's
8230 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
8232 shifts or pops the array in the I<list option> variable
8234 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
8236 works like the corresponding perl commands.
8240 =head2 Note on config variable getcwd
8242 CPAN.pm changes the current working directory often and needs to
8243 determine its own current working directory. Per default it uses
8244 Cwd::cwd but if this doesn't work on your system for some reason,
8245 alternatives can be configured according to the following table:
8249 fastcwd Cwd::fastcwd
8250 backtickcwd external command cwd
8252 =head2 Note on urllist parameter's format
8254 urllist parameters are URLs according to RFC 1738. We do a little
8255 guessing if your URL is not compliant, but if you have problems with
8256 file URLs, please try the correct format. Either:
8258 file://localhost/whatever/ftp/pub/CPAN/
8262 file:///home/ftp/pub/CPAN/
8264 =head2 urllist parameter has CD-ROM support
8266 The C<urllist> parameter of the configuration table contains a list of
8267 URLs that are to be used for downloading. If the list contains any
8268 C<file> URLs, CPAN always tries to get files from there first. This
8269 feature is disabled for index files. So the recommendation for the
8270 owner of a CD-ROM with CPAN contents is: include your local, possibly
8271 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
8273 o conf urllist push file://localhost/CDROM/CPAN
8275 CPAN.pm will then fetch the index files from one of the CPAN sites
8276 that come at the beginning of urllist. It will later check for each
8277 module if there is a local copy of the most recent version.
8279 Another peculiarity of urllist is that the site that we could
8280 successfully fetch the last file from automatically gets a preference
8281 token and is tried as the first site for the next request. So if you
8282 add a new site at runtime it may happen that the previously preferred
8283 site will be tried another time. This means that if you want to disallow
8284 a site for the next transfer, it must be explicitly removed from
8289 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
8290 install foreign, unmasked, unsigned code on your machine. We compare
8291 to a checksum that comes from the net just as the distribution file
8292 itself. But we try to make it easy to add security on demand:
8294 =head2 Cryptographically signed modules
8296 Since release 1.77 CPAN.pm has been able to verify cryptographically
8297 signed module distributions using Module::Signature. The CPAN modules
8298 can be signed by their authors, thus giving more security. The simple
8299 unsigned MD5 checksums that were used before by CPAN protect mainly
8300 against accidental file corruption.
8302 You will need to have Module::Signature installed, which in turn
8303 requires that you have at least one of Crypt::OpenPGP module or the
8304 command-line F<gpg> tool installed.
8306 You will also need to be able to connect over the Internet to the public
8307 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
8309 The configuration parameter check_sigs is there to turn signature
8314 Most functions in package CPAN are exported per default. The reason
8315 for this is that the primary use is intended for the cpan shell or for
8320 When the CPAN shell enters a subshell via the look command, it sets
8321 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
8324 When the config variable ftp_passive is set, all downloads will be run
8325 with the environment variable FTP_PASSIVE set to this value. This is
8326 in general a good idea as it influences both Net::FTP and LWP based
8327 connections. The same effect can be achieved by starting the cpan
8328 shell with this environment variable set. For Net::FTP alone, one can
8329 also always set passive mode by running libnetcfg.
8331 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
8333 Populating a freshly installed perl with my favorite modules is pretty
8334 easy if you maintain a private bundle definition file. To get a useful
8335 blueprint of a bundle definition file, the command autobundle can be used
8336 on the CPAN shell command line. This command writes a bundle definition
8337 file for all modules that are installed for the currently running perl
8338 interpreter. It's recommended to run this command only once and from then
8339 on maintain the file manually under a private name, say
8340 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
8342 cpan> install Bundle::my_bundle
8344 then answer a few questions and then go out for a coffee.
8346 Maintaining a bundle definition file means keeping track of two
8347 things: dependencies and interactivity. CPAN.pm sometimes fails on
8348 calculating dependencies because not all modules define all MakeMaker
8349 attributes correctly, so a bundle definition file should specify
8350 prerequisites as early as possible. On the other hand, it's a bit
8351 annoying that many distributions need some interactive configuring. So
8352 what I try to accomplish in my private bundle file is to have the
8353 packages that need to be configured early in the file and the gentle
8354 ones later, so I can go out after a few minutes and leave CPAN.pm
8357 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
8359 Thanks to Graham Barr for contributing the following paragraphs about
8360 the interaction between perl, and various firewall configurations. For
8361 further information on firewalls, it is recommended to consult the
8362 documentation that comes with the ncftp program. If you are unable to
8363 go through the firewall with a simple Perl setup, it is very likely
8364 that you can configure ncftp so that it works for your firewall.
8366 =head2 Three basic types of firewalls
8368 Firewalls can be categorized into three basic types.
8374 This is where the firewall machine runs a web server and to access the
8375 outside world you must do it via the web server. If you set environment
8376 variables like http_proxy or ftp_proxy to a values beginning with http://
8377 or in your web browser you have to set proxy information then you know
8378 you are running an http firewall.
8380 To access servers outside these types of firewalls with perl (even for
8381 ftp) you will need to use LWP.
8385 This where the firewall machine runs an ftp server. This kind of
8386 firewall will only let you access ftp servers outside the firewall.
8387 This is usually done by connecting to the firewall with ftp, then
8388 entering a username like "user@outside.host.com"
8390 To access servers outside these type of firewalls with perl you
8391 will need to use Net::FTP.
8393 =item One way visibility
8395 I say one way visibility as these firewalls try to make themselves look
8396 invisible to the users inside the firewall. An FTP data connection is
8397 normally created by sending the remote server your IP address and then
8398 listening for the connection. But the remote server will not be able to
8399 connect to you because of the firewall. So for these types of firewall
8400 FTP connections need to be done in a passive mode.
8402 There are two that I can think off.
8408 If you are using a SOCKS firewall you will need to compile perl and link
8409 it with the SOCKS library, this is what is normally called a 'socksified'
8410 perl. With this executable you will be able to connect to servers outside
8411 the firewall as if it is not there.
8415 This is the firewall implemented in the Linux kernel, it allows you to
8416 hide a complete network behind one IP address. With this firewall no
8417 special compiling is needed as you can access hosts directly.
8419 For accessing ftp servers behind such firewalls you usually need to
8420 set the environment variable C<FTP_PASSIVE> or the config variable
8421 ftp_passive to a true value.
8427 =head2 Configuring lynx or ncftp for going through a firewall
8429 If you can go through your firewall with e.g. lynx, presumably with a
8432 /usr/local/bin/lynx -pscott:tiger
8434 then you would configure CPAN.pm with the command
8436 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
8438 That's all. Similarly for ncftp or ftp, you would configure something
8441 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
8443 Your mileage may vary...
8451 I installed a new version of module X but CPAN keeps saying,
8452 I have the old version installed
8454 Most probably you B<do> have the old version installed. This can
8455 happen if a module installs itself into a different directory in the
8456 @INC path than it was previously installed. This is not really a
8457 CPAN.pm problem, you would have the same problem when installing the
8458 module manually. The easiest way to prevent this behaviour is to add
8459 the argument C<UNINST=1> to the C<make install> call, and that is why
8460 many people add this argument permanently by configuring
8462 o conf make_install_arg UNINST=1
8466 So why is UNINST=1 not the default?
8468 Because there are people who have their precise expectations about who
8469 may install where in the @INC path and who uses which @INC array. In
8470 fine tuned environments C<UNINST=1> can cause damage.
8474 I want to clean up my mess, and install a new perl along with
8475 all modules I have. How do I go about it?
8477 Run the autobundle command for your old perl and optionally rename the
8478 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
8479 with the Configure option prefix, e.g.
8481 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
8483 Install the bundle file you produced in the first step with something like
8485 cpan> install Bundle::mybundle
8491 When I install bundles or multiple modules with one command
8492 there is too much output to keep track of.
8494 You may want to configure something like
8496 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
8497 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
8499 so that STDOUT is captured in a file for later inspection.
8504 I am not root, how can I install a module in a personal directory?
8506 First of all, you will want to use your own configuration, not the one
8507 that your root user installed. If you do not have permission to write
8508 in the cpan directory that root has configured, you will be asked if
8509 you want to create your own config. Answering "yes" will bring you into
8510 CPAN's configuration stage, using the system config for all defaults except
8511 things that have to do with CPAN's work directory, saving your choices to
8512 your MyConfig.pm file.
8514 You can also manually initiate this process with the following command:
8516 % perl -MCPAN -e 'mkmyconfig'
8522 from the CPAN shell.
8524 You will most probably also want to configure something like this:
8526 o conf makepl_arg "LIB=~/myperl/lib \
8527 INSTALLMAN1DIR=~/myperl/man/man1 \
8528 INSTALLMAN3DIR=~/myperl/man/man3"
8530 You can make this setting permanent like all C<o conf> settings with
8533 You will have to add ~/myperl/man to the MANPATH environment variable
8534 and also tell your perl programs to look into ~/myperl/lib, e.g. by
8537 use lib "$ENV{HOME}/myperl/lib";
8539 or setting the PERL5LIB environment variable.
8541 While we're speaking about $ENV{HOME}, it might be worth mentioning,
8542 that for Windows we use the File::HomeDir module that provides an
8543 equivalent to the concept of the home directory on Unix.
8545 Another thing you should bear in mind is that the UNINST parameter can
8546 be dnagerous when you are installing into a private area because you
8547 might accidentally remove modules that other people depend on that are
8548 not using the private area.
8552 How to get a package, unwrap it, and make a change before building it?
8554 Have a look at the C<look> (!) command.
8558 I installed a Bundle and had a couple of fails. When I
8559 retried, everything resolved nicely. Can this be fixed to work
8562 The reason for this is that CPAN does not know the dependencies of all
8563 modules when it starts out. To decide about the additional items to
8564 install, it just uses data found in the META.yml file or the generated
8565 Makefile. An undetected missing piece breaks the process. But it may
8566 well be that your Bundle installs some prerequisite later than some
8567 depending item and thus your second try is able to resolve everything.
8568 Please note, CPAN.pm does not know the dependency tree in advance and
8569 cannot sort the queue of things to install in a topologically correct
8570 order. It resolves perfectly well IF all modules declare the
8571 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
8572 the C<requires> stanza of Module::Build. For bundles which fail and
8573 you need to install often, it is recommended to sort the Bundle
8574 definition file manually.
8578 In our intranet we have many modules for internal use. How
8579 can I integrate these modules with CPAN.pm but without uploading
8580 the modules to CPAN?
8582 Have a look at the CPAN::Site module.
8586 When I run CPAN's shell, I get an error message about things in my
8587 /etc/inputrc (or ~/.inputrc) file.
8589 These are readline issues and can only be fixed by studying readline
8590 configuration on your architecture and adjusting the referenced file
8591 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
8592 and edit them. Quite often harmless changes like uppercasing or
8593 lowercasing some arguments solves the problem.
8597 Some authors have strange characters in their names.
8599 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
8600 expecting ISO-8859-1 charset, a converter can be activated by setting
8601 term_is_latin to a true value in your config file. One way of doing so
8604 cpan> o conf term_is_latin 1
8606 If other charset support is needed, please file a bugreport against
8607 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
8608 the support or maybe UTF-8 terminals become widely available.
8612 When an install fails for some reason and then I correct the error
8613 condition and retry, CPAN.pm refuses to install the module, saying
8614 C<Already tried without success>.
8616 Use the force pragma like so
8618 force install Foo::Bar
8620 This does a bit more than really needed because it untars the
8621 distribution again and runs make and test and only then install.
8623 Or, if you find this is too fast and you would prefer to do smaller
8628 first and then continue as always. C<Force get> I<forgets> previous
8635 and then 'make install' directly in the subshell.
8637 Or you leave the CPAN shell and start it again.
8639 For the really curious, by accessing internals directly, you I<could>
8641 !delete CPAN::Shell->expandany("Foo::Bar")->distribution->{install}
8643 but this is neither guaranteed to work in the future nor is it a
8648 How do I install a "DEVELOPER RELEASE" of a module?
8650 By default, CPAN will install the latest non-developer release of a
8651 module. If you want to install a dev release, you have to specify the
8652 partial path starting with the author id to the tarball you wish to
8655 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
8657 Note that you can use the C<ls> command to get this path listed.
8661 How do I install a module and all its dependencies from the commandline,
8662 without being prompted for anything, despite my CPAN configuration
8665 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
8666 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
8667 asked any questions at all (assuming the modules you are installing are
8668 nice about obeying that variable as well):
8670 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
8674 How do I create a Module::Build based Build.PL derived from an
8675 ExtUtils::MakeMaker focused Makefile.PL?
8677 http://search.cpan.org/search?query=Module::Build::Convert
8679 http://accognoscere.org/papers/perl-module-build-convert/module-build-convert.html
8686 Please report bugs via http://rt.cpan.org/
8688 Before submitting a bug, please make sure that the traditional method
8689 of building a Perl module package from a shell by following the
8690 installation instructions of that package still works in your
8693 =head1 SECURITY ADVICE
8695 This software enables you to upgrade software on your computer and so
8696 is inherently dangerous because the newly installed software may
8697 contain bugs and may alter the way your computer works or even make it
8698 unusable. Please consider backing up your data before every upgrade.
8702 Andreas Koenig C<< <andk@cpan.org> >>
8706 Kawai,Takanori provides a Japanese translation of this manpage at
8707 http://member.nifty.ne.jp/hippo2000/perltips/CPAN.htm
8711 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)