1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 $CPAN::VERSION = '1.88_57';
5 $CPAN::VERSION = eval $CPAN::VERSION;
7 use CPAN::HandleConfig;
17 use ExtUtils::MakeMaker qw(prompt); # for some unknown reason,
18 # 5.005_04 does not work without
20 use File::Basename ();
27 use Sys::Hostname qw(hostname);
28 use Text::ParseWords ();
31 # we need to run chdir all over and we would get at wrong libraries
34 if (File::Spec->can("rel2abs")) {
36 $inc = File::Spec->rel2abs($inc);
42 require Mac::BuildTools if $^O eq 'MacOS';
44 END { $CPAN::End++; &cleanup; }
47 $CPAN::Frontend ||= "CPAN::Shell";
48 unless (@CPAN::Defaultsites){
49 @CPAN::Defaultsites = map {
50 CPAN::URL->new(TEXT => $_, FROM => "DEF")
52 "http://www.perl.org/CPAN/",
53 "ftp://ftp.perl.org/pub/CPAN/";
55 # $CPAN::iCwd (i for initial) is going to be initialized during find_perl
56 $CPAN::Perl ||= CPAN::find_perl();
57 $CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
58 $CPAN::Defaultrecent ||= "http://search.cpan.org/recent";
82 @CPAN::ISA = qw(CPAN::Debug Exporter);
84 # note that these functions live in CPAN::Shell and get executed via
85 # AUTOLOAD when called directly
108 sub soft_chdir_with_alternatives ($);
111 $autoload_recursion ||= 0;
113 #-> sub CPAN::AUTOLOAD ;
115 $autoload_recursion++;
119 warn "Refusing to autoload '$l' while signal pending";
120 $autoload_recursion--;
123 if ($autoload_recursion > 1) {
124 my $fullcommand = join " ", map { "'$_'" } $l, @_;
125 warn "Refusing to autoload $fullcommand in recursion\n";
126 $autoload_recursion--;
130 @export{@EXPORT} = '';
131 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
132 if (exists $export{$l}){
135 die(qq{Unknown CPAN command "$AUTOLOAD". }.
136 qq{Type ? for help.\n});
138 $autoload_recursion--;
142 #-> sub CPAN::shell ;
145 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
146 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
148 my $oprompt = shift || CPAN::Prompt->new;
149 my $prompt = $oprompt;
150 my $commandline = shift || "";
151 $CPAN::CurrentCommandId ||= 1;
154 unless ($Suppress_readline) {
155 require Term::ReadLine;
158 $term->ReadLine eq "Term::ReadLine::Stub"
160 $term = Term::ReadLine->new('CPAN Monitor');
162 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
163 my $attribs = $term->Attribs;
164 $attribs->{attempted_completion_function} = sub {
165 &CPAN::Complete::gnu_cpl;
168 $readline::rl_completion_function =
169 $readline::rl_completion_function = 'CPAN::Complete::cpl';
171 if (my $histfile = $CPAN::Config->{'histfile'}) {{
172 unless ($term->can("AddHistory")) {
173 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
176 my($fh) = FileHandle->new;
177 open $fh, "<$histfile" or last;
181 $term->AddHistory($_);
185 for ($CPAN::Config->{term_ornaments}) { # alias
186 local $Term::ReadLine::termcap_nowarn = 1;
187 $term->ornaments($_) if defined;
189 # $term->OUT is autoflushed anyway
190 my $odef = select STDERR;
197 # no strict; # I do not recall why no strict was here (2000-09-03)
199 my @cwd = grep { defined $_ and length $_ }
201 File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
202 File::Spec->rootdir();
203 my $try_detect_readline;
204 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
205 my $rl_avail = $Suppress_readline ? "suppressed" :
206 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
207 "available (try 'install Bundle::CPAN')";
209 unless ($CPAN::Config->{'inhibit_startup_message'}){
210 $CPAN::Frontend->myprint(
212 cpan shell -- CPAN exploration and modules installation (v%s)
220 my($continuation) = "";
221 my $last_term_ornaments;
222 SHELLCOMMAND: while () {
223 if ($Suppress_readline) {
225 last SHELLCOMMAND unless defined ($_ = <> );
228 last SHELLCOMMAND unless
229 defined ($_ = $term->readline($prompt, $commandline));
231 $_ = "$continuation$_" if $continuation;
233 next SHELLCOMMAND if /^$/;
234 $_ = 'h' if /^\s*\?/;
235 if (/^(?:q(?:uit)?|bye|exit)$/i) {
246 use vars qw($import_done);
247 CPAN->import(':DEFAULT') unless $import_done++;
248 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
255 eval { @line = Text::ParseWords::shellwords($_) };
256 warn($@), next SHELLCOMMAND if $@;
257 warn("Text::Parsewords could not parse the line [$_]"),
258 next SHELLCOMMAND unless @line;
259 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
260 my $command = shift @line;
261 eval { CPAN::Shell->$command(@line) };
266 if ($command =~ /^(make|test|install|force|notest|clean|report|upgrade)$/) {
267 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
269 soft_chdir_with_alternatives(\@cwd);
270 $CPAN::Frontend->myprint("\n");
272 $CPAN::CurrentCommandId++;
276 $commandline = ""; # I do want to be able to pass a default to
277 # shell, but on the second command I see no
280 CPAN::Queue->nullify_queue;
281 if ($try_detect_readline) {
282 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
284 $CPAN::META->has_inst("Term::ReadLine::Perl")
286 delete $INC{"Term/ReadLine.pm"};
288 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
289 require Term::ReadLine;
290 $CPAN::Frontend->myprint("\n$redef subroutines in ".
291 "Term::ReadLine redefined\n");
295 if ($term and $term->can("ornaments")) {
296 for ($CPAN::Config->{term_ornaments}) { # alias
298 if (not defined $last_term_ornaments
299 or $_ != $last_term_ornaments
301 local $Term::ReadLine::termcap_nowarn = 1;
302 $term->ornaments($_);
303 $last_term_ornaments = $_;
306 undef $last_term_ornaments;
310 for my $class (qw(Module Distribution)) {
311 # again unsafe meta access?
312 for my $dm (keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) {
313 next unless $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
314 CPAN->debug("BUG: $class '$dm' was in command state, resetting");
315 delete $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
319 $GOTOSHELL = 0; # not too often
320 $META->savehist if $CPAN::term && $CPAN::term->can("GetHistory");
325 soft_chdir_with_alternatives(\@cwd);
328 sub soft_chdir_with_alternatives ($) {
331 my $root = File::Spec->rootdir();
332 $CPAN::Frontend->mywarn(qq{Warning: no good directory to chdir to!
333 Trying '$root' as temporary haven.
338 if (chdir $cwd->[0]) {
342 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
343 Trying to chdir to "$cwd->[1]" instead.
347 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
353 # CPAN::_yaml_loadfile
355 my($self,$local_file) = @_;
356 my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
357 if ($CPAN::META->has_inst($yaml_module)) {
358 my $code = UNIVERSAL::can($yaml_module, "LoadFile");
360 eval { @yaml = $code->($local_file); };
362 $CPAN::Frontend->mydie("Alert: While trying to parse YAML file\n".
364 "with $yaml_module the following error was encountered:\n".
370 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot parse '$local_file'\n");
375 package CPAN::CacheMgr;
377 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
382 use vars qw($Ua $Thesite $ThesiteURL $Themethod);
383 @CPAN::FTP::ISA = qw(CPAN::Debug);
385 package CPAN::LWP::UserAgent;
387 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
388 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
390 package CPAN::Complete;
392 @CPAN::Complete::ISA = qw(CPAN::Debug);
393 @CPAN::Complete::COMMANDS = sort qw(
394 ! a b d h i m o q r u
419 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03);
420 @CPAN::Index::ISA = qw(CPAN::Debug);
423 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
426 package CPAN::InfoObj;
428 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
430 package CPAN::Author;
432 @CPAN::Author::ISA = qw(CPAN::InfoObj);
434 package CPAN::Distribution;
436 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
438 package CPAN::Bundle;
440 @CPAN::Bundle::ISA = qw(CPAN::Module);
442 package CPAN::Module;
444 @CPAN::Module::ISA = qw(CPAN::InfoObj);
446 package CPAN::Exception::RecursiveDependency;
448 use overload '""' => "as_string";
455 for my $dep (@$deps) {
457 last if $seen{$dep}++;
459 bless { deps => \@deps }, $class;
464 "\nRecursive dependency detected:\n " .
465 join("\n => ", @{$self->{deps}}) .
466 ".\nCannot continue.\n";
469 package CPAN::Prompt; use overload '""' => "as_string";
470 use vars qw($prompt);
472 $CPAN::CurrentCommandId ||= 0;
477 if ($CPAN::Config->{commandnumber_in_prompt}) {
478 sprintf "cpan[%d]> ", $CPAN::CurrentCommandId;
484 package CPAN::URL; use overload '""' => "as_string", fallback => 1;
485 # accessors: TEXT(the url string), FROM(DEF=>defaultlist,USER=>urllist),
486 # planned are things like age or quality
488 my($class,%args) = @_;
500 $self->{TEXT} = $set;
505 package CPAN::Distrostatus;
506 use overload '""' => "as_string",
509 my($class,$arg) = @_;
512 FAILED => substr($arg,0,2) eq "NO",
513 COMMANDID => $CPAN::CurrentCommandId,
516 sub commandid { shift->{COMMANDID} }
517 sub failed { shift->{FAILED} }
521 $self->{TEXT} = $set;
540 @CPAN::Shell::ISA = qw(CPAN::Debug);
541 $COLOR_REGISTERED ||= 0;
544 # $GLOBAL_AUTOLOAD_RECURSION = 12;
545 $autoload_recursion ||= 0;
547 #-> sub CPAN::Shell::AUTOLOAD ;
549 $autoload_recursion++;
551 my $class = shift(@_);
552 # warn "autoload[$l] class[$class]";
555 warn "Refusing to autoload '$l' while signal pending";
556 $autoload_recursion--;
559 if ($autoload_recursion > 1) {
560 my $fullcommand = join " ", map { "'$_'" } $l, @_;
561 warn "Refusing to autoload $fullcommand in recursion\n";
562 $autoload_recursion--;
566 # XXX needs to be reconsidered
567 if ($CPAN::META->has_inst('CPAN::WAIT')) {
570 $CPAN::Frontend->mywarn(qq{
571 Commands starting with "w" require CPAN::WAIT to be installed.
572 Please consider installing CPAN::WAIT to use the fulltext index.
573 For this you just need to type
578 $CPAN::Frontend->mywarn(qq{Unknown shell command '$l'. }.
582 $autoload_recursion--;
589 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
591 # from here on only subs.
592 ################################################################################
594 sub suggest_myconfig () {
595 SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
596 $CPAN::Frontend->myprint("You don't seem to have a user ".
597 "configuration (MyConfig.pm) yet.\n");
598 my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ".
599 "user configuration now? (Y/n)",
602 CPAN::Shell->mkmyconfig();
605 $CPAN::Frontend->mydie("OK, giving up.");
610 #-> sub CPAN::all_objects ;
612 my($mgr,$class) = @_;
613 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
614 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
616 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
619 # Called by shell, not in batch mode. In batch mode I see no risk in
620 # having many processes updating something as installations are
621 # continually checked at runtime. In shell mode I suspect it is
622 # unintentional to open more than one shell at a time
624 #-> sub CPAN::checklock ;
627 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
628 if (-f $lockfile && -M _ > 0) {
629 my $fh = FileHandle->new($lockfile) or
630 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
631 my $otherpid = <$fh>;
632 my $otherhost = <$fh>;
634 if (defined $otherpid && $otherpid) {
637 if (defined $otherhost && $otherhost) {
640 my $thishost = hostname();
641 if (defined $otherhost && defined $thishost &&
642 $otherhost ne '' && $thishost ne '' &&
643 $otherhost ne $thishost) {
644 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
645 "reports other host $otherhost and other ".
646 "process $otherpid.\n".
647 "Cannot proceed.\n"));
649 elsif (defined $otherpid && $otherpid) {
650 return if $$ == $otherpid; # should never happen
651 $CPAN::Frontend->mywarn(
653 There seems to be running another CPAN process (pid $otherpid). Contacting...
655 if (kill 0, $otherpid) {
656 $CPAN::Frontend->mydie(qq{Other job is running.
657 You may want to kill it and delete the lockfile, maybe. On UNIX try:
661 } elsif (-w $lockfile) {
663 CPAN::Shell::colorable_makemaker_prompt
664 (qq{Other job not responding. Shall I overwrite }.
665 qq{the lockfile '$lockfile'? (Y/n)},"y");
666 $CPAN::Frontend->myexit("Ok, bye\n")
667 unless $ans =~ /^y/i;
670 qq{Lockfile '$lockfile' not writeable by you. }.
671 qq{Cannot proceed.\n}.
673 qq{ rm '$lockfile'\n}.
674 qq{ and then rerun us.\n}
678 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
679 "reports other process with ID ".
680 "$otherpid. Cannot proceed.\n"));
683 my $dotcpan = $CPAN::Config->{cpan_home};
684 eval { File::Path::mkpath($dotcpan);};
686 # A special case at least for Jarkko.
691 $symlinkcpan = readlink $dotcpan;
692 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
693 eval { File::Path::mkpath($symlinkcpan); };
697 $CPAN::Frontend->mywarn(qq{
698 Working directory $symlinkcpan created.
702 unless (-d $dotcpan) {
704 Your configuration suggests "$dotcpan" as your
705 CPAN.pm working directory. I could not create this directory due
706 to this error: $firsterror\n};
708 As "$dotcpan" is a symlink to "$symlinkcpan",
709 I tried to create that, but I failed with this error: $seconderror
712 Please make sure the directory exists and is writable.
714 $CPAN::Frontend->myprint($mess);
715 return suggest_myconfig;
717 } # $@ after eval mkpath $dotcpan
719 unless ($fh = FileHandle->new(">$lockfile")) {
720 if ($! =~ /Permission/) {
721 $CPAN::Frontend->myprint(qq{
723 Your configuration suggests that CPAN.pm should use a working
725 $CPAN::Config->{cpan_home}
726 Unfortunately we could not create the lock file
728 due to permission problems.
730 Please make sure that the configuration variable
731 \$CPAN::Config->{cpan_home}
732 points to a directory where you can write a .lock file. You can set
733 this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
736 return suggest_myconfig;
739 $fh->print($$, "\n");
740 $fh->print(hostname(), "\n");
741 $self->{LOCK} = $lockfile;
746 $CPAN::Frontend->mydie("Got SIG$sig, leaving");
752 die "Got yet another signal" if $Signal > 1;
753 $CPAN::Frontend->mydie("Got another SIG$sig") if $Signal;
754 $CPAN::Frontend->mywarn("Caught SIG$sig, trying to continue\n");
758 # From: Larry Wall <larry@wall.org>
759 # Subject: Re: deprecating SIGDIE
760 # To: perl5-porters@perl.org
761 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
763 # The original intent of __DIE__ was only to allow you to substitute one
764 # kind of death for another on an application-wide basis without respect
765 # to whether you were in an eval or not. As a global backstop, it should
766 # not be used any more lightly (or any more heavily :-) than class
767 # UNIVERSAL. Any attempt to build a general exception model on it should
768 # be politely squashed. Any bug that causes every eval {} to have to be
769 # modified should be not so politely squashed.
771 # Those are my current opinions. It is also my optinion that polite
772 # arguments degenerate to personal arguments far too frequently, and that
773 # when they do, it's because both people wanted it to, or at least didn't
774 # sufficiently want it not to.
778 # global backstop to cleanup if we should really die
779 $SIG{__DIE__} = \&cleanup;
780 $self->debug("Signal handler set.") if $CPAN::DEBUG;
783 #-> sub CPAN::DESTROY ;
785 &cleanup; # need an eval?
788 #-> sub CPAN::anycwd ;
791 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
796 sub cwd {Cwd::cwd();}
798 #-> sub CPAN::getcwd ;
799 sub getcwd {Cwd::getcwd();}
801 #-> sub CPAN::fastcwd ;
802 sub fastcwd {Cwd::fastcwd();}
804 #-> sub CPAN::backtickcwd ;
805 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
807 #-> sub CPAN::find_perl ;
809 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
810 my $pwd = $CPAN::iCwd = CPAN::anycwd();
811 my $candidate = File::Spec->catfile($pwd,$^X);
812 $perl ||= $candidate if MM->maybe_command($candidate);
815 my ($component,$perl_name);
816 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
817 PATH_COMPONENT: foreach $component (File::Spec->path(),
818 $Config::Config{'binexp'}) {
819 next unless defined($component) && $component;
820 my($abs) = File::Spec->catfile($component,$perl_name);
821 if (MM->maybe_command($abs)) {
833 #-> sub CPAN::exists ;
835 my($mgr,$class,$id) = @_;
836 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
838 ### Carp::croak "exists called without class argument" unless $class;
840 $id =~ s/:+/::/g if $class eq "CPAN::Module";
841 exists $META->{readonly}{$class}{$id} or
842 exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
845 #-> sub CPAN::delete ;
847 my($mgr,$class,$id) = @_;
848 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
849 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
852 #-> sub CPAN::has_usable
853 # has_inst is sometimes too optimistic, we should replace it with this
854 # has_usable whenever a case is given
856 my($self,$mod,$message) = @_;
857 return 1 if $HAS_USABLE->{$mod};
858 my $has_inst = $self->has_inst($mod,$message);
859 return unless $has_inst;
862 LWP => [ # we frequently had "Can't locate object
863 # method "new" via package "LWP::UserAgent" at
864 # (eval 69) line 2006
866 sub {require LWP::UserAgent},
867 sub {require HTTP::Request},
868 sub {require URI::URL},
871 sub {require Net::FTP},
872 sub {require Net::Config},
875 sub {require File::HomeDir;
876 unless (File::HomeDir::->VERSION >= 0.52){
877 for ("Will not use File::HomeDir, need 0.52\n") {
878 $CPAN::Frontend->mywarn($_);
885 if ($usable->{$mod}) {
886 for my $c (0..$#{$usable->{$mod}}) {
887 my $code = $usable->{$mod}[$c];
888 my $ret = eval { &$code() };
889 $ret = "" unless defined $ret;
891 # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
896 return $HAS_USABLE->{$mod} = 1;
899 #-> sub CPAN::has_inst
901 my($self,$mod,$message) = @_;
902 Carp::croak("CPAN->has_inst() called without an argument")
904 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
905 keys %{$CPAN::Config->{dontload_hash}||{}},
906 @{$CPAN::Config->{dontload_list}||[]};
907 if (defined $message && $message eq "no" # afair only used by Nox
911 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
919 # checking %INC is wrong, because $INC{LWP} may be true
920 # although $INC{"URI/URL.pm"} may have failed. But as
921 # I really want to say "bla loaded OK", I have to somehow
923 ### warn "$file in %INC"; #debug
925 } elsif (eval { require $file }) {
926 # eval is good: if we haven't yet read the database it's
927 # perfect and if we have installed the module in the meantime,
928 # it tries again. The second require is only a NOOP returning
929 # 1 if we had success, otherwise it's retrying
931 my $v = eval "\$$mod\::VERSION";
932 $v = $v ? " (v$v)" : "";
933 $CPAN::Frontend->myprint("CPAN: $mod loaded ok$v\n");
934 if ($mod eq "CPAN::WAIT") {
935 push @CPAN::Shell::ISA, 'CPAN::WAIT';
938 } elsif ($mod eq "Net::FTP") {
939 $CPAN::Frontend->mywarn(qq{
940 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
942 install Bundle::libnet
944 }) unless $Have_warned->{"Net::FTP"}++;
945 $CPAN::Frontend->mysleep(3);
946 } elsif ($mod eq "Digest::SHA"){
947 if ($Have_warned->{"Digest::SHA"}++) {
948 $CPAN::Frontend->myprint(qq{CPAN: checksum security checks disabled}.
949 qq{because Digest::SHA not installed.\n});
951 $CPAN::Frontend->mywarn(qq{
952 CPAN: checksum security checks disabled because Digest::SHA not installed.
953 Please consider installing the Digest::SHA module.
956 $CPAN::Frontend->mysleep(2);
958 } elsif ($mod eq "Module::Signature"){
959 if (not $CPAN::Config->{check_sigs}) {
960 # they do not want us:-(
961 } elsif (not $Have_warned->{"Module::Signature"}++) {
962 # No point in complaining unless the user can
963 # reasonably install and use it.
964 if (eval { require Crypt::OpenPGP; 1 } ||
966 defined $CPAN::Config->{'gpg'}
968 $CPAN::Config->{'gpg'} =~ /\S/
971 $CPAN::Frontend->mywarn(qq{
972 CPAN: Module::Signature security checks disabled because Module::Signature
973 not installed. Please consider installing the Module::Signature module.
974 You may also need to be able to connect over the Internet to the public
975 keyservers like pgp.mit.edu (port 11371).
978 $CPAN::Frontend->mysleep(2);
982 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
987 #-> sub CPAN::instance ;
989 my($mgr,$class,$id) = @_;
992 # unsafe meta access, ok?
993 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
994 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
1002 #-> sub CPAN::cleanup ;
1004 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
1005 local $SIG{__DIE__} = '';
1010 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
1011 $ineval = 1, last if
1012 $subroutine eq '(eval)';
1014 return if $ineval && !$CPAN::End;
1015 return unless defined $META->{LOCK};
1016 return unless -f $META->{LOCK};
1018 unlink $META->{LOCK};
1020 # Carp::cluck("DEBUGGING");
1021 if ( $CPAN::CONFIG_DIRTY ) {
1022 $CPAN::Frontend->mywarn("Warning: Configuration not saved.\n");
1024 $CPAN::Frontend->myprint("Lockfile removed.\n");
1027 #-> sub CPAN::savehist
1030 my($histfile,$histsize);
1031 unless ($histfile = $CPAN::Config->{'histfile'}){
1032 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
1035 $histsize = $CPAN::Config->{'histsize'} || 100;
1037 unless ($CPAN::term->can("GetHistory")) {
1038 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
1044 my @h = $CPAN::term->GetHistory;
1045 splice @h, 0, @h-$histsize if @h>$histsize;
1046 my($fh) = FileHandle->new;
1047 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
1048 local $\ = local $, = "\n";
1053 #-> sub CPAN::is_tested
1055 my($self,$what) = @_;
1056 $self->{is_tested}{$what} = 1;
1059 #-> sub CPAN::is_installed
1060 # unsets the is_tested flag: as soon as the thing is installed, it is
1061 # not needed in set_perl5lib anymore
1063 my($self,$what) = @_;
1064 delete $self->{is_tested}{$what};
1067 #-> sub CPAN::set_perl5lib
1069 my($self,$for) = @_;
1071 (undef,undef,undef,$for) = caller(1);
1074 $self->{is_tested} ||= {};
1075 return unless %{$self->{is_tested}};
1076 my $env = $ENV{PERL5LIB};
1077 $env = $ENV{PERLLIB} unless defined $env;
1079 push @env, $env if defined $env and length $env;
1080 #my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1081 #$CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1082 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} sort keys %{$self->{is_tested}};
1084 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB for $for\n");
1086 my @d = map {s/^\Q$CPAN::Config->{'build_dir'}/%BUILDDIR%/; $_ }
1087 sort keys %{$self->{is_tested}};
1088 $CPAN::Frontend->myprint("Prepending blib/arch and blib/lib subdirs of ".
1090 "%BUILDDIR%=$CPAN::Config->{'build_dir'} ".
1095 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1098 package CPAN::CacheMgr;
1101 #-> sub CPAN::CacheMgr::as_string ;
1103 eval { require Data::Dumper };
1105 return shift->SUPER::as_string;
1107 return Data::Dumper::Dumper(shift);
1111 #-> sub CPAN::CacheMgr::cachesize ;
1116 #-> sub CPAN::CacheMgr::tidyup ;
1119 return unless -d $self->{ID};
1120 while ($self->{DU} > $self->{'MAX'} ) {
1121 my($toremove) = shift @{$self->{FIFO}};
1122 $CPAN::Frontend->myprint(sprintf(
1123 "Deleting from cache".
1124 ": $toremove (%.1f>%.1f MB)\n",
1125 $self->{DU}, $self->{'MAX'})
1127 return if $CPAN::Signal;
1128 $self->force_clean_cache($toremove);
1129 return if $CPAN::Signal;
1133 #-> sub CPAN::CacheMgr::dir ;
1138 #-> sub CPAN::CacheMgr::entries ;
1140 my($self,$dir) = @_;
1141 return unless defined $dir;
1142 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1143 $dir ||= $self->{ID};
1144 my($cwd) = CPAN::anycwd();
1145 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1146 my $dh = DirHandle->new(File::Spec->curdir)
1147 or Carp::croak("Couldn't opendir $dir: $!");
1150 next if $_ eq "." || $_ eq "..";
1152 push @entries, File::Spec->catfile($dir,$_);
1154 push @entries, File::Spec->catdir($dir,$_);
1156 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1159 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1160 sort { -M $b <=> -M $a} @entries;
1163 #-> sub CPAN::CacheMgr::disk_usage ;
1165 my($self,$dir) = @_;
1166 return if exists $self->{SIZE}{$dir};
1167 return if $CPAN::Signal;
1171 unless (chmod 0755, $dir) {
1172 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1173 "permission to change the permission; cannot ".
1174 "estimate disk usage of '$dir'\n");
1175 $CPAN::Frontend->mysleep(5);
1180 $CPAN::Frontend->mywarn("Directory '$dir' has gone. Cannot continue.\n");
1185 $File::Find::prune++ if $CPAN::Signal;
1187 if ($^O eq 'MacOS') {
1189 my $cat = Mac::Files::FSpGetCatInfo($_);
1190 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1194 unless (chmod 0755, $_) {
1195 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1196 "the permission to change the permission; ".
1197 "can only partially estimate disk usage ".
1199 $CPAN::Frontend->mysleep(5);
1210 return if $CPAN::Signal;
1211 $self->{SIZE}{$dir} = $Du/1024/1024;
1212 push @{$self->{FIFO}}, $dir;
1213 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1214 $self->{DU} += $Du/1024/1024;
1218 #-> sub CPAN::CacheMgr::force_clean_cache ;
1219 sub force_clean_cache {
1220 my($self,$dir) = @_;
1221 return unless -e $dir;
1222 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1224 File::Path::rmtree($dir);
1225 $self->{DU} -= $self->{SIZE}{$dir};
1226 delete $self->{SIZE}{$dir};
1229 #-> sub CPAN::CacheMgr::new ;
1236 ID => $CPAN::Config->{'build_dir'},
1237 MAX => $CPAN::Config->{'build_cache'},
1238 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1241 File::Path::mkpath($self->{ID});
1242 my $dh = DirHandle->new($self->{ID});
1243 bless $self, $class;
1246 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1248 CPAN->debug($debug) if $CPAN::DEBUG;
1252 #-> sub CPAN::CacheMgr::scan_cache ;
1255 return if $self->{SCAN} eq 'never';
1256 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1257 unless $self->{SCAN} eq 'atstart';
1258 $CPAN::Frontend->myprint(
1259 sprintf("Scanning cache %s for sizes\n",
1262 for $e ($self->entries($self->{ID})) {
1263 next if $e eq ".." || $e eq ".";
1264 $self->disk_usage($e);
1265 return if $CPAN::Signal;
1270 package CPAN::Shell;
1273 #-> sub CPAN::Shell::h ;
1275 my($class,$about) = @_;
1276 if (defined $about) {
1277 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1279 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1280 $CPAN::Frontend->myprint(qq{
1281 Display Information $filler (ver $CPAN::VERSION)
1282 command argument description
1283 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1284 i WORD or /REGEXP/ about any of the above
1285 ls AUTHOR or GLOB about files in the author's directory
1286 (with WORD being a module, bundle or author name or a distribution
1287 name of the form AUTHOR/DISTRIBUTION)
1289 Download, Test, Make, Install...
1290 get download clean make clean
1291 make make (implies get) look open subshell in dist directory
1292 test make test (implies make) readme display these README files
1293 install make install (implies test) perldoc display POD documentation
1296 r WORDs or /REGEXP/ or NONE report updates for some/matching/all modules
1297 upgrade WORDs or /REGEXP/ or NONE upgrade some/matching/all modules
1300 force COMMAND unconditionally do command
1301 notest COMMAND skip testing
1304 h,? display this menu ! perl-code eval a perl command
1305 o conf [opt] set and query options q quit the cpan shell
1306 reload cpan load CPAN.pm again reload index load newer indices
1307 autobundle Snapshot recent latest CPAN uploads});
1313 #-> sub CPAN::Shell::a ;
1315 my($self,@arg) = @_;
1316 # authors are always UPPERCASE
1318 $_ = uc $_ unless /=/;
1320 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1323 #-> sub CPAN::Shell::globls ;
1325 my($self,$s,$pragmas) = @_;
1326 # ls is really very different, but we had it once as an ordinary
1327 # command in the Shell (upto rev. 321) and we could not handle
1329 my(@accept,@preexpand);
1330 if ($s =~ /[\*\?\/]/) {
1331 if ($CPAN::META->has_inst("Text::Glob")) {
1332 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1333 my $rau = Text::Glob::glob_to_regex(uc $au);
1334 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1336 push @preexpand, map { $_->id . "/" . $pathglob }
1337 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1339 my $rau = Text::Glob::glob_to_regex(uc $s);
1340 push @preexpand, map { $_->id }
1341 CPAN::Shell->expand_by_method('CPAN::Author',
1346 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1349 push @preexpand, uc $s;
1352 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1353 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1358 my $silent = @accept>1;
1359 my $last_alpha = "";
1361 for my $a (@accept){
1362 my($author,$pathglob);
1363 if ($a =~ m|(.*?)/(.*)|) {
1366 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1368 $a2) or die "No author found for $a2";
1370 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1372 $a) or die "No author found for $a";
1375 my $alpha = substr $author->id, 0, 1;
1377 if ($alpha eq $last_alpha) {
1381 $last_alpha = $alpha;
1383 $CPAN::Frontend->myprint($ad);
1385 for my $pragma (@$pragmas) {
1386 if ($author->can($pragma)) {
1390 push @results, $author->ls($pathglob,$silent); # silent if
1393 for my $pragma (@$pragmas) {
1394 my $meth = "un$pragma";
1395 if ($author->can($meth)) {
1403 #-> sub CPAN::Shell::local_bundles ;
1405 my($self,@which) = @_;
1406 my($incdir,$bdir,$dh);
1407 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1408 my @bbase = "Bundle";
1409 while (my $bbase = shift @bbase) {
1410 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1411 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1412 if ($dh = DirHandle->new($bdir)) { # may fail
1414 for $entry ($dh->read) {
1415 next if $entry =~ /^\./;
1416 next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
1417 if (-d File::Spec->catdir($bdir,$entry)){
1418 push @bbase, "$bbase\::$entry";
1420 next unless $entry =~ s/\.pm(?!\n)\Z//;
1421 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1429 #-> sub CPAN::Shell::b ;
1431 my($self,@which) = @_;
1432 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1433 $self->local_bundles;
1434 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1437 #-> sub CPAN::Shell::d ;
1438 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1440 #-> sub CPAN::Shell::m ;
1441 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1443 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1446 #-> sub CPAN::Shell::i ;
1450 @args = '/./' unless @args;
1452 for my $type (qw/Bundle Distribution Module/) {
1453 push @result, $self->expand($type,@args);
1455 # Authors are always uppercase.
1456 push @result, $self->expand("Author", map { uc $_ } @args);
1458 my $result = @result == 1 ?
1459 $result[0]->as_string :
1461 "No objects found of any type for argument @args\n" :
1463 (map {$_->as_glimpse} @result),
1464 scalar @result, " items found\n",
1466 $CPAN::Frontend->myprint($result);
1469 #-> sub CPAN::Shell::o ;
1471 # CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o
1472 # conf' calls through to CPAN::HandleConfig::edit. 'o conf' should
1473 # probably have been called 'set' and 'o debug' maybe 'set debug' or
1474 # 'debug'; 'o conf ARGS' calls ->edit in CPAN/HandleConfig.pm
1476 my($self,$o_type,@o_what) = @_;
1478 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1479 if ($o_type eq 'conf') {
1480 if (!@o_what) { # print all things, "o conf"
1482 $CPAN::Frontend->myprint("\$CPAN::Config options from ");
1484 if (exists $INC{'CPAN/Config.pm'}) {
1485 push @from, $INC{'CPAN/Config.pm'};
1487 if (exists $INC{'CPAN/MyConfig.pm'}) {
1488 push @from, $INC{'CPAN/MyConfig.pm'};
1490 $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
1491 $CPAN::Frontend->myprint(":\n");
1492 for $k (sort keys %CPAN::HandleConfig::can) {
1493 $v = $CPAN::HandleConfig::can{$k};
1494 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
1496 $CPAN::Frontend->myprint("\n");
1497 for $k (sort keys %$CPAN::Config) {
1498 CPAN::HandleConfig->prettyprint($k);
1500 $CPAN::Frontend->myprint("\n");
1501 } elsif (!CPAN::HandleConfig->edit(@o_what)) {
1502 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
1505 } elsif ($o_type eq 'debug') {
1507 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1510 my($what) = shift @o_what;
1511 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1512 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1515 if ( exists $CPAN::DEBUG{$what} ) {
1516 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1517 } elsif ($what =~ /^\d/) {
1518 $CPAN::DEBUG = $what;
1519 } elsif (lc $what eq 'all') {
1521 for (values %CPAN::DEBUG) {
1524 $CPAN::DEBUG = $max;
1527 for (keys %CPAN::DEBUG) {
1528 next unless lc($_) eq lc($what);
1529 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1532 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1537 my $raw = "Valid options for debug are ".
1538 join(", ",sort(keys %CPAN::DEBUG), 'all').
1539 qq{ or a number. Completion works on the options. }.
1540 qq{Case is ignored.};
1542 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1543 $CPAN::Frontend->myprint("\n\n");
1546 $CPAN::Frontend->myprint("Options set for debugging ($CPAN::DEBUG):\n");
1548 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1549 $v = $CPAN::DEBUG{$k};
1550 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1551 if $v & $CPAN::DEBUG;
1554 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1557 $CPAN::Frontend->myprint(qq{
1559 conf set or get configuration variables
1560 debug set or get debugging options
1565 # CPAN::Shell::paintdots_onreload
1566 sub paintdots_onreload {
1569 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
1573 # $CPAN::Frontend->myprint(".($subr)");
1574 $CPAN::Frontend->myprint(".");
1575 if ($subr =~ /\bshell\b/i) {
1576 # warn "debug[$_[0]]";
1578 # It would be nice if we could detect that a
1579 # subroutine has actually changed, but for now we
1580 # practically always set the GOTOSHELL global
1590 #-> sub CPAN::Shell::reload ;
1592 my($self,$command,@arg) = @_;
1594 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1595 if ($command =~ /^cpan$/i) {
1597 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
1601 "CPAN/HandleConfig.pm",
1602 "CPAN/FirstTime.pm",
1609 MFILE: for my $f (@relo) {
1610 next unless exists $INC{$f};
1614 $CPAN::Frontend->myprint("($p");
1615 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
1616 $self->reload_this($f) or $failed++;
1617 my $v = eval "$p\::->VERSION";
1618 $CPAN::Frontend->myprint("v$v)");
1620 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1622 my $errors = $failed == 1 ? "error" : "errors";
1623 $CPAN::Frontend->mywarn("\n$failed $errors during reload. You better quit ".
1626 } elsif ($command =~ /^index$/i) {
1627 CPAN::Index->force_reload;
1629 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN modules
1630 index re-reads the index files\n});
1634 # reload means only load again what we have loaded before
1635 #-> sub CPAN::Shell::reload_this ;
1637 my($self,$f,$args) = @_;
1638 CPAN->debug("f[$f]") if $CPAN::DEBUG;
1639 return 1 unless $INC{$f}; # we never loaded this, so we do not
1641 my $pwd = CPAN::anycwd();
1642 CPAN->debug("pwd[$pwd]") if $CPAN::DEBUG;
1644 for my $inc (@INC) {
1645 $file = File::Spec->catfile($inc,split /\//, $f);
1649 CPAN->debug("file[$file]") if $CPAN::DEBUG;
1651 unless ($file && -f $file) {
1652 # this thingie is not in the INC path, maybe CPAN/MyConfig.pm?
1654 unless (CPAN->has_inst("File::Basename")) {
1655 @inc = File::Basename::dirname($file);
1657 # do we ever need this?
1658 @inc = substr($file,0,-length($f)-1); # bring in back to me!
1661 CPAN->debug("file[$file]inc[@inc]") if $CPAN::DEBUG;
1663 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
1666 my $mtime = (stat $file)[9];
1667 $reload->{$f} ||= $^T;
1668 my $must_reload = $mtime > $reload->{$f};
1670 $must_reload ||= $args->{force};
1672 my $fh = FileHandle->new($file) or
1673 $CPAN::Frontend->mydie("Could not open $file: $!");
1676 my $content = <$fh>;
1677 CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128)))
1681 eval "require '$f'";
1686 $reload->{$f} = time;
1688 $CPAN::Frontend->myprint("__unchanged__");
1693 #-> sub CPAN::Shell::mkmyconfig ;
1695 my($self, $cpanpm, %args) = @_;
1696 require CPAN::FirstTime;
1697 my $home = CPAN::HandleConfig::home;
1698 $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
1699 File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
1700 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
1701 CPAN::HandleConfig::require_myconfig_or_config;
1702 $CPAN::Config ||= {};
1707 keep_source_where => undef,
1710 CPAN::FirstTime::init($cpanpm, %args);
1713 #-> sub CPAN::Shell::_binary_extensions ;
1714 sub _binary_extensions {
1715 my($self) = shift @_;
1716 my(@result,$module,%seen,%need,$headerdone);
1717 for $module ($self->expand('Module','/./')) {
1718 my $file = $module->cpan_file;
1719 next if $file eq "N/A";
1720 next if $file =~ /^Contact Author/;
1721 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
1722 next if $dist->isa_perl;
1723 next unless $module->xs_file;
1725 $CPAN::Frontend->myprint(".");
1726 push @result, $module;
1728 # print join " | ", @result;
1729 $CPAN::Frontend->myprint("\n");
1733 #-> sub CPAN::Shell::recompile ;
1735 my($self) = shift @_;
1736 my($module,@module,$cpan_file,%dist);
1737 @module = $self->_binary_extensions();
1738 for $module (@module){ # we force now and compile later, so we
1740 $cpan_file = $module->cpan_file;
1741 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1743 $dist{$cpan_file}++;
1745 for $cpan_file (sort keys %dist) {
1746 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1747 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1749 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1750 # stop a package from recompiling,
1751 # e.g. IO-1.12 when we have perl5.003_10
1755 #-> sub CPAN::Shell::scripts ;
1757 my($self, $arg) = @_;
1758 $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n");
1760 for my $req (qw( HTML::LinkExtor Sort::Versions List::Util )) {
1761 unless ($CPAN::META->has_inst($req)) {
1762 $CPAN::Frontend->mywarn(" $req not available\n");
1765 my $p = HTML::LinkExtor->new();
1766 my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html";
1767 unless (-f $indexfile) {
1768 $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n");
1770 $p->parse_file($indexfile);
1773 if ($arg =~ s|^/(.+)/$|$1|) {
1774 $qrarg = eval 'qr/$arg/'; # hide construct from 5.004
1776 for my $l ($p->links) {
1777 my $tag = shift @$l;
1778 next unless $tag eq "a";
1780 my $href = $att{href};
1781 next unless $href =~ s|^\.\./authors/id/./../||;
1784 if ($href =~ $qrarg) {
1788 if ($href =~ /\Q$arg\E/) {
1796 # now filter for the latest version if there is more than one of a name
1802 $stems{$stem} ||= [];
1803 push @{$stems{$stem}}, $href;
1805 for (sort keys %stems) {
1807 if (@{$stems{$_}} > 1) {
1808 $highest = List::Util::reduce {
1809 Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b
1812 $highest = $stems{$_}[0];
1814 $CPAN::Frontend->myprint("$highest\n");
1818 #-> sub CPAN::Shell::report ;
1820 my($self,@args) = @_;
1821 unless ($CPAN::META->has_inst("CPAN::Reporter")) {
1822 $CPAN::Frontend->mydie("CPAN::Reporter not installed; cannot continue");
1824 local $CPAN::Config->{test_report} = 1;
1825 $self->force("test",@args); # force is there so that the test be
1826 # re-run (as documented)
1829 #-> sub CPAN::Shell::upgrade ;
1831 my($self,@args) = @_;
1832 $self->install($self->r(@args));
1835 #-> sub CPAN::Shell::_u_r_common ;
1837 my($self) = shift @_;
1838 my($what) = shift @_;
1839 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1840 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
1841 $what && $what =~ /^[aru]$/;
1843 @args = '/./' unless @args;
1844 my(@result,$module,%seen,%need,$headerdone,
1845 $version_undefs,$version_zeroes);
1846 $version_undefs = $version_zeroes = 0;
1847 my $sprintf = "%s%-25s%s %9s %9s %s\n";
1848 my @expand = $self->expand('Module',@args);
1849 my $expand = scalar @expand;
1850 if (0) { # Looks like noise to me, was very useful for debugging
1851 # for metadata cache
1852 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
1854 MODULE: for $module (@expand) {
1855 my $file = $module->cpan_file;
1856 next MODULE unless defined $file; # ??
1857 $file =~ s|^./../||;
1858 my($latest) = $module->cpan_version;
1859 my($inst_file) = $module->inst_file;
1861 return if $CPAN::Signal;
1864 $have = $module->inst_version;
1865 } elsif ($what eq "r") {
1866 $have = $module->inst_version;
1868 if ($have eq "undef"){
1870 } elsif ($have == 0){
1873 next MODULE unless CPAN::Version->vgt($latest, $have);
1874 # to be pedantic we should probably say:
1875 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
1876 # to catch the case where CPAN has a version 0 and we have a version undef
1877 } elsif ($what eq "u") {
1883 } elsif ($what eq "r") {
1885 } elsif ($what eq "u") {
1889 return if $CPAN::Signal; # this is sometimes lengthy
1892 push @result, sprintf "%s %s\n", $module->id, $have;
1893 } elsif ($what eq "r") {
1894 push @result, $module->id;
1895 next MODULE if $seen{$file}++;
1896 } elsif ($what eq "u") {
1897 push @result, $module->id;
1898 next MODULE if $seen{$file}++;
1899 next MODULE if $file =~ /^Contact/;
1901 unless ($headerdone++){
1902 $CPAN::Frontend->myprint("\n");
1903 $CPAN::Frontend->myprint(sprintf(
1906 "Package namespace",
1918 $CPAN::META->has_inst("Term::ANSIColor")
1920 $module->description
1922 $color_on = Term::ANSIColor::color("green");
1923 $color_off = Term::ANSIColor::color("reset");
1925 $CPAN::Frontend->myprint(sprintf $sprintf,
1932 $need{$module->id}++;
1936 $CPAN::Frontend->myprint("No modules found for @args\n");
1937 } elsif ($what eq "r") {
1938 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
1942 if ($version_zeroes) {
1943 my $s_has = $version_zeroes > 1 ? "s have" : " has";
1944 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
1945 qq{a version number of 0\n});
1947 if ($version_undefs) {
1948 my $s_has = $version_undefs > 1 ? "s have" : " has";
1949 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
1950 qq{parseable version number\n});
1956 #-> sub CPAN::Shell::r ;
1958 shift->_u_r_common("r",@_);
1961 #-> sub CPAN::Shell::u ;
1963 shift->_u_r_common("u",@_);
1966 #-> sub CPAN::Shell::failed ;
1968 my($self,$only_id,$silent) = @_;
1970 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
1972 NAY: for my $nosayer (
1981 next unless exists $d->{$nosayer};
1983 $d->{$nosayer}->can("failed") ?
1984 $d->{$nosayer}->failed :
1985 $d->{$nosayer} =~ /^NO/
1987 next NAY if $only_id && $only_id != (
1988 $d->{$nosayer}->can("commandid")
1990 $d->{$nosayer}->commandid
1992 $CPAN::CurrentCommandId
1997 next DIST unless $failed;
2001 # " %-45s: %s %s\n",
2004 $d->{$failed}->can("failed") ?
2006 $d->{$failed}->commandid,
2009 $d->{$failed}->text,
2019 my $scope = $only_id ? "command" : "session";
2021 my $print = join "",
2022 map { sprintf " %-45s: %s %s\n", @$_[1,2,3] }
2023 sort { $a->[0] <=> $b->[0] } @failed;
2024 $CPAN::Frontend->myprint("Failed during this $scope:\n$print");
2025 } elsif (!$only_id || !$silent) {
2026 $CPAN::Frontend->myprint("Nothing failed in this $scope\n");
2030 # XXX intentionally undocumented because completely bogus, unportable,
2033 #-> sub CPAN::Shell::status ;
2036 require Devel::Size;
2037 my $ps = FileHandle->new;
2038 open $ps, "/proc/$$/status";
2041 next unless /VmSize:\s+(\d+)/;
2045 $CPAN::Frontend->mywarn(sprintf(
2046 "%-27s %6d\n%-27s %6d\n",
2050 Devel::Size::total_size($CPAN::META)/1024,
2052 for my $k (sort keys %$CPAN::META) {
2053 next unless substr($k,0,4) eq "read";
2054 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
2055 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
2056 warn sprintf " %-25s %6d (keys: %6d)\n",
2058 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
2059 scalar keys %{$CPAN::META->{$k}{$k2}};
2064 #-> sub CPAN::Shell::autobundle ;
2067 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
2068 my(@bundle) = $self->_u_r_common("a",@_);
2069 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2070 File::Path::mkpath($todir);
2071 unless (-d $todir) {
2072 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
2075 my($y,$m,$d) = (localtime)[5,4,3];
2079 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
2080 my($to) = File::Spec->catfile($todir,"$me.pm");
2082 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
2083 $to = File::Spec->catfile($todir,"$me.pm");
2085 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
2087 "package Bundle::$me;\n\n",
2088 "\$VERSION = '0.01';\n\n",
2092 "Bundle::$me - Snapshot of installation on ",
2093 $Config::Config{'myhostname'},
2096 "\n\n=head1 SYNOPSIS\n\n",
2097 "perl -MCPAN -e 'install Bundle::$me'\n\n",
2098 "=head1 CONTENTS\n\n",
2099 join("\n", @bundle),
2100 "\n\n=head1 CONFIGURATION\n\n",
2102 "\n\n=head1 AUTHOR\n\n",
2103 "This Bundle has been generated automatically ",
2104 "by the autobundle routine in CPAN.pm.\n",
2107 $CPAN::Frontend->myprint("\nWrote bundle file
2111 #-> sub CPAN::Shell::expandany ;
2114 CPAN->debug("s[$s]") if $CPAN::DEBUG;
2115 if ($s =~ m|/| or substr($s,-1,1) eq ".") { # looks like a file or a directory
2116 $s = CPAN::Distribution->normalize($s);
2117 return $CPAN::META->instance('CPAN::Distribution',$s);
2118 # Distributions spring into existence, not expand
2119 } elsif ($s =~ m|^Bundle::|) {
2120 $self->local_bundles; # scanning so late for bundles seems
2121 # both attractive and crumpy: always
2122 # current state but easy to forget
2124 return $self->expand('Bundle',$s);
2126 return $self->expand('Module',$s)
2127 if $CPAN::META->exists('CPAN::Module',$s);
2132 #-> sub CPAN::Shell::expand ;
2135 my($type,@args) = @_;
2136 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
2137 my $class = "CPAN::$type";
2138 my $methods = ['id'];
2139 for my $meth (qw(name)) {
2140 next if $] < 5.00303; # no "can"
2141 next unless $class->can($meth);
2142 push @$methods, $meth;
2144 $self->expand_by_method($class,$methods,@args);
2147 sub expand_by_method {
2149 my($class,$methods,@args) = @_;
2152 my($regex,$command);
2153 if ($arg =~ m|^/(.*)/$|) {
2155 } elsif ($arg =~ m/=/) {
2159 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
2161 defined $regex ? $regex : "UNDEFINED",
2162 defined $command ? $command : "UNDEFINED",
2164 if (defined $regex) {
2166 $CPAN::META->all_objects($class)
2169 # BUG, we got an empty object somewhere
2170 require Data::Dumper;
2171 CPAN->debug(sprintf(
2172 "Bug in CPAN: Empty id on obj[%s][%s]",
2174 Data::Dumper::Dumper($obj)
2178 for my $method (@$methods) {
2179 my $match = eval {$obj->$method() =~ /$regex/i};
2181 my($err) = $@ =~ /^(.+) at .+? line \d+\.$/;
2182 $err ||= $@; # if we were too restrictive above
2183 $CPAN::Frontend->mydie("$err\n");
2190 } elsif ($command) {
2191 die "equal sign in command disabled (immature interface), ".
2193 ! \$CPAN::Shell::ADVANCED_QUERY=1
2194 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
2195 that may go away anytime.\n"
2196 unless $ADVANCED_QUERY;
2197 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
2198 my($matchcrit) = $criterion =~ m/^~(.+)/;
2202 $CPAN::META->all_objects($class)
2204 my $lhs = $self->$method() or next; # () for 5.00503
2206 push @m, $self if $lhs =~ m/$matchcrit/;
2208 push @m, $self if $lhs eq $criterion;
2213 if ( $class eq 'CPAN::Bundle' ) {
2214 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
2215 } elsif ($class eq "CPAN::Distribution") {
2216 $xarg = CPAN::Distribution->normalize($arg);
2220 if ($CPAN::META->exists($class,$xarg)) {
2221 $obj = $CPAN::META->instance($class,$xarg);
2222 } elsif ($CPAN::META->exists($class,$arg)) {
2223 $obj = $CPAN::META->instance($class,$arg);
2230 @m = sort {$a->id cmp $b->id} @m;
2231 if ( $CPAN::DEBUG ) {
2232 my $wantarray = wantarray;
2233 my $join_m = join ",", map {$_->id} @m;
2234 $self->debug("wantarray[$wantarray]join_m[$join_m]");
2236 return wantarray ? @m : $m[0];
2239 #-> sub CPAN::Shell::format_result ;
2242 my($type,@args) = @_;
2243 @args = '/./' unless @args;
2244 my(@result) = $self->expand($type,@args);
2245 my $result = @result == 1 ?
2246 $result[0]->as_string :
2248 "No objects of type $type found for argument @args\n" :
2250 (map {$_->as_glimpse} @result),
2251 scalar @result, " items found\n",
2256 #-> sub CPAN::Shell::report_fh ;
2258 my $installation_report_fh;
2259 my $previously_noticed = 0;
2262 return $installation_report_fh if $installation_report_fh;
2263 if ($CPAN::META->has_inst("File::Temp")) {
2264 $installation_report_fh
2266 template => 'cpan_install_XXXX',
2271 unless ( $installation_report_fh ) {
2272 warn("Couldn't open installation report file; " .
2273 "no report file will be generated."
2274 ) unless $previously_noticed++;
2280 # The only reason for this method is currently to have a reliable
2281 # debugging utility that reveals which output is going through which
2282 # channel. No, I don't like the colors ;-)
2284 # to turn colordebugging on, write
2285 # cpan> o conf colorize_output 1
2287 #-> sub CPAN::Shell::print_ornamented ;
2289 my $print_ornamented_have_warned = 0;
2290 sub colorize_output {
2291 my $colorize_output = $CPAN::Config->{colorize_output};
2292 if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) {
2293 unless ($print_ornamented_have_warned++) {
2294 # no myprint/mywarn within myprint/mywarn!
2295 warn "Colorize_output is set to true but Term::ANSIColor is not
2296 installed. To activate colorized output, please install Term::ANSIColor.\n\n";
2298 $colorize_output = 0;
2300 return $colorize_output;
2305 sub print_ornamented {
2306 my($self,$what,$ornament) = @_;
2307 return unless defined $what;
2309 local $| = 1; # Flush immediately
2310 if ( $CPAN::Be_Silent ) {
2311 print {report_fh()} $what;
2314 my $swhat = "$what"; # stringify if it is an object
2315 if ($CPAN::Config->{term_is_latin}){
2318 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
2320 if ($self->colorize_output) {
2321 if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) {
2322 # if you want to have this configurable, please file a bugreport
2323 $ornament = "black on_cyan";
2325 my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
2327 print "Term::ANSIColor rejects color[$ornament]: $@\n
2328 Please choose a different color (Hint: try 'o conf init color.*')\n";
2332 Term::ANSIColor::color("reset");
2338 # where is myprint/mywarn/Frontend/etc. documented? We need guidelines
2339 # where to use what! I think, we send everything to STDOUT and use
2340 # print for normal/good news and warn for news that need more
2341 # attention. Yes, this is our working contract for now.
2343 my($self,$what) = @_;
2345 $self->print_ornamented($what, $CPAN::Config->{colorize_print}||'bold blue on_white');
2349 my($self,$what) = @_;
2350 $self->myprint($what);
2355 my($self,$what) = @_;
2356 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2359 # only to be used for shell commands
2361 my($self,$what) = @_;
2362 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2364 # If it is the shell, we want that the following die to be silent,
2365 # but if it is not the shell, we would need a 'die $what'. We need
2366 # to take care that only shell commands use mydie. Is this
2372 # sub CPAN::Shell::colorable_makemaker_prompt
2373 sub colorable_makemaker_prompt {
2375 if (CPAN::Shell->colorize_output) {
2376 my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white';
2377 my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
2380 my $ans = ExtUtils::MakeMaker::prompt($foo,$bar);
2381 if (CPAN::Shell->colorize_output) {
2382 print Term::ANSIColor::color('reset');
2387 # use this only for unrecoverable errors!
2388 sub unrecoverable_error {
2389 my($self,$what) = @_;
2390 my @lines = split /\n/, $what;
2392 for my $l (@lines) {
2393 $longest = length $l if length $l > $longest;
2395 $longest = 62 if $longest > 62;
2396 for my $l (@lines) {
2402 if (length $l < 66) {
2403 $l = pack "A66 A*", $l, "<==";
2407 unshift @lines, "\n";
2408 $self->mydie(join "", @lines);
2412 my($self, $sleep) = @_;
2417 return if -t STDOUT;
2418 my $odef = select STDERR;
2425 #-> sub CPAN::Shell::rematein ;
2426 # RE-adme||MA-ke||TE-st||IN-stall
2429 my($meth,@some) = @_;
2431 while($meth =~ /^(force|notest)$/) {
2432 push @pragma, $meth;
2433 $meth = shift @some or
2434 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
2438 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
2440 # Here is the place to set "test_count" on all involved parties to
2441 # 0. We then can pass this counter on to the involved
2442 # distributions and those can refuse to test if test_count > X. In
2443 # the first stab at it we could use a 1 for "X".
2445 # But when do I reset the distributions to start with 0 again?
2446 # Jost suggested to have a random or cycling interaction ID that
2447 # we pass through. But the ID is something that is just left lying
2448 # around in addition to the counter, so I'd prefer to set the
2449 # counter to 0 now, and repeat at the end of the loop. But what
2450 # about dependencies? They appear later and are not reset, they
2451 # enter the queue but not its copy. How do they get a sensible
2454 # construct the queue
2456 STHING: foreach $s (@some) {
2459 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
2461 } elsif ($s =~ m|[\$\@\%]|) { # looks like a perl variable
2462 } elsif ($s =~ m|^/|) { # looks like a regexp
2463 if (substr($s,-1,1) eq ".") {
2464 $obj = CPAN::Shell->expandany($s);
2466 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
2467 "not supported.\nRejecting argument '$s'\n");
2468 $CPAN::Frontend->mysleep(2);
2471 } elsif ($meth eq "ls") {
2472 $self->globls($s,\@pragma);
2475 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
2476 $obj = CPAN::Shell->expandany($s);
2479 } elsif (ref $obj) {
2480 $obj->color_cmd_tmps(0,1);
2481 CPAN::Queue->new(qmod => $obj->id, reqtype => "c");
2483 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
2484 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
2485 if ($meth =~ /^(dump|ls)$/) {
2488 $CPAN::Frontend->mywarn(
2490 "Don't be silly, you can't $meth ",
2494 $CPAN::Frontend->mysleep(2);
2496 } elsif ($s =~ m|[\$\@\%]| && $meth eq "dump") {
2497 CPAN::InfoObj->dump($s);
2500 ->mywarn(qq{Warning: Cannot $meth $s, }.
2501 qq{don't know what it is.
2506 to find objects with matching identifiers.
2508 $CPAN::Frontend->mysleep(2);
2512 # queuerunner (please be warned: when I started to change the
2513 # queue to hold objects instead of names, I made one or two
2514 # mistakes and never found which. I reverted back instead)
2515 while (my $q = CPAN::Queue->first) {
2517 my $s = $q->as_string;
2518 my $reqtype = $q->reqtype || "";
2519 $obj = CPAN::Shell->expandany($s);
2520 $obj->{reqtype} ||= "";
2521 CPAN->debug("obj-reqtype[$obj->{reqtype}]".
2522 "q-reqtype[$reqtype]") if $CPAN::DEBUG;
2523 if ($obj->{reqtype}) {
2524 if ($obj->{reqtype} eq "b" && $reqtype =~ /^[rc]$/) {
2525 $obj->{reqtype} = $reqtype;
2527 exists $obj->{install}
2530 $obj->{install}->can("failed") ?
2531 $obj->{install}->failed :
2532 $obj->{install} =~ /^NO/
2535 delete $obj->{install};
2536 $CPAN::Frontend->mywarn
2537 ("Promoting $obj->{ID} from 'build_requires' to 'requires'");
2541 $obj->{reqtype} = $reqtype;
2544 for my $pragma (@pragma) {
2547 ($] < 5.00303 || $obj->can($pragma))){
2548 ### compatibility with 5.003
2549 $obj->$pragma($meth); # the pragma "force" in
2550 # "CPAN::Distribution" must know
2551 # what we are intending
2554 if ($]>=5.00303 && $obj->can('called_for')) {
2555 $obj->called_for($s);
2557 CPAN->debug(qq{pragma[@pragma]meth[$meth]}.
2558 qq{ID[$obj->{ID}]}) if $CPAN::DEBUG;
2562 CPAN::Queue->delete($s);
2564 CPAN->debug("failed");
2568 CPAN::Queue->delete_first($s);
2570 for my $obj (@qcopy) {
2571 $obj->color_cmd_tmps(0,0);
2575 #-> sub CPAN::Shell::recent ;
2579 CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
2584 # set up the dispatching methods
2586 for my $command (qw(
2601 *$command = sub { shift->rematein($command, @_); };
2605 package CPAN::LWP::UserAgent;
2609 return if $SETUPDONE;
2610 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2611 require LWP::UserAgent;
2612 @ISA = qw(Exporter LWP::UserAgent);
2615 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
2619 sub get_basic_credentials {
2620 my($self, $realm, $uri, $proxy) = @_;
2621 if ($USER && $PASSWD) {
2622 return ($USER, $PASSWD);
2625 ($USER,$PASSWD) = $self->get_proxy_credentials();
2627 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
2629 return($USER,$PASSWD);
2632 sub get_proxy_credentials {
2634 my ($user, $password);
2635 if ( defined $CPAN::Config->{proxy_user} &&
2636 defined $CPAN::Config->{proxy_pass}) {
2637 $user = $CPAN::Config->{proxy_user};
2638 $password = $CPAN::Config->{proxy_pass};
2639 return ($user, $password);
2641 my $username_prompt = "\nProxy authentication needed!
2642 (Note: to permanently configure username and password run
2643 o conf proxy_user your_username
2644 o conf proxy_pass your_password
2646 ($user, $password) =
2647 _get_username_and_password_from_user($username_prompt);
2648 return ($user,$password);
2651 sub get_non_proxy_credentials {
2653 my ($user,$password);
2654 if ( defined $CPAN::Config->{username} &&
2655 defined $CPAN::Config->{password}) {
2656 $user = $CPAN::Config->{username};
2657 $password = $CPAN::Config->{password};
2658 return ($user, $password);
2660 my $username_prompt = "\nAuthentication needed!
2661 (Note: to permanently configure username and password run
2662 o conf username your_username
2663 o conf password your_password
2666 ($user, $password) =
2667 _get_username_and_password_from_user($username_prompt);
2668 return ($user,$password);
2671 sub _get_username_and_password_from_user {
2673 my $username_message = shift;
2674 my ($username,$password);
2676 ExtUtils::MakeMaker->import(qw(prompt));
2677 $username = prompt($username_message);
2678 if ($CPAN::META->has_inst("Term::ReadKey")) {
2679 Term::ReadKey::ReadMode("noecho");
2682 $CPAN::Frontend->mywarn(
2683 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
2686 $password = prompt("Password:");
2688 if ($CPAN::META->has_inst("Term::ReadKey")) {
2689 Term::ReadKey::ReadMode("restore");
2691 $CPAN::Frontend->myprint("\n\n");
2692 return ($username,$password);
2695 # mirror(): Its purpose is to deal with proxy authentication. When we
2696 # call SUPER::mirror, we relly call the mirror method in
2697 # LWP::UserAgent. LWP::UserAgent will then call
2698 # $self->get_basic_credentials or some equivalent and this will be
2699 # $self->dispatched to our own get_basic_credentials method.
2701 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2703 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2704 # although we have gone through our get_basic_credentials, the proxy
2705 # server refuses to connect. This could be a case where the username or
2706 # password has changed in the meantime, so I'm trying once again without
2707 # $USER and $PASSWD to give the get_basic_credentials routine another
2708 # chance to set $USER and $PASSWD.
2710 # mirror(): Its purpose is to deal with proxy authentication. When we
2711 # call SUPER::mirror, we relly call the mirror method in
2712 # LWP::UserAgent. LWP::UserAgent will then call
2713 # $self->get_basic_credentials or some equivalent and this will be
2714 # $self->dispatched to our own get_basic_credentials method.
2716 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2718 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2719 # although we have gone through our get_basic_credentials, the proxy
2720 # server refuses to connect. This could be a case where the username or
2721 # password has changed in the meantime, so I'm trying once again without
2722 # $USER and $PASSWD to give the get_basic_credentials routine another
2723 # chance to set $USER and $PASSWD.
2726 my($self,$url,$aslocal) = @_;
2727 my $result = $self->SUPER::mirror($url,$aslocal);
2728 if ($result->code == 407) {
2731 $result = $self->SUPER::mirror($url,$aslocal);
2739 #-> sub CPAN::FTP::ftp_get ;
2741 my($class,$host,$dir,$file,$target) = @_;
2743 qq[Going to fetch file [$file] from dir [$dir]
2744 on host [$host] as local [$target]\n]
2746 my $ftp = Net::FTP->new($host);
2748 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
2751 return 0 unless defined $ftp;
2752 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
2753 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
2754 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
2755 my $msg = $ftp->message;
2756 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
2759 unless ( $ftp->cwd($dir) ){
2760 my $msg = $ftp->message;
2761 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
2765 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
2766 unless ( $ftp->get($file,$target) ){
2767 my $msg = $ftp->message;
2768 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
2771 $ftp->quit; # it's ok if this fails
2775 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
2777 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
2778 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
2780 # > *** 1562,1567 ****
2781 # > --- 1562,1580 ----
2782 # > return 1 if substr($url,0,4) eq "file";
2783 # > return 1 unless $url =~ m|://([^/]+)|;
2785 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
2787 # > + $proxy =~ m|://([^/:]+)|;
2789 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
2790 # > + if ($noproxy) {
2791 # > + if ($host !~ /$noproxy$/) {
2792 # > + $host = $proxy;
2795 # > + $host = $proxy;
2798 # > require Net::Ping;
2799 # > return 1 unless $Net::Ping::VERSION >= 2;
2803 #-> sub CPAN::FTP::localize ;
2805 my($self,$file,$aslocal,$force) = @_;
2807 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
2808 unless defined $aslocal;
2809 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
2812 if ($^O eq 'MacOS') {
2813 # Comment by AK on 2000-09-03: Uniq short filenames would be
2814 # available in CHECKSUMS file
2815 my($name, $path) = File::Basename::fileparse($aslocal, '');
2816 if (length($name) > 31) {
2827 my $size = 31 - length($suf);
2828 while (length($name) > $size) {
2832 $aslocal = File::Spec->catfile($path, $name);
2836 if (-f $aslocal && -r _ && !($force & 1)){
2838 if ($size = -s $aslocal) {
2839 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
2842 # empty file from a previous unsuccessful attempt to download it
2844 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
2845 "could not remove.");
2850 rename $aslocal, "$aslocal.bak";
2854 my($aslocal_dir) = File::Basename::dirname($aslocal);
2855 File::Path::mkpath($aslocal_dir);
2856 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
2857 qq{directory "$aslocal_dir".
2858 I\'ll continue, but if you encounter problems, they may be due
2859 to insufficient permissions.\n}) unless -w $aslocal_dir;
2861 # Inheritance is not easier to manage than a few if/else branches
2862 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2864 CPAN::LWP::UserAgent->config;
2865 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
2867 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
2871 $Ua->proxy('ftp', $var)
2872 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
2873 $Ua->proxy('http', $var)
2874 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
2877 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
2879 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
2880 # > use ones that require basic autorization.
2882 # > Example of when I use it manually in my own stuff:
2884 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
2885 # > $req->proxy_authorization_basic("username","password");
2886 # > $res = $ua->request($req);
2890 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
2894 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
2895 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
2898 # Try the list of urls for each single object. We keep a record
2899 # where we did get a file from
2900 my(@reordered,$last);
2901 $CPAN::Config->{urllist} ||= [];
2902 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
2903 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
2904 $CPAN::Config->{urllist} = [];
2906 $last = $#{$CPAN::Config->{urllist}};
2907 if ($force & 2) { # local cpans probably out of date, don't reorder
2908 @reordered = (0..$last);
2912 (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
2914 (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
2916 defined($ThesiteURL)
2918 ($CPAN::Config->{urllist}[$b] eq $ThesiteURL)
2920 ($CPAN::Config->{urllist}[$a] eq $ThesiteURL)
2925 $self->debug("Themethod[$Themethod]") if $CPAN::DEBUG;
2927 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
2929 @levels = qw/easy hard hardest/;
2931 @levels = qw/easy/ if $^O eq 'MacOS';
2933 local $ENV{FTP_PASSIVE} =
2934 exists $CPAN::Config->{ftp_passive} ?
2935 $CPAN::Config->{ftp_passive} : 1;
2936 for $levelno (0..$#levels) {
2937 my $level = $levels[$levelno];
2938 my $method = "host$level";
2939 my @host_seq = $level eq "easy" ?
2940 @reordered : 0..$last; # reordered has CDROM up front
2941 my @urllist = map { $CPAN::Config->{urllist}[$_] } @host_seq;
2942 for my $u (@urllist) {
2943 if ($u->can("text")) {
2944 $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
2946 $u .= "/" unless substr($u,-1) eq "/";
2947 $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
2950 for my $u (@CPAN::Defaultsites) {
2951 push @urllist, $u unless grep { $_ eq $u } @urllist;
2953 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
2954 my $ret = $self->$method(\@urllist,$file,$aslocal);
2956 $Themethod = $level;
2958 # utime $now, $now, $aslocal; # too bad, if we do that, we
2959 # might alter a local mirror
2960 $self->debug("level[$level]") if $CPAN::DEBUG;
2964 last if $CPAN::Signal; # need to cleanup
2967 unless ($CPAN::Signal) {
2970 if (@{$CPAN::Config->{urllist}}) {
2972 qq{Please check, if the URLs I found in your configuration file \(}.
2973 join(", ", @{$CPAN::Config->{urllist}}).
2976 push @mess, qq{Your urllist is empty!};
2978 push @mess, qq{The urllist can be edited.},
2979 qq{E.g. with 'o conf urllist push ftp://myurl/'};
2980 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
2981 $CPAN::Frontend->mywarn("Could not fetch $file\n");
2982 $CPAN::Frontend->mysleep(2);
2985 rename "$aslocal.bak", $aslocal;
2986 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
2987 $self->ls($aslocal));
2993 # package CPAN::FTP;
2995 my($self,$host_seq,$file,$aslocal) = @_;
2997 HOSTEASY: for $ro_url (@$host_seq) {
2998 my $url .= "$ro_url$file";
2999 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
3000 if ($url =~ /^file:/) {
3002 if ($CPAN::META->has_inst('URI::URL')) {
3003 my $u = URI::URL->new($url);
3005 } else { # works only on Unix, is poorly constructed, but
3006 # hopefully better than nothing.
3007 # RFC 1738 says fileurl BNF is
3008 # fileurl = "file://" [ host | "localhost" ] "/" fpath
3009 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
3011 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
3012 $l =~ s|^file:||; # assume they
3016 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
3018 $self->debug("local file[$l]") if $CPAN::DEBUG;
3019 if ( -f $l && -r _) {
3020 $ThesiteURL = $ro_url;
3023 if ($l =~ /(.+)\.gz$/) {
3025 if ( -f $ungz && -r _) {
3026 $ThesiteURL = $ro_url;
3030 # Maybe mirror has compressed it?
3032 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
3033 CPAN::Tarzip->new("$l.gz")->gunzip($aslocal);
3035 $ThesiteURL = $ro_url;
3040 if ($CPAN::META->has_usable('LWP')) {
3041 $CPAN::Frontend->myprint("Fetching with LWP:
3045 CPAN::LWP::UserAgent->config;
3046 eval { $Ua = CPAN::LWP::UserAgent->new; };
3048 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
3051 my $res = $Ua->mirror($url, $aslocal);
3052 if ($res->is_success) {
3053 $ThesiteURL = $ro_url;
3055 utime $now, $now, $aslocal; # download time is more
3056 # important than upload
3059 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3060 my $gzurl = "$url.gz";
3061 $CPAN::Frontend->myprint("Fetching with LWP:
3064 $res = $Ua->mirror($gzurl, "$aslocal.gz");
3065 if ($res->is_success &&
3066 CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)
3068 $ThesiteURL = $ro_url;
3072 $CPAN::Frontend->myprint(sprintf(
3073 "LWP failed with code[%s] message[%s]\n",
3077 # Alan Burlison informed me that in firewall environments
3078 # Net::FTP can still succeed where LWP fails. So we do not
3079 # skip Net::FTP anymore when LWP is available.
3082 $ro_url->can("text")
3084 $ro_url->{FROM} eq "USER"
3086 my $ret = $self->hosthard([$ro_url],$file,$aslocal);
3087 return $ret if $ret;
3089 $CPAN::Frontend->mywarn(" LWP not available\n");
3091 return if $CPAN::Signal;
3092 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3093 # that's the nice and easy way thanks to Graham
3094 my($host,$dir,$getfile) = ($1,$2,$3);
3095 if ($CPAN::META->has_usable('Net::FTP')) {
3097 $CPAN::Frontend->myprint("Fetching with Net::FTP:
3100 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
3101 "aslocal[$aslocal]") if $CPAN::DEBUG;
3102 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
3103 $ThesiteURL = $ro_url;
3106 if ($aslocal !~ /\.gz(?!\n)\Z/) {
3107 my $gz = "$aslocal.gz";
3108 $CPAN::Frontend->myprint("Fetching with Net::FTP
3111 if (CPAN::FTP->ftp_get($host,
3115 CPAN::Tarzip->new($gz)->gunzip($aslocal)
3117 $ThesiteURL = $ro_url;
3124 return if $CPAN::Signal;
3128 # package CPAN::FTP;
3130 my($self,$host_seq,$file,$aslocal) = @_;
3132 # Came back if Net::FTP couldn't establish connection (or
3133 # failed otherwise) Maybe they are behind a firewall, but they
3134 # gave us a socksified (or other) ftp program...
3137 my($devnull) = $CPAN::Config->{devnull} || "";
3139 my($aslocal_dir) = File::Basename::dirname($aslocal);
3140 File::Path::mkpath($aslocal_dir);
3141 HOSTHARD: for $ro_url (@$host_seq) {
3142 my $url = "$ro_url$file";
3143 my($proto,$host,$dir,$getfile);
3145 # Courtesy Mark Conty mark_conty@cargill.com change from
3146 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3148 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
3149 # proto not yet used
3150 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
3152 next HOSTHARD; # who said, we could ftp anything except ftp?
3154 next HOSTHARD if $proto eq "file"; # file URLs would have had
3155 # success above. Likely a bogus URL
3157 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
3159 # Try the most capable first and leave ncftp* for last as it only
3161 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
3162 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
3163 next unless defined $funkyftp;
3164 next if $funkyftp =~ /^\s*$/;
3166 my($asl_ungz, $asl_gz);
3167 ($asl_ungz = $aslocal) =~ s/\.gz//;
3168 $asl_gz = "$asl_ungz.gz";
3170 my($src_switch) = "";
3172 my($stdout_redir) = " > $asl_ungz";
3174 $src_switch = " -source";
3175 } elsif ($f eq "ncftp"){
3176 $src_switch = " -c";
3177 } elsif ($f eq "wget"){
3178 $src_switch = " -O $asl_ungz";
3180 } elsif ($f eq 'curl'){
3181 $src_switch = ' -L -f -s -S --netrc-optional';
3184 if ($f eq "ncftpget"){
3185 $chdir = "cd $aslocal_dir && ";
3188 $CPAN::Frontend->myprint(
3190 Trying with "$funkyftp$src_switch" to get
3194 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
3195 $self->debug("system[$system]") if $CPAN::DEBUG;
3196 my($wstatus) = system($system);
3198 # lynx returns 0 when it fails somewhere
3200 my $content = do { local *FH; open FH, $asl_ungz or die; local $/; <FH> };
3201 if ($content =~ /^<.*<title>[45]/si) {
3202 $CPAN::Frontend->mywarn(qq{
3203 No success, the file that lynx has has downloaded looks like an error message:
3206 $CPAN::Frontend->mysleep(1);
3210 $CPAN::Frontend->myprint(qq{
3211 No success, the file that lynx has has downloaded is an empty file.
3216 if ($wstatus == 0) {
3219 } elsif ($asl_ungz ne $aslocal) {
3220 # test gzip integrity
3221 if (CPAN::Tarzip->new($asl_ungz)->gtest) {
3222 # e.g. foo.tar is gzipped --> foo.tar.gz
3223 rename $asl_ungz, $aslocal;
3225 CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz);
3228 $ThesiteURL = $ro_url;
3230 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3232 -f $asl_ungz && -s _ == 0;
3233 my $gz = "$aslocal.gz";
3234 my $gzurl = "$url.gz";
3235 $CPAN::Frontend->myprint(
3237 Trying with "$funkyftp$src_switch" to get
3240 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
3241 $self->debug("system[$system]") if $CPAN::DEBUG;
3243 if (($wstatus = system($system)) == 0
3247 # test gzip integrity
3248 my $ct = CPAN::Tarzip->new($asl_gz);
3250 $ct->gunzip($aslocal);
3252 # somebody uncompressed file for us?
3253 rename $asl_ungz, $aslocal;
3255 $ThesiteURL = $ro_url;
3258 unlink $asl_gz if -f $asl_gz;
3261 my $estatus = $wstatus >> 8;
3262 my $size = -f $aslocal ?
3263 ", left\n$aslocal with size ".-s _ :
3264 "\nWarning: expected file [$aslocal] doesn't exist";
3265 $CPAN::Frontend->myprint(qq{
3266 System call "$system"
3267 returned status $estatus (wstat $wstatus)$size
3270 return if $CPAN::Signal;
3271 } # transfer programs
3275 # package CPAN::FTP;
3277 my($self,$host_seq,$file,$aslocal) = @_;
3280 my($aslocal_dir) = File::Basename::dirname($aslocal);
3281 File::Path::mkpath($aslocal_dir);
3282 my $ftpbin = $CPAN::Config->{ftp};
3283 unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) {
3284 $CPAN::Frontend->myprint("No external ftp command available\n\n");
3287 $CPAN::Frontend->mywarn(qq{
3288 As a last ressort we now switch to the external ftp command '$ftpbin'
3291 Doing so often leads to problems that are hard to diagnose.
3293 If you're victim of such problems, please consider unsetting the ftp
3294 config variable with
3300 $CPAN::Frontend->mysleep(2);
3301 HOSTHARDEST: for $ro_url (@$host_seq) {
3302 my $url = "$ro_url$file";
3303 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
3304 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3307 my($host,$dir,$getfile) = ($1,$2,$3);
3309 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
3310 $ctime,$blksize,$blocks) = stat($aslocal);
3311 $timestamp = $mtime ||= 0;
3312 my($netrc) = CPAN::FTP::netrc->new;
3313 my($netrcfile) = $netrc->netrc;
3314 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
3315 my $targetfile = File::Basename::basename($aslocal);
3321 map("cd $_", split /\//, $dir), # RFC 1738
3323 "get $getfile $targetfile",
3327 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
3328 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
3329 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
3331 $netrc->contains($host))) if $CPAN::DEBUG;
3332 if ($netrc->protected) {
3333 my $dialog = join "", map { " $_\n" } @dialog;
3335 if ($netrc->contains($host)) {
3336 $netrc_explain = "Relying that your .netrc entry for '$host' ".
3337 "manages the login";
3339 $netrc_explain = "Relying that your default .netrc entry ".
3340 "manages the login";
3342 $CPAN::Frontend->myprint(qq{
3343 Trying with external ftp to get
3346 Going to send the dialog
3350 $self->talk_ftp("$ftpbin$verbose $host",
3352 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3353 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3355 if ($mtime > $timestamp) {
3356 $CPAN::Frontend->myprint("GOT $aslocal\n");
3357 $ThesiteURL = $ro_url;
3360 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
3362 return if $CPAN::Signal;
3364 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
3365 qq{correctly protected.\n});
3368 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
3369 nor does it have a default entry\n");
3372 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
3373 # then and login manually to host, using e-mail as
3375 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
3379 "user anonymous $Config::Config{'cf_email'}"
3381 my $dialog = join "", map { " $_\n" } @dialog;
3382 $CPAN::Frontend->myprint(qq{
3383 Trying with external ftp to get
3385 Going to send the dialog
3389 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
3390 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3391 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3393 if ($mtime > $timestamp) {
3394 $CPAN::Frontend->myprint("GOT $aslocal\n");
3395 $ThesiteURL = $ro_url;
3398 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
3400 return if $CPAN::Signal;
3401 $CPAN::Frontend->mywarn("Can't access URL $url.\n\n");
3402 $CPAN::Frontend->mysleep(2);
3406 # package CPAN::FTP;
3408 my($self,$command,@dialog) = @_;
3409 my $fh = FileHandle->new;
3410 $fh->open("|$command") or die "Couldn't open ftp: $!";
3411 foreach (@dialog) { $fh->print("$_\n") }
3412 $fh->close; # Wait for process to complete
3414 my $estatus = $wstatus >> 8;
3415 $CPAN::Frontend->myprint(qq{
3416 Subprocess "|$command"
3417 returned status $estatus (wstat $wstatus)
3421 # find2perl needs modularization, too, all the following is stolen
3425 my($self,$name) = @_;
3426 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
3427 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
3429 my($perms,%user,%group);
3433 $blocks = int(($blocks + 1) / 2);
3436 $blocks = int(($sizemm + 1023) / 1024);
3439 if (-f _) { $perms = '-'; }
3440 elsif (-d _) { $perms = 'd'; }
3441 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
3442 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
3443 elsif (-p _) { $perms = 'p'; }
3444 elsif (-S _) { $perms = 's'; }
3445 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
3447 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
3448 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
3449 my $tmpmode = $mode;
3450 my $tmp = $rwx[$tmpmode & 7];
3452 $tmp = $rwx[$tmpmode & 7] . $tmp;
3454 $tmp = $rwx[$tmpmode & 7] . $tmp;
3455 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
3456 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
3457 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
3460 my $user = $user{$uid} || $uid; # too lazy to implement lookup
3461 my $group = $group{$gid} || $gid;
3463 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
3465 my($moname) = $moname[$mon];
3466 if (-M _ > 365.25 / 2) {
3467 $timeyear = $year + 1900;
3470 $timeyear = sprintf("%02d:%02d", $hour, $min);
3473 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
3487 package CPAN::FTP::netrc;
3490 # package CPAN::FTP::netrc;
3493 my $home = CPAN::HandleConfig::home;
3494 my $file = File::Spec->catfile($home,".netrc");
3496 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3497 $atime,$mtime,$ctime,$blksize,$blocks)
3502 my($fh,@machines,$hasdefault);
3504 $fh = FileHandle->new or die "Could not create a filehandle";
3506 if($fh->open($file)){
3507 $protected = ($mode & 077) == 0;
3509 NETRC: while (<$fh>) {
3510 my(@tokens) = split " ", $_;
3511 TOKEN: while (@tokens) {
3512 my($t) = shift @tokens;
3513 if ($t eq "default"){
3517 last TOKEN if $t eq "macdef";
3518 if ($t eq "machine") {
3519 push @machines, shift @tokens;
3524 $file = $hasdefault = $protected = "";
3528 'mach' => [@machines],
3530 'hasdefault' => $hasdefault,
3531 'protected' => $protected,
3535 # CPAN::FTP::netrc::hasdefault;
3536 sub hasdefault { shift->{'hasdefault'} }
3537 sub netrc { shift->{'netrc'} }
3538 sub protected { shift->{'protected'} }
3540 my($self,$mach) = @_;
3541 for ( @{$self->{'mach'}} ) {
3542 return 1 if $_ eq $mach;
3547 package CPAN::Complete;
3551 my($text, $line, $start, $end) = @_;
3552 my(@perlret) = cpl($text, $line, $start);
3553 # find longest common match. Can anybody show me how to peruse
3554 # T::R::Gnu to have this done automatically? Seems expensive.
3555 return () unless @perlret;
3556 my($newtext) = $text;
3557 for (my $i = length($text)+1;;$i++) {
3558 last unless length($perlret[0]) && length($perlret[0]) >= $i;
3559 my $try = substr($perlret[0],0,$i);
3560 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
3561 # warn "try[$try]tries[@tries]";
3562 if (@tries == @perlret) {
3568 ($newtext,@perlret);
3571 #-> sub CPAN::Complete::cpl ;
3573 my($word,$line,$pos) = @_;
3577 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3579 if ($line =~ s/^(force\s*)//) {
3584 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
3585 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
3587 } elsif ($line =~ /^(a|ls)\s/) {
3588 @return = cplx('CPAN::Author',uc($word));
3589 } elsif ($line =~ /^b\s/) {
3590 CPAN::Shell->local_bundles;
3591 @return = cplx('CPAN::Bundle',$word);
3592 } elsif ($line =~ /^d\s/) {
3593 @return = cplx('CPAN::Distribution',$word);
3594 } elsif ($line =~ m/^(
3595 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
3597 if ($word =~ /^Bundle::/) {
3598 CPAN::Shell->local_bundles;
3600 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3601 } elsif ($line =~ /^i\s/) {
3602 @return = cpl_any($word);
3603 } elsif ($line =~ /^reload\s/) {
3604 @return = cpl_reload($word,$line,$pos);
3605 } elsif ($line =~ /^o\s/) {
3606 @return = cpl_option($word,$line,$pos);
3607 } elsif ($line =~ m/^\S+\s/ ) {
3608 # fallback for future commands and what we have forgotten above
3609 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3616 #-> sub CPAN::Complete::cplx ;
3618 my($class, $word) = @_;
3619 # I believed for many years that this was sorted, today I
3620 # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
3621 # make it sorted again. Maybe sort was dropped when GNU-readline
3622 # support came in? The RCS file is difficult to read on that:-(
3623 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
3626 #-> sub CPAN::Complete::cpl_any ;
3630 cplx('CPAN::Author',$word),
3631 cplx('CPAN::Bundle',$word),
3632 cplx('CPAN::Distribution',$word),
3633 cplx('CPAN::Module',$word),
3637 #-> sub CPAN::Complete::cpl_reload ;
3639 my($word,$line,$pos) = @_;
3641 my(@words) = split " ", $line;
3642 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3643 my(@ok) = qw(cpan index);
3644 return @ok if @words == 1;
3645 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
3648 #-> sub CPAN::Complete::cpl_option ;
3650 my($word,$line,$pos) = @_;
3652 my(@words) = split " ", $line;
3653 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3654 my(@ok) = qw(conf debug);
3655 return @ok if @words == 1;
3656 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
3658 } elsif ($words[1] eq 'index') {
3660 } elsif ($words[1] eq 'conf') {
3661 return CPAN::HandleConfig::cpl(@_);
3662 } elsif ($words[1] eq 'debug') {
3663 return sort grep /^\Q$word\E/i,
3664 sort keys %CPAN::DEBUG, 'all';
3668 package CPAN::Index;
3671 #-> sub CPAN::Index::force_reload ;
3674 $CPAN::Index::LAST_TIME = 0;
3678 #-> sub CPAN::Index::reload ;
3680 my($cl,$force) = @_;
3683 # XXX check if a newer one is available. (We currently read it
3684 # from time to time)
3685 for ($CPAN::Config->{index_expire}) {
3686 $_ = 0.001 unless $_ && $_ > 0.001;
3688 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
3689 # debug here when CPAN doesn't seem to read the Metadata
3691 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
3693 unless ($CPAN::META->{PROTOCOL}) {
3694 $cl->read_metadata_cache;
3695 $CPAN::META->{PROTOCOL} ||= "1.0";
3697 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
3698 # warn "Setting last_time to 0";
3699 $LAST_TIME = 0; # No warning necessary
3701 return if $LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
3704 # IFF we are developing, it helps to wipe out the memory
3705 # between reloads, otherwise it is not what a user expects.
3706 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
3707 $CPAN::META = CPAN->new;
3711 local $LAST_TIME = $time;
3712 local $CPAN::META->{PROTOCOL} = PROTOCOL;
3714 my $needshort = $^O eq "dos";
3716 $cl->rd_authindex($cl
3718 "authors/01mailrc.txt.gz",
3720 File::Spec->catfile('authors', '01mailrc.gz') :
3721 File::Spec->catfile('authors', '01mailrc.txt.gz'),
3724 $debug = "timing reading 01[".($t2 - $time)."]";
3726 return if $CPAN::Signal; # this is sometimes lengthy
3727 $cl->rd_modpacks($cl
3729 "modules/02packages.details.txt.gz",
3731 File::Spec->catfile('modules', '02packag.gz') :
3732 File::Spec->catfile('modules', '02packages.details.txt.gz'),
3735 $debug .= "02[".($t2 - $time)."]";
3737 return if $CPAN::Signal; # this is sometimes lengthy
3740 "modules/03modlist.data.gz",
3742 File::Spec->catfile('modules', '03mlist.gz') :
3743 File::Spec->catfile('modules', '03modlist.data.gz'),
3745 $cl->write_metadata_cache;
3747 $debug .= "03[".($t2 - $time)."]";
3749 CPAN->debug($debug) if $CPAN::DEBUG;
3752 $CPAN::META->{PROTOCOL} = PROTOCOL;
3755 #-> sub CPAN::Index::reload_x ;
3757 my($cl,$wanted,$localname,$force) = @_;
3758 $force |= 2; # means we're dealing with an index here
3759 CPAN::HandleConfig->load; # we should guarantee loading wherever
3760 # we rely on Config XXX
3761 $localname ||= $wanted;
3762 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
3766 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
3769 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
3770 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
3771 qq{day$s. I\'ll use that.});
3774 $force |= 1; # means we're quite serious about it.
3776 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
3779 #-> sub CPAN::Index::rd_authindex ;
3781 my($cl, $index_target) = @_;
3783 return unless defined $index_target;
3784 $CPAN::Frontend->myprint("Going to read $index_target\n");
3786 tie *FH, 'CPAN::Tarzip', $index_target;
3789 push @lines, split /\012/ while <FH>;
3791 my $modulus = int($#lines/75) || 1;
3792 CPAN->debug(sprintf "modulus[%d]lines[%s]", $modulus, scalar @lines) if $CPAN::DEBUG;
3794 my($userid,$fullname,$email) =
3795 m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/;
3796 $fullname ||= $email;
3797 if ($userid && $fullname && $email){
3798 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
3799 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
3801 CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG;
3803 $CPAN::Frontend->myprint(".") unless $i++ % $modulus;
3804 return if $CPAN::Signal;
3806 $CPAN::Frontend->myprint("DONE\n");
3810 my($self,$dist) = @_;
3811 $dist = $self->{'id'} unless defined $dist;
3812 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
3816 #-> sub CPAN::Index::rd_modpacks ;
3818 my($self, $index_target) = @_;
3819 return unless defined $index_target;
3820 $CPAN::Frontend->myprint("Going to read $index_target\n");
3821 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3823 CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
3826 while (my $bytes = $fh->READ(\$chunk,8192)) {
3829 my @lines = split /\012/, $slurp;
3830 CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG;
3833 my($line_count,$last_updated);
3835 my $shift = shift(@lines);
3836 last if $shift =~ /^\s*$/;
3837 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
3838 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
3840 CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
3841 if (not defined $line_count) {
3843 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
3844 Please check the validity of the index file by comparing it to more
3845 than one CPAN mirror. I'll continue but problems seem likely to
3849 $CPAN::Frontend->mysleep(5);
3850 } elsif ($line_count != scalar @lines) {
3852 $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
3853 contains a Line-Count header of %d but I see %d lines there. Please
3854 check the validity of the index file by comparing it to more than one
3855 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
3856 $index_target, $line_count, scalar(@lines));
3859 if (not defined $last_updated) {
3861 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
3862 Please check the validity of the index file by comparing it to more
3863 than one CPAN mirror. I'll continue but problems seem likely to
3867 $CPAN::Frontend->mysleep(5);
3871 ->myprint(sprintf qq{ Database was generated on %s\n},
3873 $DATE_OF_02 = $last_updated;
3876 if ($CPAN::META->has_inst('HTTP::Date')) {
3878 $age -= HTTP::Date::str2time($last_updated);
3880 $CPAN::Frontend->mywarn(" HTTP::Date not available\n");
3881 require Time::Local;
3882 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
3883 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
3884 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
3891 qq{Warning: This index file is %d days old.
3892 Please check the host you chose as your CPAN mirror for staleness.
3893 I'll continue but problems seem likely to happen.\a\n},
3896 } elsif ($age < -1) {
3900 qq{Warning: Your system date is %d days behind this index file!
3902 Timestamp index file: %s
3903 Please fix your system time, problems with the make command expected.\n},
3913 # A necessity since we have metadata_cache: delete what isn't
3915 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
3916 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
3919 my $modulus = int($#lines/75) || 1;
3921 # before 1.56 we split into 3 and discarded the rest. From
3922 # 1.57 we assign remaining text to $comment thus allowing to
3923 # influence isa_perl
3924 my($mod,$version,$dist,$comment) = split " ", $_, 4;
3925 my($bundle,$id,$userid);
3927 if ($mod eq 'CPAN' &&
3929 CPAN::Queue->exists('Bundle::CPAN') ||
3930 CPAN::Queue->exists('CPAN')
3934 if ($version > $CPAN::VERSION){
3935 $CPAN::Frontend->mywarn(qq{
3936 New CPAN.pm version (v$version) available.
3937 [Currently running version is v$CPAN::VERSION]
3938 You might want to try
3941 to both upgrade CPAN.pm and run the new version without leaving
3942 the current session.
3945 $CPAN::Frontend->mysleep(2);
3946 $CPAN::Frontend->myprint(qq{\n});
3948 last if $CPAN::Signal;
3949 } elsif ($mod =~ /^Bundle::(.*)/) {
3954 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
3955 # Let's make it a module too, because bundles have so much
3956 # in common with modules.
3958 # Changed in 1.57_63: seems like memory bloat now without
3959 # any value, so commented out
3961 # $CPAN::META->instance('CPAN::Module',$mod);
3965 # instantiate a module object
3966 $id = $CPAN::META->instance('CPAN::Module',$mod);
3970 # Although CPAN prohibits same name with different version the
3971 # indexer may have changed the version for the same distro
3972 # since the last time ("Force Reindexing" feature)
3973 if ($id->cpan_file ne $dist
3975 $id->cpan_version ne $version
3977 $userid = $id->userid || $self->userid($dist);
3979 'CPAN_USERID' => $userid,
3980 'CPAN_VERSION' => $version,
3981 'CPAN_FILE' => $dist,
3985 # instantiate a distribution object
3986 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
3987 # we do not need CONTAINSMODS unless we do something with
3988 # this dist, so we better produce it on demand.
3990 ## my $obj = $CPAN::META->instance(
3991 ## 'CPAN::Distribution' => $dist
3993 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
3995 $CPAN::META->instance(
3996 'CPAN::Distribution' => $dist
3998 'CPAN_USERID' => $userid,
3999 'CPAN_COMMENT' => $comment,
4003 for my $name ($mod,$dist) {
4004 # $self->debug("exists name[$name]") if $CPAN::DEBUG;
4005 $exists{$name} = undef;
4008 $CPAN::Frontend->myprint(".") unless $i++ % $modulus;
4009 return if $CPAN::Signal;
4011 $CPAN::Frontend->myprint("DONE\n");
4013 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
4014 for my $o ($CPAN::META->all_objects($class)) {
4015 next if exists $exists{$o->{ID}};
4016 $CPAN::META->delete($class,$o->{ID});
4017 # CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
4024 #-> sub CPAN::Index::rd_modlist ;
4026 my($cl,$index_target) = @_;
4027 return unless defined $index_target;
4028 $CPAN::Frontend->myprint("Going to read $index_target\n");
4029 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
4033 while (my $bytes = $fh->READ(\$chunk,8192)) {
4036 my @eval2 = split /\012/, $slurp;
4039 my $shift = shift(@eval2);
4040 if ($shift =~ /^Date:\s+(.*)/){
4041 if ($DATE_OF_03 eq $1){
4042 $CPAN::Frontend->myprint("Unchanged.\n");
4047 last if $shift =~ /^\s*$/;
4049 push @eval2, q{CPAN::Modulelist->data;};
4051 my($comp) = Safe->new("CPAN::Safe1");
4052 my($eval2) = join("\n", @eval2);
4053 CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
4054 my $ret = $comp->reval($eval2);
4055 Carp::confess($@) if $@;
4056 return if $CPAN::Signal;
4058 my $until = keys(%$ret) - 1;
4059 my $modulus = int($until/75) || 1;
4060 CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
4062 my $obj = $CPAN::META->instance("CPAN::Module",$_);
4063 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
4064 $obj->set(%{$ret->{$_}});
4065 $CPAN::Frontend->myprint(".") unless $i++ % $modulus;
4066 return if $CPAN::Signal;
4068 $CPAN::Frontend->myprint("DONE\n");
4071 #-> sub CPAN::Index::write_metadata_cache ;
4072 sub write_metadata_cache {
4074 return unless $CPAN::Config->{'cache_metadata'};
4075 return unless $CPAN::META->has_usable("Storable");
4077 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
4078 CPAN::Distribution)) {
4079 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
4081 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4082 $cache->{last_time} = $LAST_TIME;
4083 $cache->{DATE_OF_02} = $DATE_OF_02;
4084 $cache->{PROTOCOL} = PROTOCOL;
4085 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
4086 eval { Storable::nstore($cache, $metadata_file) };
4087 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4090 #-> sub CPAN::Index::read_metadata_cache ;
4091 sub read_metadata_cache {
4093 return unless $CPAN::Config->{'cache_metadata'};
4094 return unless $CPAN::META->has_usable("Storable");
4095 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4096 return unless -r $metadata_file and -f $metadata_file;
4097 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
4099 eval { $cache = Storable::retrieve($metadata_file) };
4100 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4101 if (!$cache || !UNIVERSAL::isa($cache, 'HASH')){
4105 if (exists $cache->{PROTOCOL}) {
4106 if (PROTOCOL > $cache->{PROTOCOL}) {
4107 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
4108 "with protocol v%s, requiring v%s\n",
4115 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
4116 "with protocol v1.0\n");
4121 while(my($class,$v) = each %$cache) {
4122 next unless $class =~ /^CPAN::/;
4123 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
4124 while (my($id,$ro) = each %$v) {
4125 $CPAN::META->{readwrite}{$class}{$id} ||=
4126 $class->new(ID=>$id, RO=>$ro);
4131 unless ($clcnt) { # sanity check
4132 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
4135 if ($idcnt < 1000) {
4136 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
4137 "in $metadata_file\n");
4140 $CPAN::META->{PROTOCOL} ||=
4141 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
4142 # does initialize to some protocol
4143 $LAST_TIME = $cache->{last_time};
4144 $DATE_OF_02 = $cache->{DATE_OF_02};
4145 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
4146 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
4150 package CPAN::InfoObj;
4155 exists $self->{RO} and return $self->{RO};
4158 #-> sub CPAN::InfoObj::cpan_userid
4163 return $ro->{CPAN_USERID} || "N/A";
4165 $self->debug("ID[$self->{ID}]");
4166 # N/A for bundles found locally
4171 sub id { shift->{ID}; }
4173 #-> sub CPAN::InfoObj::new ;
4175 my $this = bless {}, shift;
4180 # The set method may only be used by code that reads index data or
4181 # otherwise "objective" data from the outside world. All session
4182 # related material may do anything else with instance variables but
4183 # must not touch the hash under the RO attribute. The reason is that
4184 # the RO hash gets written to Metadata file and is thus persistent.
4186 #-> sub CPAN::InfoObj::safe_chdir ;
4188 my($self,$todir) = @_;
4189 # we die if we cannot chdir and we are debuggable
4190 Carp::confess("safe_chdir called without todir argument")
4191 unless defined $todir and length $todir;
4193 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4197 unless (-x $todir) {
4198 unless (chmod 0755, $todir) {
4199 my $cwd = CPAN::anycwd();
4200 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
4201 "permission to change the permission; cannot ".
4202 "chdir to '$todir'\n");
4203 $CPAN::Frontend->mysleep(5);
4204 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4205 qq{to todir[$todir]: $!});
4209 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
4212 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4215 my $cwd = CPAN::anycwd();
4216 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4217 qq{to todir[$todir] (a chmod has been issued): $!});
4222 #-> sub CPAN::InfoObj::set ;
4224 my($self,%att) = @_;
4225 my $class = ref $self;
4227 # This must be ||=, not ||, because only if we write an empty
4228 # reference, only then the set method will write into the readonly
4229 # area. But for Distributions that spring into existence, maybe
4230 # because of a typo, we do not like it that they are written into
4231 # the readonly area and made permanent (at least for a while) and
4232 # that is why we do not "allow" other places to call ->set.
4233 unless ($self->id) {
4234 CPAN->debug("Bug? Empty ID, rejecting");
4237 my $ro = $self->{RO} =
4238 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
4240 while (my($k,$v) = each %att) {
4245 #-> sub CPAN::InfoObj::as_glimpse ;
4249 my $class = ref($self);
4250 $class =~ s/^CPAN:://;
4251 my $id = $self->can("pretty_id") ? $self->pretty_id : $self->{ID};
4252 push @m, sprintf "%-15s %s\n", $class, $id;
4256 #-> sub CPAN::InfoObj::as_string ;
4260 my $class = ref($self);
4261 $class =~ s/^CPAN:://;
4262 push @m, $class, " id = $self->{ID}\n";
4264 unless ($ro = $self->ro) {
4265 if (substr($self->{ID},-1,1) eq ".") { # directory
4268 $CPAN::Frontend->mydie("Unknown object $self->{ID}");
4271 for (sort keys %$ro) {
4272 # next if m/^(ID|RO)$/;
4274 if ($_ eq "CPAN_USERID") {
4276 $extra .= $self->fullname;
4277 my $email; # old perls!
4278 if ($email = $CPAN::META->instance("CPAN::Author",
4281 $extra .= " <$email>";
4283 $extra .= " <no email>";
4286 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
4287 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
4290 next unless defined $ro->{$_};
4291 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
4293 KEY: for (sort keys %$self) {
4294 next if m/^(ID|RO)$/;
4295 unless (defined $self->{$_}) {
4299 if (ref($self->{$_}) eq "ARRAY") {
4300 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
4301 } elsif (ref($self->{$_}) eq "HASH") {
4303 if (/^CONTAINSMODS$/) {
4304 $value = join(" ",sort keys %{$self->{$_}});
4305 } elsif (/^prereq_pm$/) {
4307 my $v = $self->{$_};
4308 for my $x (sort keys %$v) {
4310 for my $y (sort keys %{$v->{$x}}) {
4311 push @svalue, "$y=>$v->{$x}{$y}";
4313 push @value, "$x\:" . join ",", @svalue;
4315 $value = join ";", @value;
4317 $value = $self->{$_};
4325 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
4331 #-> sub CPAN::InfoObj::fullname ;
4334 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
4337 #-> sub CPAN::InfoObj::dump ;
4339 my($self, $what) = @_;
4340 unless ($CPAN::META->has_inst("Data::Dumper")) {
4341 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
4343 local $Data::Dumper::Sortkeys;
4344 $Data::Dumper::Sortkeys = 1;
4345 my $out = Data::Dumper::Dumper($what ? eval $what : $self);
4346 if (length $out > 100000) {
4347 my $fh_pager = FileHandle->new;
4348 local($SIG{PIPE}) = "IGNORE";
4349 my $pager = $CPAN::Config->{'pager'} || "cat";
4350 $fh_pager->open("|$pager")
4351 or die "Could not open pager $pager\: $!";
4352 $fh_pager->print($out);
4355 $CPAN::Frontend->myprint($out);
4359 package CPAN::Author;
4362 #-> sub CPAN::Author::force
4368 #-> sub CPAN::Author::force
4371 delete $self->{force};
4374 #-> sub CPAN::Author::id
4377 my $id = $self->{ID};
4378 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
4382 #-> sub CPAN::Author::as_glimpse ;
4386 my $class = ref($self);
4387 $class =~ s/^CPAN:://;
4388 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
4396 #-> sub CPAN::Author::fullname ;
4398 shift->ro->{FULLNAME};
4402 #-> sub CPAN::Author::email ;
4403 sub email { shift->ro->{EMAIL}; }
4405 #-> sub CPAN::Author::ls ;
4408 my $glob = shift || "";
4409 my $silent = shift || 0;
4412 # adapted from CPAN::Distribution::verifyCHECKSUM ;
4413 my(@csf); # chksumfile
4414 @csf = $self->id =~ /(.)(.)(.*)/;
4415 $csf[1] = join "", @csf[0,1];
4416 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
4418 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
4419 unless (grep {$_->[2] eq $csf[1]} @dl) {
4420 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
4423 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
4424 unless (grep {$_->[2] eq $csf[2]} @dl) {
4425 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
4428 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
4430 if ($CPAN::META->has_inst("Text::Glob")) {
4431 my $rglob = Text::Glob::glob_to_regex($glob);
4432 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
4434 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
4437 $CPAN::Frontend->myprint(join "", map {
4438 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
4439 } sort { $a->[2] cmp $b->[2] } @dl);
4443 # returns an array of arrays, the latter contain (size,mtime,filename)
4444 #-> sub CPAN::Author::dir_listing ;
4447 my $chksumfile = shift;
4448 my $recursive = shift;
4449 my $may_ftp = shift;
4452 File::Spec->catfile($CPAN::Config->{keep_source_where},
4453 "authors", "id", @$chksumfile);
4457 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
4458 # hazard. (Without GPG installed they are not that much better,
4460 $fh = FileHandle->new;
4461 if (open($fh, $lc_want)) {
4462 my $line = <$fh>; close $fh;
4463 unlink($lc_want) unless $line =~ /PGP/;
4467 # connect "force" argument with "index_expire".
4468 my $force = $self->{force};
4469 if (my @stat = stat $lc_want) {
4470 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
4474 $lc_file = CPAN::FTP->localize(
4475 "authors/id/@$chksumfile",
4480 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
4481 $chksumfile->[-1] .= ".gz";
4482 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
4485 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
4486 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
4492 $lc_file = $lc_want;
4493 # we *could* second-guess and if the user has a file: URL,
4494 # then we could look there. But on the other hand, if they do
4495 # have a file: URL, wy did they choose to set
4496 # $CPAN::Config->{show_upload_date} to false?
4499 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
4500 $fh = FileHandle->new;
4502 if (open $fh, $lc_file){
4505 $eval =~ s/\015?\012/\n/g;
4507 my($comp) = Safe->new();
4508 $cksum = $comp->reval($eval);
4510 rename $lc_file, "$lc_file.bad";
4511 Carp::confess($@) if $@;
4513 } elsif ($may_ftp) {
4514 Carp::carp "Could not open '$lc_file' for reading.";
4516 # Maybe should warn: "You may want to set show_upload_date to a true value"
4520 for $f (sort keys %$cksum) {
4521 if (exists $cksum->{$f}{isdir}) {
4523 my(@dir) = @$chksumfile;
4525 push @dir, $f, "CHECKSUMS";
4527 [$_->[0], $_->[1], "$f/$_->[2]"]
4528 } $self->dir_listing(\@dir,1,$may_ftp);
4530 push @result, [ 0, "-", $f ];
4534 ($cksum->{$f}{"size"}||0),
4535 $cksum->{$f}{"mtime"}||"---",
4543 package CPAN::Distribution;
4549 my $ro = $self->ro or return;
4553 # CPAN::Distribution::undelay
4556 delete $self->{later};
4559 # add the A/AN/ stuff
4560 # CPAN::Distribution::normalize
4563 $s = $self->id unless defined $s;
4564 if (substr($s,-1,1) eq ".") {
4566 $s = "$CPAN::iCwd/.";
4567 } elsif (File::Spec->file_name_is_absolute($s)) {
4568 } elsif (File::Spec->can("rel2abs")) {
4569 $s = File::Spec->rel2abs($s);
4571 $CPAN::Frontend->mydie("Your File::Spec is too old, please upgrade File::Spec");
4573 CPAN->debug("s[$s]") if $CPAN::DEBUG;
4574 unless ($CPAN::META->exists("CPAN::Distribution", $s)) {
4575 for ($CPAN::META->instance("CPAN::Distribution", $s)) {
4576 $_->{build_dir} = $s;
4577 $_->{archived} = "local_directory";
4578 $_->{unwrapped} = CPAN::Distrostatus->new("YES -- local_directory");
4584 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
4586 return $s if $s =~ m:^N/A|^Contact Author: ;
4587 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
4588 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
4589 CPAN->debug("s[$s]") if $CPAN::DEBUG;
4594 #-> sub CPAN::Distribution::author ;
4598 if (substr($self->id,-1,1) eq ".") {
4599 $authorid = "LOCAL";
4601 ($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
4603 CPAN::Shell->expand("Author",$authorid);
4606 # tries to get the yaml from CPAN instead of the distro itself:
4607 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
4610 my $meta = $self->pretty_id;
4611 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
4612 my(@ls) = CPAN::Shell->globls($meta);
4613 my $norm = $self->normalize($meta);
4617 File::Spec->catfile(
4618 $CPAN::Config->{keep_source_where},
4623 $self->debug("Doing localize") if $CPAN::DEBUG;
4624 unless ($local_file =
4625 CPAN::FTP->localize("authors/id/$norm",
4627 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
4629 my $yaml = CPAN->_yaml_loadfile($local_file)->[0];
4632 #-> sub CPAN::Distribution::cpan_userid
4635 if ($self->{ID} =~ m{[A-Z]/[A-Z\-]{2}/([A-Z\-]+)/}) {
4638 return $self->SUPER::cpan_userid;
4641 #-> sub CPAN::Distribution::pretty_id
4645 return $id unless $id =~ m|^./../|;
4649 # mark as dirty/clean
4650 #-> sub CPAN::Distribution::color_cmd_tmps ;
4651 sub color_cmd_tmps {
4653 my($depth) = shift || 0;
4654 my($color) = shift || 0;
4655 my($ancestors) = shift || [];
4656 # a distribution needs to recurse into its prereq_pms
4658 return if exists $self->{incommandcolor}
4659 && $self->{incommandcolor}==$color;
4661 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
4663 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
4664 my $prereq_pm = $self->prereq_pm;
4665 if (defined $prereq_pm) {
4666 PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
4667 keys %{$prereq_pm->{build_requires}||{}}) {
4668 next PREREQ if $pre eq "perl";
4670 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
4671 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
4672 $CPAN::Frontend->mysleep(2);
4675 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
4679 delete $self->{sponsored_mods};
4680 delete $self->{badtestcnt};
4682 $self->{incommandcolor} = $color;
4685 #-> sub CPAN::Distribution::as_string ;
4688 $self->containsmods;
4690 $self->SUPER::as_string(@_);
4693 #-> sub CPAN::Distribution::containsmods ;
4696 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
4697 my $dist_id = $self->{ID};
4698 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
4699 my $mod_file = $mod->cpan_file or next;
4700 my $mod_id = $mod->{ID} or next;
4701 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
4703 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
4705 keys %{$self->{CONTAINSMODS}};
4708 #-> sub CPAN::Distribution::upload_date ;
4711 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
4712 my(@local_wanted) = split(/\//,$self->id);
4713 my $filename = pop @local_wanted;
4714 push @local_wanted, "CHECKSUMS";
4715 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
4716 return unless $author;
4717 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
4719 my($dirent) = grep { $_->[2] eq $filename } @dl;
4720 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
4721 return unless $dirent->[1];
4722 return $self->{UPLOAD_DATE} = $dirent->[1];
4725 #-> sub CPAN::Distribution::uptodate ;
4729 foreach $c ($self->containsmods) {
4730 my $obj = CPAN::Shell->expandany($c);
4731 unless ($obj->uptodate){
4732 my $id = $self->pretty_id;
4733 $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG;
4740 #-> sub CPAN::Distribution::called_for ;
4743 $self->{CALLED_FOR} = $id if defined $id;
4744 return $self->{CALLED_FOR};
4747 #-> sub CPAN::Distribution::get ;
4750 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
4752 : ($ENV{PERLLIB} || "");
4754 $CPAN::META->set_perl5lib;
4755 local $ENV{MAKEFLAGS}; # protect us from outer make calls
4759 exists $self->{build_dir} and push @e,
4760 "Is already unwrapped into directory $self->{build_dir}";
4762 exists $self->{unwrapped} and (
4763 $self->{unwrapped}->can("failed") ?
4764 $self->{unwrapped}->failed :
4765 $self->{unwrapped} =~ /^NO/
4767 and push @e, "Unwrapping had some problem, won't try again without force";
4769 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
4771 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
4774 # Get the file on local disk
4779 File::Spec->catfile(
4780 $CPAN::Config->{keep_source_where},
4783 split(/\//,$self->id)
4786 $self->debug("Doing localize") if $CPAN::DEBUG;
4787 unless ($local_file =
4788 CPAN::FTP->localize("authors/id/$self->{ID}",
4791 if ($CPAN::Index::DATE_OF_02) {
4792 $note = "Note: Current database in memory was generated ".
4793 "on $CPAN::Index::DATE_OF_02\n";
4795 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
4798 $self->debug("local_wanted[$local_wanted]local_file[$local_file]") if $CPAN::DEBUG;
4799 $self->{localfile} = $local_file;
4800 return if $CPAN::Signal;
4805 if ($CPAN::META->has_inst("Digest::SHA")) {
4806 $self->debug("Digest::SHA is installed, verifying");
4807 $self->verifyCHECKSUM;
4809 $self->debug("Digest::SHA is NOT installed");
4811 return if $CPAN::Signal;
4814 # Create a clean room and go there
4816 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
4817 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
4818 $self->safe_chdir($builddir);
4819 $self->debug("Removing tmp") if $CPAN::DEBUG;
4820 File::Path::rmtree("tmp");
4821 unless (mkdir "tmp", 0755) {
4822 $CPAN::Frontend->unrecoverable_error(<<EOF);
4823 Couldn't mkdir '$builddir/tmp': $!
4825 Cannot continue: Please find the reason why I cannot make the
4828 and fix the problem, then retry.
4833 $self->safe_chdir($sub_wd);
4836 $self->safe_chdir("tmp");
4841 my $ct = CPAN::Tarzip->new($local_file);
4842 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
4843 $self->{was_uncompressed}++ unless $ct->gtest();
4844 $self->untar_me($ct);
4845 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
4846 $self->unzip_me($ct);
4848 $self->{was_uncompressed}++ unless $ct->gtest();
4849 $local_file = $self->handle_singlefile($local_file);
4851 # $self->{archived} = "NO";
4852 # $self->safe_chdir($sub_wd);
4856 # we are still in the tmp directory!
4857 # Let's check if the package has its own directory.
4858 my $dh = DirHandle->new(File::Spec->curdir)
4859 or Carp::croak("Couldn't opendir .: $!");
4860 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
4862 my ($distdir,$packagedir);
4863 if (@readdir == 1 && -d $readdir[0]) {
4864 $distdir = $readdir[0];
4865 $packagedir = File::Spec->catdir($builddir,$distdir);
4866 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
4868 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
4870 File::Path::rmtree($packagedir);
4871 unless (File::Copy::move($distdir,$packagedir)) {
4872 $CPAN::Frontend->unrecoverable_error(<<EOF);
4873 Couldn't move '$distdir' to '$packagedir': $!
4875 Cannot continue: Please find the reason why I cannot move
4876 $builddir/tmp/$distdir
4879 and fix the problem, then retry
4883 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
4890 my $userid = $self->cpan_userid;
4891 CPAN->debug("userid[$userid]");
4892 if (!$userid or $userid eq "N/A") {
4895 my $pragmatic_dir = $userid . '000';
4896 $pragmatic_dir =~ s/\W_//g;
4897 $pragmatic_dir++ while -d "../$pragmatic_dir";
4898 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
4899 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
4900 File::Path::mkpath($packagedir);
4902 for $f (@readdir) { # is already without "." and ".."
4903 my $to = File::Spec->catdir($packagedir,$f);
4904 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
4908 $self->safe_chdir($sub_wd);
4912 $self->{'build_dir'} = $packagedir;
4913 $self->safe_chdir($builddir);
4914 File::Path::rmtree("tmp");
4916 $self->safe_chdir($packagedir);
4917 $self->_signature_business();
4918 $self->safe_chdir($builddir);
4919 return if $CPAN::Signal;
4922 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
4923 my($mpl_exists) = -f $mpl;
4924 unless ($mpl_exists) {
4925 # NFS has been reported to have racing problems after the
4926 # renaming of a directory in some environments.
4928 $CPAN::Frontend->mysleep(1);
4929 my $mpldh = DirHandle->new($packagedir)
4930 or Carp::croak("Couldn't opendir $packagedir: $!");
4931 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
4934 my $prefer_installer = "eumm"; # eumm|mb
4935 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
4936 if ($mpl_exists) { # they *can* choose
4937 $prefer_installer = CPAN::HandleConfig->prefs_lookup($self,
4938 q{prefer_installer});
4940 $prefer_installer = "mb";
4943 return unless $self->patch;
4944 if (lc($prefer_installer) eq "mb") {
4945 $self->{modulebuild} = 1;
4946 } elsif (! $mpl_exists) {
4947 $self->_edge_cases($mpl,$packagedir,$local_file);
4953 #-> CPAN::Distribution::patch
4955 my($self,$patch) = @_;
4956 my $norm = $self->normalize($patch);
4958 File::Spec->catfile(
4959 $CPAN::Config->{keep_source_where},
4964 $self->debug("Doing localize") if $CPAN::DEBUG;
4965 return CPAN::FTP->localize("authors/id/$norm",
4969 #-> CPAN::Distribution::patch
4972 if (my $patches = $self->prefs->{patches}) {
4973 return unless @$patches;
4974 $self->safe_chdir($self->{build_dir});
4975 CPAN->debug("patches[$patches]");
4976 my $patchbin = $CPAN::Config->{patch};
4977 unless ($patchbin && length $patchbin) {
4978 $CPAN::Frontend->mydie("No external patch command configured\n\n".
4979 "Please run 'o conf init /patch/'\n\n");
4981 unless (MM->maybe_command($patchbin)) {
4982 $CPAN::Frontend->mydie("No external patch command available\n\n".
4983 "Please run 'o conf init /patch/'\n\n");
4985 $patchbin = CPAN::HandleConfig->safe_quote($patchbin);
4986 my $args = "-b -g0 -p1 -N --fuzz=3";
4987 my $countedpatches = @$patches == 1 ? "1 patch" : (scalar @$patches . " patches");
4988 $CPAN::Frontend->myprint("Going to apply $countedpatches:\n");
4989 for my $patch (@$patches) {
4990 unless (-f $patch) {
4991 if (my $trydl = $self->try_download($patch)) {
4994 my $fail = "Could not find patch '$patch'";
4995 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
4996 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
4997 delete $self->{build_dir};
5001 $CPAN::Frontend->myprint(" $patch\n");
5002 my $readfh = CPAN::Tarzip->TIEHANDLE($patch);
5003 my $writefh = FileHandle->new;
5004 unless (open $writefh, "|$patchbin $args") {
5005 my $fail = "Could not fork '$patchbin $args'";
5006 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5007 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5008 delete $self->{build_dir};
5011 while (my $x = $readfh->READLINE) {
5014 unless (close $writefh) {
5015 my $fail = "Could not apply patch '$patch'";
5016 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5017 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5018 delete $self->{build_dir};
5027 #-> sub CPAN::Distribution::_edge_cases
5028 # with "configure" or "Makefile" or single file scripts
5030 my($self,$mpl,$packagedir,$local_file) = @_;
5031 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
5035 my($configure) = File::Spec->catfile($packagedir,"Configure");
5036 if (-f $configure) {
5037 # do we have anything to do?
5038 $self->{configure} = $configure;
5039 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
5040 $CPAN::Frontend->mywarn(qq{
5041 Package comes with a Makefile and without a Makefile.PL.
5042 We\'ll try to build it with that Makefile then.
5044 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
5045 $CPAN::Frontend->mysleep(2);
5047 my $cf = $self->called_for || "unknown";
5052 $cf =~ s|[/\\:]||g; # risk of filesystem damage
5053 $cf = "unknown" unless length($cf);
5054 $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
5055 (The test -f "$mpl" returned false.)
5056 Writing one on our own (setting NAME to $cf)\a\n});
5057 $self->{had_no_makefile_pl}++;
5058 $CPAN::Frontend->mysleep(3);
5060 # Writing our own Makefile.PL
5063 if ($self->{archived} eq "maybe_pl") {
5064 my $fh = FileHandle->new;
5065 my $script_file = File::Spec->catfile($packagedir,$local_file);
5066 $fh->open($script_file)
5067 or Carp::croak("Could not open $script_file: $!");
5069 # name parsen und prereq
5070 my($state) = "poddir";
5071 my($name, $prereq) = ("", "");
5073 if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
5076 } elsif ($1 eq 'PREREQUISITES') {
5079 } elsif ($state =~ m{^(name|prereq)$}) {
5084 } elsif ($state eq "name") {
5089 } elsif ($state eq "prereq") {
5092 } elsif (/^=cut\b/) {
5099 s{.*<}{}; # strip X<...>
5103 $prereq = join " ", split /\s+/, $prereq;
5104 my($PREREQ_PM) = join("\n", map {
5105 s{.*<}{}; # strip X<...>
5107 if (/[\s\'\"]/) { # prose?
5109 s/[^\w:]$//; # period?
5110 " "x28 . "'$_' => 0,";
5112 } split /\s*,\s*/, $prereq);
5115 EXE_FILES => ['$name'],
5121 my $to_file = File::Spec->catfile($packagedir, $name);
5122 rename $script_file, $to_file
5123 or die "Can't rename $script_file to $to_file: $!";
5127 my $fh = FileHandle->new;
5129 or Carp::croak("Could not open >$mpl: $!");
5131 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
5132 # because there was no Makefile.PL supplied.
5133 # Autogenerated on: }.scalar localtime().qq{
5135 use ExtUtils::MakeMaker;
5137 NAME => q[$cf],$script
5144 #-> CPAN::Distribution::_signature_business
5145 sub _signature_business {
5147 if ($CPAN::Config->{check_sigs}) {
5148 if ($CPAN::META->has_inst("Module::Signature")) {
5149 if (-f "SIGNATURE") {
5150 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
5151 my $rv = Module::Signature::verify();
5152 if ($rv != Module::Signature::SIGNATURE_OK() and
5153 $rv != Module::Signature::SIGNATURE_MISSING()) {
5154 $CPAN::Frontend->myprint(
5155 qq{\nSignature invalid for }.
5156 qq{distribution file. }.
5157 qq{Please investigate.\n\n}.
5159 $CPAN::META->instance(
5166 sprintf(qq{I'd recommend removing %s. Its signature
5167 is invalid. Maybe you have configured your 'urllist' with
5168 a bad URL. Please check this array with 'o conf urllist', and
5169 retry. For more information, try opening a subshell with
5177 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
5178 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
5179 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
5181 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
5182 $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
5185 $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n});
5188 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
5193 #-> CPAN::Distribution::untar_me ;
5196 $self->{archived} = "tar";
5198 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
5200 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- untar failed");
5204 # CPAN::Distribution::unzip_me ;
5207 $self->{archived} = "zip";
5209 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
5211 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- unzip failed");
5216 sub handle_singlefile {
5217 my($self,$local_file) = @_;
5219 if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ){
5220 $self->{archived} = "pm";
5222 $self->{archived} = "maybe_pl";
5225 my $to = File::Basename::basename($local_file);
5226 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
5227 if (CPAN::Tarzip->new($local_file)->gunzip($to)) {
5228 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
5230 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- uncompressing failed");
5233 File::Copy::cp($local_file,".");
5234 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- copying failed");
5239 #-> sub CPAN::Distribution::new ;
5241 my($class,%att) = @_;
5243 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
5245 my $this = { %att };
5246 return bless $this, $class;
5249 #-> sub CPAN::Distribution::look ;
5253 if ($^O eq 'MacOS') {
5254 $self->Mac::BuildTools::look;
5258 if ( $CPAN::Config->{'shell'} ) {
5259 $CPAN::Frontend->myprint(qq{
5260 Trying to open a subshell in the build directory...
5263 $CPAN::Frontend->myprint(qq{
5264 Your configuration does not define a value for subshells.
5265 Please define it with "o conf shell <your shell>"
5269 my $dist = $self->id;
5271 unless ($dir = $self->dir) {
5274 unless ($dir ||= $self->dir) {
5275 $CPAN::Frontend->mywarn(qq{
5276 Could not determine which directory to use for looking at $dist.
5280 my $pwd = CPAN::anycwd();
5281 $self->safe_chdir($dir);
5282 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
5284 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
5285 $ENV{CPAN_SHELL_LEVEL} += 1;
5286 my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
5287 unless (system($shell) == 0) {
5289 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
5292 $self->safe_chdir($pwd);
5295 # CPAN::Distribution::cvs_import ;
5299 my $dir = $self->dir;
5301 my $package = $self->called_for;
5302 my $module = $CPAN::META->instance('CPAN::Module', $package);
5303 my $version = $module->cpan_version;
5305 my $userid = $self->cpan_userid;
5307 my $cvs_dir = (split /\//, $dir)[-1];
5308 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
5310 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
5312 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
5313 if ($cvs_site_perl) {
5314 $cvs_dir = "$cvs_site_perl/$cvs_dir";
5316 my $cvs_log = qq{"imported $package $version sources"};
5317 $version =~ s/\./_/g;
5318 # XXX cvs: undocumented and unclear how it was meant to work
5319 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
5320 "$cvs_dir", $userid, "v$version");
5322 my $pwd = CPAN::anycwd();
5323 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
5325 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
5327 $CPAN::Frontend->myprint(qq{@cmd\n});
5328 system(@cmd) == 0 or
5330 $CPAN::Frontend->mydie("cvs import failed");
5331 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
5334 #-> sub CPAN::Distribution::readme ;
5337 my($dist) = $self->id;
5338 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
5339 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
5342 File::Spec->catfile(
5343 $CPAN::Config->{keep_source_where},
5346 split(/\//,"$sans.readme"),
5348 $self->debug("Doing localize") if $CPAN::DEBUG;
5349 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
5351 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
5353 if ($^O eq 'MacOS') {
5354 Mac::BuildTools::launch_file($local_file);
5358 my $fh_pager = FileHandle->new;
5359 local($SIG{PIPE}) = "IGNORE";
5360 my $pager = $CPAN::Config->{'pager'} || "cat";
5361 $fh_pager->open("|$pager")
5362 or die "Could not open pager $pager\: $!";
5363 my $fh_readme = FileHandle->new;
5364 $fh_readme->open($local_file)
5365 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
5366 $CPAN::Frontend->myprint(qq{
5371 $fh_pager->print(<$fh_readme>);
5375 #-> sub CPAN::Distribution::verifyCHECKSUM ;
5376 sub verifyCHECKSUM {
5380 $self->{CHECKSUM_STATUS} ||= "";
5381 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
5382 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5384 my($lc_want,$lc_file,@local,$basename);
5385 @local = split(/\//,$self->id);
5387 push @local, "CHECKSUMS";
5389 File::Spec->catfile($CPAN::Config->{keep_source_where},
5390 "authors", "id", @local);
5392 if (my $size = -s $lc_want) {
5393 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
5394 if ($self->CHECKSUM_check_file($lc_want,1)) {
5395 return $self->{CHECKSUM_STATUS} = "OK";
5398 $lc_file = CPAN::FTP->localize("authors/id/@local",
5401 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
5402 $local[-1] .= ".gz";
5403 $lc_file = CPAN::FTP->localize("authors/id/@local",
5406 $lc_file =~ s/\.gz(?!\n)\Z//;
5407 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
5412 if ($self->CHECKSUM_check_file($lc_file)) {
5413 return $self->{CHECKSUM_STATUS} = "OK";
5417 #-> sub CPAN::Distribution::SIG_check_file ;
5418 sub SIG_check_file {
5419 my($self,$chk_file) = @_;
5420 my $rv = eval { Module::Signature::_verify($chk_file) };
5422 if ($rv == Module::Signature::SIGNATURE_OK()) {
5423 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
5424 return $self->{SIG_STATUS} = "OK";
5426 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
5427 qq{distribution file. }.
5428 qq{Please investigate.\n\n}.
5430 $CPAN::META->instance(
5435 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
5436 is invalid. Maybe you have configured your 'urllist' with
5437 a bad URL. Please check this array with 'o conf urllist', and
5440 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
5444 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
5446 # sloppy is 1 when we have an old checksums file that maybe is good
5449 sub CHECKSUM_check_file {
5450 my($self,$chk_file,$sloppy) = @_;
5451 my($cksum,$file,$basename);
5454 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
5455 if ($CPAN::Config->{check_sigs}) {
5456 if ($CPAN::META->has_inst("Module::Signature")) {
5457 $self->debug("Module::Signature is installed, verifying");
5458 $self->SIG_check_file($chk_file);
5460 $self->debug("Module::Signature is NOT installed");
5464 $file = $self->{localfile};
5465 $basename = File::Basename::basename($file);
5466 my $fh = FileHandle->new;
5467 if (open $fh, $chk_file){
5470 $eval =~ s/\015?\012/\n/g;
5472 my($comp) = Safe->new();
5473 $cksum = $comp->reval($eval);
5475 rename $chk_file, "$chk_file.bad";
5476 Carp::confess($@) if $@;
5479 Carp::carp "Could not open $chk_file for reading";
5482 if (! ref $cksum or ref $cksum ne "HASH") {
5483 $CPAN::Frontend->mywarn(qq{
5484 Warning: checksum file '$chk_file' broken.
5486 When trying to read that file I expected to get a hash reference
5487 for further processing, but got garbage instead.
5489 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
5490 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
5491 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
5493 } elsif (exists $cksum->{$basename}{sha256}) {
5494 $self->debug("Found checksum for $basename:" .
5495 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
5499 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
5501 $fh = CPAN::Tarzip->TIEHANDLE($file);
5504 my $dg = Digest::SHA->new(256);
5507 while ($fh->READ($ref, 4096) > 0){
5510 my $hexdigest = $dg->hexdigest;
5511 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
5515 $CPAN::Frontend->myprint("Checksum for $file ok\n");
5516 return $self->{CHECKSUM_STATUS} = "OK";
5518 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
5519 qq{distribution file. }.
5520 qq{Please investigate.\n\n}.
5522 $CPAN::META->instance(
5527 my $wrap = qq{I\'d recommend removing $file. Its
5528 checksum is incorrect. Maybe you have configured your 'urllist' with
5529 a bad URL. Please check this array with 'o conf urllist', and
5532 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
5534 # former versions just returned here but this seems a
5535 # serious threat that deserves a die
5537 # $CPAN::Frontend->myprint("\n\n");
5541 # close $fh if fileno($fh);
5544 unless ($self->{CHECKSUM_STATUS}) {
5545 $CPAN::Frontend->mywarn(qq{
5546 Warning: No checksum for $basename in $chk_file.
5548 The cause for this may be that the file is very new and the checksum
5549 has not yet been calculated, but it may also be that something is
5550 going awry right now.
5552 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes");
5553 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
5555 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
5560 #-> sub CPAN::Distribution::eq_CHECKSUM ;
5562 my($self,$fh,$expect) = @_;
5563 if ($CPAN::META->has_inst("Digest::SHA")) {
5564 my $dg = Digest::SHA->new(256);
5566 while (read($fh, $data, 4096)){
5569 my $hexdigest = $dg->hexdigest;
5570 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
5571 return $hexdigest eq $expect;
5576 #-> sub CPAN::Distribution::force ;
5578 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
5579 # effect by autoinspection, not by inspecting a global variable. One
5580 # of the reason why this was chosen to work that way was the treatment
5581 # of dependencies. They should not automatically inherit the force
5582 # status. But this has the downside that ^C and die() will return to
5583 # the prompt but will not be able to reset the force_update
5584 # attributes. We try to correct for it currently in the read_metadata
5585 # routine, and immediately before we check for a Signal. I hope this
5586 # works out in one of v1.57_53ff
5588 # "Force get forgets previous error conditions"
5590 #-> sub CPAN::Distribution::force ;
5592 my($self, $method) = @_;
5612 delete $self->{$att};
5613 CPAN->debug(sprintf "att[%s]", $att) if $CPAN::DEBUG;
5615 if ($method && $method =~ /make|test|install/) {
5616 $self->{"force_update"}++; # name should probably have been force_install
5621 my($self, $method) = @_;
5622 # warn "XDEBUG: set notest for $self $method";
5623 $self->{"notest"}++; # name should probably have been force_install
5628 # warn "XDEBUG: deleting notest";
5629 delete $self->{'notest'};
5632 #-> sub CPAN::Distribution::unforce ;
5635 delete $self->{'force_update'};
5638 #-> sub CPAN::Distribution::isa_perl ;
5641 my $file = File::Basename::basename($self->id);
5642 if ($file =~ m{ ^ perl
5655 } elsif ($self->cpan_comment
5657 $self->cpan_comment =~ /isa_perl\(.+?\)/){
5663 #-> sub CPAN::Distribution::perl ;
5668 carp __PACKAGE__ . "::perl was called without parameters.";
5670 return CPAN::HandleConfig->safe_quote($CPAN::Perl);
5674 #-> sub CPAN::Distribution::make ;
5677 my $make = $self->{modulebuild} ? "Build" : "make";
5678 # Emergency brake if they said install Pippi and get newest perl
5679 if ($self->isa_perl) {
5681 $self->called_for ne $self->id &&
5682 ! $self->{force_update}
5684 # if we die here, we break bundles
5687 qq{The most recent version "%s" of the module "%s"
5688 is part of the perl-%s distribution. To install that, you need to run
5689 force install %s --or--
5692 $CPAN::META->instance(
5701 $self->{make} = CPAN::Distrostatus->new("NO isa perl");
5702 $CPAN::Frontend->mysleep(1);
5706 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
5708 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
5710 : ($ENV{PERLLIB} || "");
5712 $CPAN::META->set_perl5lib;
5713 local $ENV{MAKEFLAGS}; # protect us from outer make calls
5716 delete $self->{force_update};
5721 if (!$self->{archived} || $self->{archived} eq "NO") {
5722 push @e, "Is neither a tar nor a zip archive.";
5725 if (!$self->{unwrapped}
5727 $self->{unwrapped}->can("failed") ?
5728 $self->{unwrapped}->failed :
5729 $self->{unwrapped} =~ /^NO/
5731 push @e, "Had problems unarchiving. Please build manually";
5734 unless ($self->{force_update}) {
5735 exists $self->{signature_verify} and (
5736 $self->{signature_verify}->can("failed") ?
5737 $self->{signature_verify}->failed :
5738 $self->{signature_verify} =~ /^NO/
5740 and push @e, "Did not pass the signature test.";
5743 if (exists $self->{writemakefile} &&
5745 $self->{writemakefile}->can("failed") ?
5746 $self->{writemakefile}->failed :
5747 $self->{writemakefile} =~ /^NO/
5749 # XXX maybe a retry would be in order?
5750 my $err = $self->{writemakefile}->can("text") ?
5751 $self->{writemakefile}->text :
5752 $self->{writemakefile};
5754 $err ||= "Had some problem writing Makefile";
5755 $err .= ", won't make";
5759 defined $self->{make} and push @e,
5760 "Has already been processed within this session";
5762 if (exists $self->{later} and length($self->{later})) {
5763 if ($self->unsat_prereq) {
5764 push @e, $self->{later};
5765 # RT ticket 18438 raises doubts if the deletion of {later} is valid.
5766 # YAML-0.53 triggered the later hodge-podge here, but my margin notes
5767 # are not sufficient to be sure if we really must/may do the delete
5768 # here. SO I accept the suggested patch for now. If we trigger a bug
5769 # again, I must go into deep contemplation about the {later} flag.
5772 # delete $self->{later};
5776 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5779 delete $self->{force_update};
5782 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
5783 my $builddir = $self->dir or
5784 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
5785 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
5786 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
5788 if ($^O eq 'MacOS') {
5789 Mac::BuildTools::make($self);
5794 if ($self->{'configure'}) {
5795 $system = $self->{'configure'};
5796 } elsif ($self->{modulebuild}) {
5797 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5798 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
5800 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5802 # This needs a handler that can be turned on or off:
5803 # $switch = "-MExtUtils::MakeMaker ".
5804 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
5806 my $makepl_arg = $self->make_x_arg("pl");
5807 $system = sprintf("%s%s Makefile.PL%s",
5809 $switch ? " $switch" : "",
5810 $makepl_arg ? " $makepl_arg" : "",
5814 while (my($k,$v) = each %ENV) {
5815 next unless defined $v;
5819 if (my $env = $self->prefs->{pl}{env}) {
5820 for my $e (keys %$env) {
5821 $ENV{$e} = $env->{$e};
5824 if (exists $self->{writemakefile}) {
5826 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
5830 if ($CPAN::Config->{inactivity_timeout}) {
5832 if ($Config::Config{d_alarm}
5834 $Config::Config{d_alarm} eq "define"
5838 $CPAN::Frontend->mywarn("Warning: you have configured the config ".
5839 "variable 'inactivity_timeout' to ".
5840 "'$CPAN::Config->{inactivity_timeout}'. But ".
5841 "on this machine the system call 'alarm' ".
5842 "isn't available. This means that we cannot ".
5843 "provide the feature of intercepting long ".
5844 "waiting code and will turn this feature off.\n"
5846 $CPAN::Config->{inactivity_timeout} = 0;
5849 if ($go_via_alarm) {
5851 alarm $CPAN::Config->{inactivity_timeout};
5852 local $SIG{CHLD}; # = sub { wait };
5853 if (defined($pid = fork)) {
5858 # note, this exec isn't necessary if
5859 # inactivity_timeout is 0. On the Mac I'd
5860 # suggest, we set it always to 0.
5864 $CPAN::Frontend->myprint("Cannot fork: $!");
5873 $CPAN::Frontend->myprint($err);
5874 $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
5879 if (my $expect = $self->prefs->{pl}{expect}) {
5880 $ret = $self->_run_via_expect($system,$expect);
5882 $ret = system($system);
5885 $self->{writemakefile} = CPAN::Distrostatus
5886 ->new("NO '$system' returned status $ret");
5887 $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
5891 if (-f "Makefile" || -f "Build") {
5892 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
5893 delete $self->{make_clean}; # if cleaned before, enable next
5895 $self->{writemakefile} = CPAN::Distrostatus
5896 ->new(qq{NO -- Unknown reason.});
5900 delete $self->{force_update};
5903 if (my @prereq = $self->unsat_prereq){
5904 if ($prereq[0][0] eq "perl") {
5905 my $need = "requires perl '$prereq[0][1]'";
5906 my $id = $self->pretty_id;
5907 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
5908 $self->{make} = CPAN::Distrostatus->new("NO $need");
5911 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5915 delete $self->{force_update};
5918 if ($self->{modulebuild}) {
5919 unless (-f "Build") {
5921 $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'".
5922 " in cwd[$cwd]. Danger, Will Robinson!");
5923 $CPAN::Frontend->mysleep(5);
5925 $system = sprintf "%s %s", $self->_build_command(), $CPAN::Config->{mbuild_arg};
5927 $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
5929 my $make_arg = $self->make_x_arg("make");
5930 $system = sprintf("%s%s",
5932 $make_arg ? " $make_arg" : "",
5934 if (my $env = $self->prefs->{make}{env}) { # overriding the local
5935 # ENV of PL, not the
5937 # unlikely to be a risk
5938 for my $e (keys %$env) {
5939 $ENV{$e} = $env->{$e};
5942 if (system($system) == 0) {
5943 $CPAN::Frontend->myprint(" $system -- OK\n");
5944 $self->{make} = CPAN::Distrostatus->new("YES");
5946 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
5947 $self->{make} = CPAN::Distrostatus->new("NO");
5948 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
5952 # CPAN::Distribution::_run_via_expect
5953 sub _run_via_expect {
5954 my($self,$system,$expect) = @_;
5955 CPAN->debug("system[$system]expect[$expect]") if $CPAN::DEBUG;
5956 if ($CPAN::META->has_inst("Expect")) {
5957 my $expo = Expect->new;
5958 $expo->spawn($system);
5959 EXPECT: for (my $i = 0; $i < $#$expect; $i+=2) {
5960 my $next = $expect->[$i];
5963 $timeout = $next->{timeout};
5964 $re = $next->{expect};
5969 my $regex = eval "qr{$re}";
5970 my $send = $expect->[$i+1];
5971 $expo->expect($timeout,
5973 my $but = $expo->clear_accum;
5974 $CPAN::Frontend->mywarn("EOF (maybe harmless) system[$system]
5975 expected[$regex]\nbut[$but]\n\n");
5979 my $but = $expo->clear_accum;
5980 $CPAN::Frontend->mydie("TIMEOUT system[$system]
5981 expected[$regex]\nbut[$but]\n\n");
5987 return $expo->exitstatus();
5989 $CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n");
5990 return system($system);
5994 # CPAN::Distribution::_find_prefs
5997 my $distroid = $self->pretty_id;
5998 CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
5999 my $prefs_dir = $CPAN::Config->{prefs_dir};
6000 eval { File::Path::mkpath($prefs_dir); };
6002 $CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
6004 my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
6005 if ($CPAN::META->has_inst($yaml_module)) {
6006 my $dh = DirHandle->new($prefs_dir)
6007 or die Carp::croak("Couldn't open '$prefs_dir': $!");
6008 DIRENT: for (sort $dh->read) {
6009 next if $_ eq "." || $_ eq "..";
6010 next unless /\.yml$/;
6011 my $abs = File::Spec->catfile($prefs_dir, $_);
6013 CPAN->debug(sprintf "abs[%s]", $abs) if $CPAN::DEBUG;
6014 my @yaml = @{CPAN->_yaml_loadfile($abs)};
6016 ELEMENT: for my $y (0..$#yaml) {
6017 my $yaml = $yaml[$y];
6018 my $match = $yaml->{match};
6020 CPAN->debug("no 'match' in abs[$abs], skipping");
6024 for my $sub_attribute (keys %$match) {
6025 my $qr = eval "qr{$yaml->{match}{$sub_attribute}}";
6026 if ($sub_attribute eq "module") {
6028 CPAN->debug(sprintf "abs[%s]yaml[%d]", $abs, scalar @yaml) if $CPAN::DEBUG;
6029 my @modules = $self->containsmods;
6030 CPAN->debug(sprintf "abs[%s]yaml[%d]modules[%s]", $abs, scalar @yaml, join(",",@modules)) if $CPAN::DEBUG;
6031 MODULE: for my $module (@modules) {
6032 $okm ||= $module =~ /$qr/;
6033 last MODULE if $okm;
6036 } elsif ($sub_attribute eq "distribution") {
6037 my $okd = $distroid =~ /$qr/;
6039 } elsif ($sub_attribute eq "perl") {
6040 my $okp = $^X =~ /$qr/;
6043 $CPAN::Frontend->mydie("Nonconforming YAML file '$abs': ".
6044 "unknown sub_attribut '$sub_attribute'. ".
6046 "remove, cannot continue.");
6049 CPAN->debug(sprintf "abs[%s]yaml[%d]ok[%d]", $abs, scalar @yaml, $ok) if $CPAN::DEBUG;
6054 prefs_file_section => $y,
6062 unless ($self->{have_complained_about_missing_yaml}++) {
6063 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot read prefs '$prefs_dir'\n");
6069 # CPAN::Distribution::prefs
6072 if (exists $self->{prefs}) {
6073 return $self->{prefs}; # XXX comment out during debugging
6075 if ($CPAN::Config->{prefs_dir}) {
6076 CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG;
6077 my $prefs = $self->_find_prefs();
6079 for my $x (qw(prefs prefs_file prefs_file_section)) {
6080 $self->{$x} = $prefs->{$x};
6084 File::Basename::basename($self->{prefs_file}),
6085 $self->{prefs_file_section},
6087 my $filler1 = "_" x 22;
6088 my $filler2 = int(66 - length($bs))/2;
6089 $filler2 = 0 if $filler2 < 0;
6090 $filler2 = " " x $filler2;
6091 $CPAN::Frontend->myprint("
6092 $filler1 D i s t r o P r e f s $filler1
6093 $filler2 $bs $filler2
6095 $CPAN::Frontend->mysleep(1);
6096 return $self->{prefs};
6102 # CPAN::Distribution::make_x_arg
6104 my($self, $whixh) = @_;
6106 my $prefs = $self->prefs;
6109 && exists $prefs->{$whixh}
6110 && exists $prefs->{$whixh}{args}
6111 && $prefs->{$whixh}{args}
6113 $make_x_arg = join(" ",
6114 map {CPAN::HandleConfig
6115 ->safe_quote($_)} @{$prefs->{$whixh}{args}},
6118 my $what = sprintf "make%s_arg", $whixh eq "make" ? "" : $whixh;
6119 $make_x_arg ||= $CPAN::Config->{$what};
6123 # CPAN::Distribution::_make_command
6130 CPAN::HandleConfig->prefs_lookup($self,
6132 || $Config::Config{make}
6136 # Old style call, without object. Deprecated
6137 Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
6140 CPAN::HandleConfig->prefs_lookup($self,q{make})
6141 || $CPAN::Config->{make}
6142 || $Config::Config{make}
6147 #-> sub CPAN::Distribution::follow_prereqs ;
6148 sub follow_prereqs {
6150 my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_;
6151 return unless @prereq_tuples;
6152 my @prereq = map { $_->[0] } @prereq_tuples;
6153 my $pretty_id = $self->pretty_id;
6155 b => "build_requires",
6159 my($filler1,$filler2,$filler3,$filler4);
6160 my $unsat = "Unsatisfied dependencies detected during";
6161 my $w = length($unsat) > length($pretty_id) ? length($unsat) : length($pretty_id);
6163 my $r = int(($w - length($unsat))/2);
6164 my $l = $w - length($unsat) - $r;
6165 $filler1 = "-"x4 . " "x$l;
6166 $filler2 = " "x$r . "-"x4 . "\n";
6169 my $r = int(($w - length($pretty_id))/2);
6170 my $l = $w - length($pretty_id) - $r;
6171 $filler3 = "-"x4 . " "x$l;
6172 $filler4 = " "x$r . "-"x4 . "\n";
6175 myprint("$filler1 $unsat $filler2".
6176 "$filler3 $pretty_id $filler4".
6177 join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @prereq_tuples),
6180 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
6182 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
6183 my $answer = CPAN::Shell::colorable_makemaker_prompt(
6184 "Shall I follow them and prepend them to the queue
6185 of modules we are processing right now?", "yes");
6186 $follow = $answer =~ /^\s*y/i;
6190 myprint(" Ignoring dependencies on modules @prereq\n");
6194 # color them as dirty
6195 for my $p (@prereq) {
6196 # warn "calling color_cmd_tmps(0,1)";
6197 CPAN::Shell->expandany($p)->color_cmd_tmps(0,1);
6199 # queue them and re-queue yourself
6200 CPAN::Queue->jumpqueue([$id,$self->{reqtype}],
6201 reverse @prereq_tuples);
6202 $self->{later} = "Delayed until after prerequisites";
6203 return 1; # signal success to the queuerunner
6207 #-> sub CPAN::Distribution::unsat_prereq ;
6208 # return ([Foo=>1],[Bar=>1.2]) for normal modules
6209 # return ([perl=>5.008]) if we need a newer perl than we are running under
6212 my $prereq_pm = $self->prereq_pm or return;
6214 my %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
6215 NEED: while (my($need_module, $need_version) = each %merged) {
6216 my($have_version,$inst_file);
6217 if ($need_module eq "perl") {
6221 my $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
6222 next if $nmo->uptodate;
6223 $inst_file = $nmo->inst_file;
6225 # if they have not specified a version, we accept any installed one
6226 if (not defined $need_version or
6227 $need_version eq "0" or
6228 $need_version eq "undef") {
6229 next if defined $inst_file;
6232 $have_version = $nmo->inst_version;
6235 # We only want to install prereqs if either they're not installed
6236 # or if the installed version is too old. We cannot omit this
6237 # check, because if 'force' is in effect, nobody else will check.
6238 if (defined $inst_file) {
6239 my(@all_requirements) = split /\s*,\s*/, $need_version;
6242 RQ: for my $rq (@all_requirements) {
6243 if ($rq =~ s|>=\s*||) {
6244 } elsif ($rq =~ s|>\s*||) {
6246 if (CPAN::Version->vgt($have_version,$rq)){
6250 } elsif ($rq =~ s|!=\s*||) {
6252 if (CPAN::Version->vcmp($have_version,$rq)){
6258 } elsif ($rq =~ m|<=?\s*|) {
6260 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])");
6264 if (! CPAN::Version->vgt($rq, $have_version)){
6267 CPAN->debug(sprintf("need_module[%s]inst_file[%s]".
6268 "inst_version[%s]rq[%s]ok[%d]",
6272 CPAN::Version->readable($rq),
6276 next NEED if $ok == @all_requirements;
6279 if ($need_module eq "perl") {
6280 return ["perl", $need_version];
6282 if ($self->{sponsored_mods}{$need_module}++){
6283 # We have already sponsored it and for some reason it's still
6284 # not available. So we do nothing. Or what should we do?
6285 # if we push it again, we have a potential infinite loop
6288 my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
6289 push @need, [$need_module,$needed_as];
6294 #-> sub CPAN::Distribution::read_yaml ;
6297 return $self->{yaml_content} if exists $self->{yaml_content};
6298 my $build_dir = $self->{build_dir};
6299 my $yaml = File::Spec->catfile($build_dir,"META.yml");
6300 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
6301 return unless -f $yaml;
6302 eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml)->[0]; };
6304 return; # if we die, then we cannot read YAML's own META.yml
6306 if (not exists $self->{yaml_content}{dynamic_config}
6307 or $self->{yaml_content}{dynamic_config}
6309 $self->{yaml_content} = undef;
6311 $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
6313 return $self->{yaml_content};
6316 #-> sub CPAN::Distribution::prereq_pm ;
6319 return $self->{prereq_pm} if
6320 exists $self->{prereq_pm_detected} && $self->{prereq_pm_detected};
6321 return unless $self->{writemakefile} # no need to have succeeded
6322 # but we must have run it
6323 || $self->{modulebuild};
6325 if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
6326 $req = $yaml->{requires} || {};
6327 $breq = $yaml->{build_requires} || {};
6328 undef $req unless ref $req eq "HASH" && %$req;
6330 if ($yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
6331 my $eummv = do { local $^W = 0; $1+0; };
6332 if ($eummv < 6.2501) {
6333 # thanks to Slaven for digging that out: MM before
6334 # that could be wrong because it could reflect a
6341 while (my($k,$v) = each %{$req||{}}) {
6344 } elsif ($k =~ /[A-Za-z]/ &&
6346 $CPAN::META->exists("Module",$v)
6348 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
6349 "requires hash: $k => $v; I'll take both ".
6350 "key and value as a module name\n");
6351 $CPAN::Frontend->mysleep(1);
6357 $req = $areq if $do_replace;
6360 unless ($req || $breq) {
6361 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
6362 my $makefile = File::Spec->catfile($build_dir,"Makefile");
6366 $fh = FileHandle->new("<$makefile\0")) {
6369 last if /MakeMaker post_initialize section/;
6371 \s+PREREQ_PM\s+=>\s+(.+)
6374 # warn "Found prereq expr[$p]";
6376 # Regexp modified by A.Speer to remember actual version of file
6377 # PREREQ_PM hash key wants, then add to
6378 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){
6379 # In case a prereq is mentioned twice, complain.
6380 if ( defined $req->{$1} ) {
6381 warn "Warning: PREREQ_PM mentions $1 more than once, ".
6382 "last mention wins";
6388 } elsif (-f "Build") {
6389 if ($CPAN::META->has_inst("Module::Build")) {
6391 $req = Module::Build->current->requires();
6392 $breq = Module::Build->current->build_requires();
6394 # this failed for example for HTML::Mason and for
6395 # Error.pm because they are subclassing Module::Build
6396 # in their Build.PL in such a way that Module::Build
6397 # cannot read the _build directory. We DO need a dump
6402 sprintf("Warning: while trying to determine ".
6403 "prerequisites for %s with the help of ".
6404 "Module::Build the following error ".
6405 "occurred: '%s'\n\nFalling back to META.yml ".
6406 "for prerequisites\n",
6410 my $build_dir = $self->{build_dir};
6411 my $yaml = File::Spec->catfile($build_dir,"META.yml");
6412 if ($yaml = CPAN->_yaml_loadfile($yaml)->[0]) {
6413 $req = $yaml->{requires} || {};
6414 $breq = $yaml->{build_requires} || {};
6421 && ! -f "Makefile.PL"
6422 && ! exists $req->{"Module::Build"}
6423 && ! $CPAN::META->has_inst("Module::Build")) {
6424 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
6425 "undeclared prerequisite.\n".
6426 " Adding it now as such.\n"
6428 $CPAN::Frontend->mysleep(5);
6429 $req->{"Module::Build"} = 0;
6430 delete $self->{writemakefile};
6432 $self->{prereq_pm_detected}++;
6433 return $self->{prereq_pm} = { requires => $req, build_requires => $breq };
6436 #-> sub CPAN::Distribution::test ;
6441 delete $self->{force_update};
6444 # warn "XDEBUG: checking for notest: $self->{notest} $self";
6445 if ($self->{notest}) {
6446 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
6450 my $make = $self->{modulebuild} ? "Build" : "make";
6452 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
6454 : ($ENV{PERLLIB} || "");
6456 $CPAN::META->set_perl5lib;
6457 local $ENV{MAKEFLAGS}; # protect us from outer make calls
6459 $CPAN::Frontend->myprint("Running $make test\n");
6460 if (my @prereq = $self->unsat_prereq){
6461 unless ($prereq[0][0] eq "perl") {
6462 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
6467 unless (exists $self->{make} or exists $self->{later}) {
6469 "Make had some problems, won't test";
6472 exists $self->{make} and
6474 $self->{make}->can("failed") ?
6475 $self->{make}->failed :
6476 $self->{make} =~ /^NO/
6477 ) and push @e, "Can't test without successful make";
6479 $self->{badtestcnt} ||= 0;
6480 $self->{badtestcnt} > 0 and
6481 push @e, "Won't repeat unsuccessful test during this command";
6483 exists $self->{later} and length($self->{later}) and
6484 push @e, $self->{later};
6486 if (exists $self->{build_dir}) {
6487 if ($CPAN::META->{is_tested}{$self->{build_dir}}
6489 exists $self->{make_test}
6492 $self->{make_test}->can("failed") ?
6493 $self->{make_test}->failed :
6494 $self->{make_test} =~ /^NO/
6497 push @e, "Already tested successfully";
6500 push @e, "Has no own directory";
6503 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6505 chdir $self->{'build_dir'} or
6506 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
6507 $self->debug("Changed directory to $self->{'build_dir'}")
6510 if ($^O eq 'MacOS') {
6511 Mac::BuildTools::make_test($self);
6515 if ($self->{modulebuild}) {
6516 my $v = CPAN::Shell->expand("Module","Test::Harness")->inst_version;
6517 if (CPAN::Version->vlt($v,2.62)) {
6518 $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only
6519 '$v', you need at least '2.62'. Please upgrade your Test::Harness.\n});
6520 $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old");
6525 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
6527 : ($ENV{PERLLIB} || "");
6529 $CPAN::META->set_perl5lib;
6530 local $ENV{MAKEFLAGS}; # protect us from outer make calls
6533 if ($self->{modulebuild}) {
6534 $system = sprintf "%s test", $self->_build_command();
6536 $system = join " ", $self->_make_command(), "test";
6540 while (my($k,$v) = each %ENV) {
6541 next unless defined $v;
6545 if (my $env = $self->prefs->{test}{env}) {
6546 for my $e (keys %$env) {
6547 $ENV{$e} = $env->{$e};
6550 my $expect = $self->prefs->{test}{expect};
6551 my $can_expect = $CPAN::META->has_inst("Expect");
6552 my $want_expect = 0;
6553 if ( $expect && @$expect ) {
6557 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
6558 "testing without\n");
6561 my $test_report = CPAN::HandleConfig->prefs_lookup($self,
6563 my $can_report = $CPAN::META->has_inst("CPAN::Reporter");
6564 my $want_report = $test_report && $can_report;
6565 my $ready_to_report = $want_report;
6566 if ($ready_to_report
6568 substr($self->id,-1,1) eq "."
6570 $self->author->id eq "LOCAL"
6573 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
6574 "for for local directories\n");
6575 $ready_to_report = 0;
6577 if ($ready_to_report
6579 $self->prefs->{patches}
6581 @{$self->prefs->{patches}}
6585 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
6586 "when the source has been patched\n");
6587 $ready_to_report = 0;
6590 if ($ready_to_report) {
6591 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is currently ".
6592 "not supported when distroprefs specify ".
6593 "an interactive test\n");
6595 $tests_ok = $self->_run_via_expect($system,$expect) == 0;
6596 } elsif ( $ready_to_report ) {
6597 $tests_ok = CPAN::Reporter::test($self, $system);
6599 $tests_ok = system($system) == 0;
6604 for my $m (keys %{$self->{sponsored_mods}}) {
6605 my $m_obj = CPAN::Shell->expand("Module",$m);
6606 my $d_obj = $m_obj->distribution;
6608 if (!$d_obj->{make_test}
6610 $d_obj->{make_test}->failed){
6618 my $which = join ",", @prereq;
6619 my $verb = $cnt == 1 ? "one dependency not OK ($which)" :
6620 "$cnt dependencies missing ($which)";
6621 $CPAN::Frontend->mywarn("Tests succeeded but $verb\n");
6622 $self->{make_test} = CPAN::Distrostatus->new("NO $verb");
6627 $CPAN::Frontend->myprint(" $system -- OK\n");
6628 $CPAN::META->is_tested($self->{'build_dir'});
6629 $self->{make_test} = CPAN::Distrostatus->new("YES");
6631 $self->{make_test} = CPAN::Distrostatus->new("NO");
6632 $self->{badtestcnt}++;
6633 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
6637 #-> sub CPAN::Distribution::clean ;
6640 my $make = $self->{modulebuild} ? "Build" : "make";
6641 $CPAN::Frontend->myprint("Running $make clean\n");
6642 unless (exists $self->{archived}) {
6643 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
6644 "/untarred, nothing done\n");
6647 unless (exists $self->{build_dir}) {
6648 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
6653 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
6654 push @e, "make clean already called once";
6655 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6657 chdir $self->{'build_dir'} or
6658 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
6659 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
6661 if ($^O eq 'MacOS') {
6662 Mac::BuildTools::make_clean($self);
6667 if ($self->{modulebuild}) {
6668 unless (-f "Build") {
6670 $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}".
6671 " in cwd[$cwd]. Danger, Will Robinson!");
6672 $CPAN::Frontend->mysleep(5);
6674 $system = sprintf "%s clean", $self->_build_command();
6676 $system = join " ", $self->_make_command(), "clean";
6678 if (system($system) == 0) {
6679 $CPAN::Frontend->myprint(" $system -- OK\n");
6683 # Jost Krieger pointed out that this "force" was wrong because
6684 # it has the effect that the next "install" on this distribution
6685 # will untar everything again. Instead we should bring the
6686 # object's state back to where it is after untarring.
6697 $self->{make_clean} = CPAN::Distrostatus->new("YES");
6700 # Hmmm, what to do if make clean failed?
6702 $self->{make_clean} = CPAN::Distrostatus->new("NO");
6703 $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n});
6705 # 2006-02-27: seems silly to me to force a make now
6706 # $self->force("make"); # so that this directory won't be used again
6711 #-> sub CPAN::Distribution::install ;
6716 delete $self->{force_update};
6719 my $make = $self->{modulebuild} ? "Build" : "make";
6720 $CPAN::Frontend->myprint("Running $make install\n");
6723 unless (exists $self->{make} or exists $self->{later}) {
6725 "Make had some problems, won't install";
6728 exists $self->{make} and
6730 $self->{make}->can("failed") ?
6731 $self->{make}->failed :
6732 $self->{make} =~ /^NO/
6734 push @e, "Make had returned bad status, install seems impossible";
6736 if (exists $self->{build_dir}) {
6738 push @e, "Has no own directory";
6741 if (exists $self->{make_test} and
6743 $self->{make_test}->can("failed") ?
6744 $self->{make_test}->failed :
6745 $self->{make_test} =~ /^NO/
6747 if ($self->{force_update}) {
6748 $self->{make_test}->text("FAILED but failure ignored because ".
6749 "'force' in effect");
6751 push @e, "make test had returned bad status, ".
6752 "won't install without force"
6755 if (exists $self->{'install'}) {
6756 if ($self->{'install'}->can("text") ?
6757 $self->{'install'}->text eq "YES" :
6758 $self->{'install'} =~ /^YES/
6760 push @e, "Already done";
6762 # comment in Todo on 2006-02-11; maybe retry?
6763 push @e, "Already tried without success";
6767 exists $self->{later} and length($self->{later}) and
6768 push @e, $self->{later};
6770 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6772 chdir $self->{'build_dir'} or
6773 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
6774 $self->debug("Changed directory to $self->{'build_dir'}")
6777 if ($^O eq 'MacOS') {
6778 Mac::BuildTools::make_install($self);
6783 if ($self->{modulebuild}) {
6784 my($mbuild_install_build_command) =
6785 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
6786 $CPAN::Config->{mbuild_install_build_command} ?
6787 $CPAN::Config->{mbuild_install_build_command} :
6788 $self->_build_command();
6789 $system = sprintf("%s install %s",
6790 $mbuild_install_build_command,
6791 $CPAN::Config->{mbuild_install_arg},
6794 my($make_install_make_command) =
6795 CPAN::HandleConfig->prefs_lookup($self,
6796 q{make_install_make_command})
6797 || $self->_make_command();
6798 $system = sprintf("%s install %s",
6799 $make_install_make_command,
6800 $CPAN::Config->{make_install_arg},
6804 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
6805 my $brip = CPAN::HandleConfig->prefs_lookup($self,
6806 q{build_requires_install_policy});
6809 my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command
6810 my $want_install = "yes";
6811 if ($reqtype eq "b") {
6812 if ($brip eq "no") {
6813 $want_install = "no";
6814 } elsif ($brip =~ m|^ask/(.+)|) {
6816 $default = "yes" unless $default =~ /^(y|n)/i;
6818 CPAN::Shell::colorable_makemaker_prompt
6819 ("$id is just needed temporarily during building or testing. ".
6820 "Do you want to install it permanently? (Y/n)",
6824 unless ($want_install =~ /^y/i) {
6825 my $is_only = "is only 'build_requires'";
6826 $CPAN::Frontend->mywarn("Not installing because $is_only\n");
6827 $self->{install} = CPAN::Distrostatus->new("NO -- $is_only");
6828 delete $self->{force_update};
6831 my($pipe) = FileHandle->new("$system $stderr |");
6834 print $_; # intentionally NOT use Frontend->myprint because it
6835 # looks irritating when we markup in color what we
6836 # just pass through from an external program
6841 $CPAN::Frontend->myprint(" $system -- OK\n");
6842 $CPAN::META->is_installed($self->{build_dir});
6843 return $self->{install} = CPAN::Distrostatus->new("YES");
6845 $self->{install} = CPAN::Distrostatus->new("NO");
6846 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
6848 CPAN::HandleConfig->prefs_lookup($self,
6849 q{make_install_make_command});
6851 $makeout =~ /permission/s
6855 || $mimc eq (CPAN::HandleConfig->prefs_lookup($self,
6859 $CPAN::Frontend->myprint(
6861 qq{ You may have to su }.
6862 qq{to root to install the package\n}.
6863 qq{ (Or you may want to run something like\n}.
6864 qq{ o conf make_install_make_command 'sudo make'\n}.
6865 qq{ to raise your permissions.}
6869 delete $self->{force_update};
6872 #-> sub CPAN::Distribution::dir ;
6874 shift->{'build_dir'};
6877 #-> sub CPAN::Distribution::perldoc ;
6881 my($dist) = $self->id;
6882 my $package = $self->called_for;
6884 $self->_display_url( $CPAN::Defaultdocs . $package );
6887 #-> sub CPAN::Distribution::_check_binary ;
6889 my ($dist,$shell,$binary) = @_;
6892 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
6896 $pid = open README, "which $binary|"
6897 or $CPAN::Frontend->mydie(qq{Could not fork 'which $binary': $!});
6901 close README or die "Could not run 'which $binary': $!";
6903 $CPAN::Frontend->myprint(qq{ + $out \n})
6904 if $CPAN::DEBUG && $out;
6909 #-> sub CPAN::Distribution::_display_url ;
6911 my($self,$url) = @_;
6912 my($res,$saved_file,$pid,$out);
6914 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
6917 # should we define it in the config instead?
6918 my $html_converter = "html2text";
6920 my $web_browser = $CPAN::Config->{'lynx'} || undef;
6921 my $web_browser_out = $web_browser
6922 ? CPAN::Distribution->_check_binary($self,$web_browser)
6925 if ($web_browser_out) {
6926 # web browser found, run the action
6927 my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
6928 $CPAN::Frontend->myprint(qq{system[$browser $url]})
6930 $CPAN::Frontend->myprint(qq{
6933 with browser $browser
6935 $CPAN::Frontend->mysleep(1);
6936 system("$browser $url");
6937 if ($saved_file) { 1 while unlink($saved_file) }
6939 # web browser not found, let's try text only
6940 my $html_converter_out =
6941 CPAN::Distribution->_check_binary($self,$html_converter);
6942 $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
6944 if ($html_converter_out ) {
6945 # html2text found, run it
6946 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
6947 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
6948 unless defined($saved_file);
6951 $pid = open README, "$html_converter $saved_file |"
6952 or $CPAN::Frontend->mydie(qq{
6953 Could not fork '$html_converter $saved_file': $!});
6955 if ($CPAN::META->has_inst("File::Temp")) {
6956 $fh = File::Temp->new(
6957 template => 'cpan_htmlconvert_XXXX',
6961 $filename = $fh->filename;
6963 $filename = "cpan_htmlconvert_$$.txt";
6964 $fh = FileHandle->new();
6965 open $fh, ">$filename" or die;
6971 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
6972 my $tmpin = $fh->filename;
6973 $CPAN::Frontend->myprint(sprintf(qq{
6975 saved output to %s\n},
6983 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
6984 my $fh_pager = FileHandle->new;
6985 local($SIG{PIPE}) = "IGNORE";
6986 my $pager = $CPAN::Config->{'pager'} || "cat";
6987 $fh_pager->open("|$pager")
6988 or $CPAN::Frontend->mydie(qq{
6989 Could not open pager '$pager': $!});
6990 $CPAN::Frontend->myprint(qq{
6995 $CPAN::Frontend->mysleep(1);
6996 $fh_pager->print(<FH>);
6999 # coldn't find the web browser or html converter
7000 $CPAN::Frontend->myprint(qq{
7001 You need to install lynx or $html_converter to use this feature.});
7006 #-> sub CPAN::Distribution::_getsave_url ;
7008 my($dist, $shell, $url) = @_;
7010 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
7014 if ($CPAN::META->has_inst("File::Temp")) {
7015 $fh = File::Temp->new(
7016 template => "cpan_getsave_url_XXXX",
7020 $filename = $fh->filename;
7022 $fh = FileHandle->new;
7023 $filename = "cpan_getsave_url_$$.html";
7025 my $tmpin = $filename;
7026 if ($CPAN::META->has_usable('LWP')) {
7027 $CPAN::Frontend->myprint("Fetching with LWP:
7031 CPAN::LWP::UserAgent->config;
7032 eval { $Ua = CPAN::LWP::UserAgent->new; };
7034 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
7038 $Ua->proxy('http', $var)
7039 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
7041 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
7044 my $req = HTTP::Request->new(GET => $url);
7045 $req->header('Accept' => 'text/html');
7046 my $res = $Ua->request($req);
7047 if ($res->is_success) {
7048 $CPAN::Frontend->myprint(" + request successful.\n")
7050 print $fh $res->content;
7052 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
7056 $CPAN::Frontend->myprint(sprintf(
7057 "LWP failed with code[%s], message[%s]\n",
7064 $CPAN::Frontend->mywarn(" LWP not available\n");
7069 # sub CPAN::Distribution::_build_command
7070 sub _build_command {
7072 if ($^O eq "MSWin32") { # special code needed at least up to
7073 # Module::Build 0.2611 and 0.2706; a fix
7074 # in M:B has been promised 2006-01-30
7075 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
7076 return "$perl ./Build";
7081 package CPAN::Bundle;
7086 $CPAN::Frontend->myprint($self->as_string);
7091 delete $self->{later};
7092 for my $c ( $self->contains ) {
7093 my $obj = CPAN::Shell->expandany($c) or next;
7098 # mark as dirty/clean
7099 #-> sub CPAN::Bundle::color_cmd_tmps ;
7100 sub color_cmd_tmps {
7102 my($depth) = shift || 0;
7103 my($color) = shift || 0;
7104 my($ancestors) = shift || [];
7105 # a module needs to recurse to its cpan_file, a distribution needs
7106 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
7108 return if exists $self->{incommandcolor}
7109 && $self->{incommandcolor}==$color;
7111 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
7113 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
7115 for my $c ( $self->contains ) {
7116 my $obj = CPAN::Shell->expandany($c) or next;
7117 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
7118 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
7121 delete $self->{badtestcnt};
7123 $self->{incommandcolor} = $color;
7126 #-> sub CPAN::Bundle::as_string ;
7130 # following line must be "=", not "||=" because we have a moving target
7131 $self->{INST_VERSION} = $self->inst_version;
7132 return $self->SUPER::as_string;
7135 #-> sub CPAN::Bundle::contains ;
7138 my($inst_file) = $self->inst_file || "";
7139 my($id) = $self->id;
7140 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
7141 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
7144 unless ($inst_file) {
7145 # Try to get at it in the cpan directory
7146 $self->debug("no inst_file") if $CPAN::DEBUG;
7148 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
7149 $cpan_file = $self->cpan_file;
7150 if ($cpan_file eq "N/A") {
7151 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
7152 Maybe stale symlink? Maybe removed during session? Giving up.\n");
7154 my $dist = $CPAN::META->instance('CPAN::Distribution',
7157 $self->debug("id[$dist->{ID}]") if $CPAN::DEBUG;
7158 my($todir) = $CPAN::Config->{'cpan_home'};
7159 my(@me,$from,$to,$me);
7160 @me = split /::/, $self->id;
7162 $me = File::Spec->catfile(@me);
7163 $from = $self->find_bundle_file($dist->{'build_dir'},join('/',@me));
7164 $to = File::Spec->catfile($todir,$me);
7165 File::Path::mkpath(File::Basename::dirname($to));
7166 File::Copy::copy($from, $to)
7167 or Carp::confess("Couldn't copy $from to $to: $!");
7171 my $fh = FileHandle->new;
7173 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
7175 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
7177 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
7178 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
7179 next unless $in_cont;
7184 push @result, (split " ", $_, 2)[0];
7187 delete $self->{STATUS};
7188 $self->{CONTAINS} = \@result;
7189 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
7191 $CPAN::Frontend->mywarn(qq{
7192 The bundle file "$inst_file" may be a broken
7193 bundlefile. It seems not to contain any bundle definition.
7194 Please check the file and if it is bogus, please delete it.
7195 Sorry for the inconvenience.
7201 #-> sub CPAN::Bundle::find_bundle_file
7202 # $where is in local format, $what is in unix format
7203 sub find_bundle_file {
7204 my($self,$where,$what) = @_;
7205 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
7206 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
7207 ### my $bu = File::Spec->catfile($where,$what);
7208 ### return $bu if -f $bu;
7209 my $manifest = File::Spec->catfile($where,"MANIFEST");
7210 unless (-f $manifest) {
7211 require ExtUtils::Manifest;
7212 my $cwd = CPAN::anycwd();
7213 $self->safe_chdir($where);
7214 ExtUtils::Manifest::mkmanifest();
7215 $self->safe_chdir($cwd);
7217 my $fh = FileHandle->new($manifest)
7218 or Carp::croak("Couldn't open $manifest: $!");
7220 my $bundle_filename = $what;
7221 $bundle_filename =~ s|Bundle.*/||;
7222 my $bundle_unixpath;
7225 my($file) = /(\S+)/;
7226 if ($file =~ m|\Q$what\E$|) {
7227 $bundle_unixpath = $file;
7228 # return File::Spec->catfile($where,$bundle_unixpath); # bad
7231 # retry if she managed to have no Bundle directory
7232 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
7234 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
7235 if $bundle_unixpath;
7236 Carp::croak("Couldn't find a Bundle file in $where");
7239 # needs to work quite differently from Module::inst_file because of
7240 # cpan_home/Bundle/ directory and the possibility that we have
7241 # shadowing effect. As it makes no sense to take the first in @INC for
7242 # Bundles, we parse them all for $VERSION and take the newest.
7244 #-> sub CPAN::Bundle::inst_file ;
7249 @me = split /::/, $self->id;
7252 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
7253 my $bfile = File::Spec->catfile($incdir, @me);
7254 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
7255 next unless -f $bfile;
7256 my $foundv = MM->parse_version($bfile);
7257 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
7258 $self->{INST_FILE} = $bfile;
7259 $self->{INST_VERSION} = $bestv = $foundv;
7265 #-> sub CPAN::Bundle::inst_version ;
7268 $self->inst_file; # finds INST_VERSION as side effect
7269 $self->{INST_VERSION};
7272 #-> sub CPAN::Bundle::rematein ;
7274 my($self,$meth) = @_;
7275 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
7276 my($id) = $self->id;
7277 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
7278 unless $self->inst_file || $self->cpan_file;
7280 for $s ($self->contains) {
7281 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
7282 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
7283 if ($type eq 'CPAN::Distribution') {
7284 $CPAN::Frontend->mywarn(qq{
7285 The Bundle }.$self->id.qq{ contains
7286 explicitly a file '$s'.
7287 Going to $meth that.
7289 $CPAN::Frontend->mysleep(5);
7291 # possibly noisy action:
7292 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
7293 my $obj = $CPAN::META->instance($type,$s);
7294 $obj->{reqtype} = $self->{reqtype};
7296 if ($obj->isa('CPAN::Bundle')
7298 exists $obj->{install_failed}
7300 ref($obj->{install_failed}) eq "HASH"
7302 for (keys %{$obj->{install_failed}}) {
7303 $self->{install_failed}{$_} = undef; # propagate faiure up
7306 $fail{$s} = 1; # the bundle itself may have succeeded but
7311 $success = $obj->can("uptodate") ? $obj->uptodate : 0;
7312 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
7314 delete $self->{install_failed}{$s};
7321 # recap with less noise
7322 if ( $meth eq "install" ) {
7325 my $raw = sprintf(qq{Bundle summary:
7326 The following items in bundle %s had installation problems:},
7329 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
7330 $CPAN::Frontend->myprint("\n");
7333 for $s ($self->contains) {
7335 $paragraph .= "$s ";
7336 $self->{install_failed}{$s} = undef;
7337 $reported{$s} = undef;
7340 my $report_propagated;
7341 for $s (sort keys %{$self->{install_failed}}) {
7342 next if exists $reported{$s};
7343 $paragraph .= "and the following items had problems
7344 during recursive bundle calls: " unless $report_propagated++;
7345 $paragraph .= "$s ";
7347 $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
7348 $CPAN::Frontend->myprint("\n");
7350 $self->{'install'} = 'YES';
7355 # If a bundle contains another that contains an xs_file we have here,
7356 # we just don't bother I suppose
7357 #-> sub CPAN::Bundle::xs_file
7362 #-> sub CPAN::Bundle::force ;
7363 sub force { shift->rematein('force',@_); }
7364 #-> sub CPAN::Bundle::notest ;
7365 sub notest { shift->rematein('notest',@_); }
7366 #-> sub CPAN::Bundle::get ;
7367 sub get { shift->rematein('get',@_); }
7368 #-> sub CPAN::Bundle::make ;
7369 sub make { shift->rematein('make',@_); }
7370 #-> sub CPAN::Bundle::test ;
7373 $self->{badtestcnt} ||= 0;
7374 $self->rematein('test',@_);
7376 #-> sub CPAN::Bundle::install ;
7379 $self->rematein('install',@_);
7381 #-> sub CPAN::Bundle::clean ;
7382 sub clean { shift->rematein('clean',@_); }
7384 #-> sub CPAN::Bundle::uptodate ;
7387 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
7389 foreach $c ($self->contains) {
7390 my $obj = CPAN::Shell->expandany($c);
7391 return 0 unless $obj->uptodate;
7396 #-> sub CPAN::Bundle::readme ;
7399 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
7400 No File found for bundle } . $self->id . qq{\n}), return;
7401 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
7402 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
7405 package CPAN::Module;
7409 # sub CPAN::Module::userid
7414 return $ro->{userid} || $ro->{CPAN_USERID};
7416 # sub CPAN::Module::description
7419 my $ro = $self->ro or return "";
7425 CPAN::Shell->expand("Distribution",$self->cpan_file);
7428 # sub CPAN::Module::undelay
7431 delete $self->{later};
7432 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
7437 # mark as dirty/clean
7438 #-> sub CPAN::Module::color_cmd_tmps ;
7439 sub color_cmd_tmps {
7441 my($depth) = shift || 0;
7442 my($color) = shift || 0;
7443 my($ancestors) = shift || [];
7444 # a module needs to recurse to its cpan_file
7446 return if exists $self->{incommandcolor}
7447 && $self->{incommandcolor}==$color;
7448 return if $depth>=1 && $self->uptodate;
7450 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
7452 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
7454 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
7455 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
7458 delete $self->{badtestcnt};
7460 $self->{incommandcolor} = $color;
7463 #-> sub CPAN::Module::as_glimpse ;
7467 my $class = ref($self);
7468 $class =~ s/^CPAN:://;
7472 $CPAN::Shell::COLOR_REGISTERED
7474 $CPAN::META->has_inst("Term::ANSIColor")
7478 $color_on = Term::ANSIColor::color("green");
7479 $color_off = Term::ANSIColor::color("reset");
7481 my $uptodateness = " ";
7482 if ($class eq "Bundle") {
7483 } elsif ($self->uptodate) {
7484 $uptodateness = "=";
7485 } elsif ($self->inst_version) {
7486 $uptodateness = "<";
7488 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
7494 ($self->distribution ?
7495 $self->distribution->pretty_id :
7502 #-> sub CPAN::Module::dslip_status
7506 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
7507 pre-alpha alpha beta released
7509 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
7510 developer comp.lang.perl.*
7512 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
7513 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
7515 object-oriented pragma
7517 @{$stat->{P}}{qw,p g l b a o d r n,} = qw,Standard-Perl
7521 distribution_allowed
7522 restricted_distribution
7524 for my $x (qw(d s l i p)) {
7525 $stat->{$x}{' '} = 'unknown';
7526 $stat->{$x}{'?'} = 'unknown';
7529 return +{} unless $ro && $ro->{statd};
7536 DV => $stat->{D}{$ro->{statd}},
7537 SV => $stat->{S}{$ro->{stats}},
7538 LV => $stat->{L}{$ro->{statl}},
7539 IV => $stat->{I}{$ro->{stati}},
7540 PV => $stat->{P}{$ro->{statp}},
7544 #-> sub CPAN::Module::as_string ;
7548 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
7549 my $class = ref($self);
7550 $class =~ s/^CPAN:://;
7552 push @m, $class, " id = $self->{ID}\n";
7553 my $sprintf = " %-12s %s\n";
7554 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
7555 if $self->description;
7556 my $sprintf2 = " %-12s %s (%s)\n";
7558 $userid = $self->userid;
7561 if ($author = CPAN::Shell->expand('Author',$userid)) {
7564 if ($m = $author->email) {
7571 $author->fullname . $email
7575 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
7576 if $self->cpan_version;
7577 if (my $cpan_file = $self->cpan_file){
7578 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
7579 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
7580 my $upload_date = $dist->upload_date;
7582 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
7586 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
7587 my $dslip = $self->dslip_status;
7591 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
7593 my $local_file = $self->inst_file;
7594 unless ($self->{MANPAGE}) {
7597 $manpage = $self->manpage_headline($local_file);
7599 # If we have already untarred it, we should look there
7600 my $dist = $CPAN::META->instance('CPAN::Distribution',
7602 # warn "dist[$dist]";
7603 # mff=manifest file; mfh=manifest handle
7608 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
7610 $mfh = FileHandle->new($mff)
7612 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
7613 my $lfre = $self->id; # local file RE
7616 my($lfl); # local file file
7618 my(@mflines) = <$mfh>;
7623 while (length($lfre)>5 and !$lfl) {
7624 ($lfl) = grep /$lfre/, @mflines;
7625 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
7628 $lfl =~ s/\s.*//; # remove comments
7629 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
7630 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
7631 # warn "lfl_abs[$lfl_abs]";
7633 $manpage = $self->manpage_headline($lfl_abs);
7637 $self->{MANPAGE} = $manpage if $manpage;
7640 for $item (qw/MANPAGE/) {
7641 push @m, sprintf($sprintf, $item, $self->{$item})
7642 if exists $self->{$item};
7644 for $item (qw/CONTAINS/) {
7645 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
7646 if exists $self->{$item} && @{$self->{$item}};
7648 push @m, sprintf($sprintf, 'INST_FILE',
7649 $local_file || "(not installed)");
7650 push @m, sprintf($sprintf, 'INST_VERSION',
7651 $self->inst_version) if $local_file;
7655 sub manpage_headline {
7656 my($self,$local_file) = @_;
7657 my(@local_file) = $local_file;
7658 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
7659 push @local_file, $local_file;
7661 for $locf (@local_file) {
7662 next unless -f $locf;
7663 my $fh = FileHandle->new($locf)
7664 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
7668 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
7669 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
7686 #-> sub CPAN::Module::cpan_file ;
7687 # Note: also inherited by CPAN::Bundle
7690 # CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
7691 unless ($self->ro) {
7692 CPAN::Index->reload;
7695 if ($ro && defined $ro->{CPAN_FILE}){
7696 return $ro->{CPAN_FILE};
7698 my $userid = $self->userid;
7700 if ($CPAN::META->exists("CPAN::Author",$userid)) {
7701 my $author = $CPAN::META->instance("CPAN::Author",
7703 my $fullname = $author->fullname;
7704 my $email = $author->email;
7705 unless (defined $fullname && defined $email) {
7706 return sprintf("Contact Author %s",
7710 return "Contact Author $fullname <$email>";
7712 return "Contact Author $userid (Email address not available)";
7720 #-> sub CPAN::Module::cpan_version ;
7726 # Can happen with modules that are not on CPAN
7729 $ro->{CPAN_VERSION} = 'undef'
7730 unless defined $ro->{CPAN_VERSION};
7731 $ro->{CPAN_VERSION};
7734 #-> sub CPAN::Module::force ;
7737 $self->{'force_update'}++;
7742 # warn "XDEBUG: set notest for Module";
7743 $self->{'notest'}++;
7746 #-> sub CPAN::Module::rematein ;
7748 my($self,$meth) = @_;
7749 $CPAN::Frontend->myprint(sprintf("Running %s for module '%s'\n",
7752 my $cpan_file = $self->cpan_file;
7753 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
7754 $CPAN::Frontend->mywarn(sprintf qq{
7755 The module %s isn\'t available on CPAN.
7757 Either the module has not yet been uploaded to CPAN, or it is
7758 temporary unavailable. Please contact the author to find out
7759 more about the status. Try 'i %s'.
7766 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
7767 $pack->called_for($self->id);
7768 $pack->force($meth) if exists $self->{'force_update'};
7769 $pack->notest($meth) if exists $self->{'notest'};
7771 $pack->{reqtype} ||= "";
7772 CPAN->debug("dist-reqtype[$pack->{reqtype}]".
7773 "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG;
7774 if ($pack->{reqtype}) {
7775 if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) {
7776 $pack->{reqtype} = $self->{reqtype};
7778 exists $pack->{install}
7781 $pack->{install}->can("failed") ?
7782 $pack->{install}->failed :
7783 $pack->{install} =~ /^NO/
7786 delete $pack->{install};
7787 $CPAN::Frontend->mywarn
7788 ("Promoting $pack->{ID} from 'build_requires' to 'requires'");
7792 $pack->{reqtype} = $self->{reqtype};
7799 $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
7800 $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
7801 delete $self->{'force_update'};
7802 delete $self->{'notest'};
7808 #-> sub CPAN::Module::perldoc ;
7809 sub perldoc { shift->rematein('perldoc') }
7810 #-> sub CPAN::Module::readme ;
7811 sub readme { shift->rematein('readme') }
7812 #-> sub CPAN::Module::look ;
7813 sub look { shift->rematein('look') }
7814 #-> sub CPAN::Module::cvs_import ;
7815 sub cvs_import { shift->rematein('cvs_import') }
7816 #-> sub CPAN::Module::get ;
7817 sub get { shift->rematein('get',@_) }
7818 #-> sub CPAN::Module::make ;
7819 sub make { shift->rematein('make') }
7820 #-> sub CPAN::Module::test ;
7823 $self->{badtestcnt} ||= 0;
7824 $self->rematein('test',@_);
7826 #-> sub CPAN::Module::uptodate ;
7829 local($_); # protect against a bug in MakeMaker 6.17
7830 my($latest) = $self->cpan_version;
7832 my($inst_file) = $self->inst_file;
7834 if (defined $inst_file) {
7835 $have = $self->inst_version;
7840 ! CPAN::Version->vgt($latest, $have)
7842 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
7843 "latest[$latest] have[$have]") if $CPAN::DEBUG;
7848 #-> sub CPAN::Module::install ;
7854 not exists $self->{'force_update'}
7856 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
7858 $self->inst_version,
7864 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
7865 $CPAN::Frontend->mywarn(qq{
7866 \n\n\n ***WARNING***
7867 The module $self->{ID} has no active maintainer.\n\n\n
7869 $CPAN::Frontend->mysleep(5);
7871 $self->rematein('install') if $doit;
7873 #-> sub CPAN::Module::clean ;
7874 sub clean { shift->rematein('clean') }
7876 #-> sub CPAN::Module::inst_file ;
7880 @packpath = split /::/, $self->{ID};
7881 $packpath[-1] .= ".pm";
7882 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
7883 unshift @packpath, "Term", "ReadLine"; # historical reasons
7885 foreach $dir (@INC) {
7886 my $pmfile = File::Spec->catfile($dir,@packpath);
7894 #-> sub CPAN::Module::xs_file ;
7898 @packpath = split /::/, $self->{ID};
7899 push @packpath, $packpath[-1];
7900 $packpath[-1] .= "." . $Config::Config{'dlext'};
7901 foreach $dir (@INC) {
7902 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
7910 #-> sub CPAN::Module::inst_version ;
7913 my $parsefile = $self->inst_file or return;
7914 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
7917 $have = MM->parse_version($parsefile) || "undef";
7918 $have =~ s/^ //; # since the %vd hack these two lines here are needed
7919 $have =~ s/ $//; # trailing whitespace happens all the time
7921 # My thoughts about why %vd processing should happen here
7923 # Alt1 maintain it as string with leading v:
7924 # read index files do nothing
7925 # compare it use utility for compare
7926 # print it do nothing
7928 # Alt2 maintain it as what it is
7929 # read index files convert
7930 # compare it use utility because there's still a ">" vs "gt" issue
7931 # print it use CPAN::Version for print
7933 # Seems cleaner to hold it in memory as a string starting with a "v"
7935 # If the author of this module made a mistake and wrote a quoted
7936 # "v1.13" instead of v1.13, we simply leave it at that with the
7937 # effect that *we* will treat it like a v-tring while the rest of
7938 # perl won't. Seems sensible when we consider that any action we
7939 # could take now would just add complexity.
7941 $have = CPAN::Version->readable($have);
7943 $have =~ s/\s*//g; # stringify to float around floating point issues
7944 $have; # no stringify needed, \s* above matches always
7957 CPAN - query, download and build perl modules from CPAN sites
7963 perl -MCPAN -e shell;
7971 cpan> install Acme::Meta # in the shell
7973 CPAN::Shell->install("Acme::Meta"); # in perl
7977 cpan> install NWCLARK/Acme-Meta-0.02.tar.gz # in the shell
7980 install("NWCLARK/Acme-Meta-0.02.tar.gz"); # in perl
7984 $mo = CPAN::Shell->expandany($mod);
7985 $mo = CPAN::Shell->expand("Module",$mod); # same thing
7987 # distribution objects:
7989 $do = CPAN::Shell->expand("Module",$mod)->distribution;
7990 $do = CPAN::Shell->expandany($distro); # same thing
7991 $do = CPAN::Shell->expand("Distribution",
7992 $distro); # same thing
7996 This module and its competitor, the CPANPLUS module, are both much
7997 cooler than the other.
7999 =head1 COMPATIBILITY
8001 CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
8002 newer versions. It is getting more and more difficult to get the
8003 minimal prerequisites working on older perls. It is close to
8004 impossible to get the whole Bundle::CPAN working there. If you're in
8005 the position to have only these old versions, be advised that CPAN is
8006 designed to work fine without the Bundle::CPAN installed.
8008 To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
8009 compatible with ancient perls and that File::Temp is listed as a
8010 prerequisite but CPAN has reasonable workarounds if it is missing.
8014 The CPAN module is designed to automate the make and install of perl
8015 modules and extensions. It includes some primitive searching
8016 capabilities and knows how to use Net::FTP or LWP (or some external
8017 download clients) to fetch the raw data from the net.
8019 Modules are fetched from one or more of the mirrored CPAN
8020 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
8023 The CPAN module also supports the concept of named and versioned
8024 I<bundles> of modules. Bundles simplify the handling of sets of
8025 related modules. See Bundles below.
8027 The package contains a session manager and a cache manager. There is
8028 no status retained between sessions. The session manager keeps track
8029 of what has been fetched, built and installed in the current
8030 session. The cache manager keeps track of the disk space occupied by
8031 the make processes and deletes excess space according to a simple FIFO
8034 All methods provided are accessible in a programmer style and in an
8035 interactive shell style.
8037 =head2 CPAN::shell([$prompt, $command]) Starting Interactive Mode
8039 The interactive mode is entered by running
8041 perl -MCPAN -e shell
8043 which puts you into a readline interface. You will have the most fun if
8044 you install Term::ReadKey and Term::ReadLine to enjoy both history and
8047 Once you are on the command line, type 'h' and the rest should be
8050 The function call C<shell> takes two optional arguments, one is the
8051 prompt, the second is the default initial command line (the latter
8052 only works if a real ReadLine interface module is installed).
8054 The most common uses of the interactive modes are
8058 =item Searching for authors, bundles, distribution files and modules
8060 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
8061 for each of the four categories and another, C<i> for any of the
8062 mentioned four. Each of the four entities is implemented as a class
8063 with slightly differing methods for displaying an object.
8065 Arguments you pass to these commands are either strings exactly matching
8066 the identification string of an object or regular expressions that are
8067 then matched case-insensitively against various attributes of the
8068 objects. The parser recognizes a regular expression only if you
8069 enclose it between two slashes.
8071 The principle is that the number of found objects influences how an
8072 item is displayed. If the search finds one item, the result is
8073 displayed with the rather verbose method C<as_string>, but if we find
8074 more than one, we display each object with the terse method
8077 =item make, test, install, clean modules or distributions
8079 These commands take any number of arguments and investigate what is
8080 necessary to perform the action. If the argument is a distribution
8081 file name (recognized by embedded slashes), it is processed. If it is
8082 a module, CPAN determines the distribution file in which this module
8083 is included and processes that, following any dependencies named in
8084 the module's META.yml or Makefile.PL (this behavior is controlled by
8085 the configuration parameter C<prerequisites_policy>.)
8087 Any C<make> or C<test> are run unconditionally. An
8089 install <distribution_file>
8091 also is run unconditionally. But for
8095 CPAN checks if an install is actually needed for it and prints
8096 I<module up to date> in the case that the distribution file containing
8097 the module doesn't need to be updated.
8099 CPAN also keeps track of what it has done within the current session
8100 and doesn't try to build a package a second time regardless if it
8101 succeeded or not. The C<force> pragma may precede another command
8102 (currently: C<make>, C<test>, or C<install>) and executes the
8103 command from scratch and tries to continue in case of some errors.
8107 cpan> install OpenGL
8108 OpenGL is up to date.
8109 cpan> force install OpenGL
8112 OpenGL-0.4/COPYRIGHT
8115 The C<notest> pragma may be set to skip the test part in the build
8120 cpan> notest install Tk
8122 A C<clean> command results in a
8126 being executed within the distribution file's working directory.
8128 =item get, readme, perldoc, look module or distribution
8130 C<get> downloads a distribution file without further action. C<readme>
8131 displays the README file of the associated distribution. C<Look> gets
8132 and untars (if not yet done) the distribution file, changes to the
8133 appropriate directory and opens a subshell process in that directory.
8134 C<perldoc> displays the pod documentation of the module in html or
8139 =item ls globbing_expression
8141 The first form lists all distribution files in and below an author's
8142 CPAN directory as they are stored in the CHECKUMS files distributed on
8143 CPAN. The listing goes recursive into all subdirectories.
8145 The second form allows to limit or expand the output with shell
8146 globbing as in the following examples:
8152 The last example is very slow and outputs extra progress indicators
8153 that break the alignment of the result.
8155 Note that globbing only lists directories explicitly asked for, for
8156 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
8157 regarded as a bug and may be changed in future versions.
8161 The C<failed> command reports all distributions that failed on one of
8162 C<make>, C<test> or C<install> for some reason in the currently
8163 running shell session.
8167 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>
8168 (but the directory can be configured via the C<cpan_home> config
8169 variable). The shell is a bit picky if you try to start another CPAN
8170 session. It dies immediately if there is a lockfile and the lock seems
8171 to belong to a running process. In case you want to run a second shell
8172 session, it is probably safest to maintain another directory, say
8173 C<~/.cpan-for-X/> and a C<~/.cpan-for-X/CPAN/MyConfig.pm> that
8174 contains the configuration options. Then you can start the second
8177 perl -I ~/.cpan-for-X -MCPAN::MyConfig -MCPAN -e shell
8181 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
8182 in the cpan-shell it is intended that you can press C<^C> anytime and
8183 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
8184 to clean up and leave the shell loop. You can emulate the effect of a
8185 SIGTERM by sending two consecutive SIGINTs, which usually means by
8186 pressing C<^C> twice.
8188 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
8189 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
8190 Build.PL> subprocess.
8196 The commands that are available in the shell interface are methods in
8197 the package CPAN::Shell. If you enter the shell command, all your
8198 input is split by the Text::ParseWords::shellwords() routine which
8199 acts like most shells do. The first word is being interpreted as the
8200 method to be called and the rest of the words are treated as arguments
8201 to this method. Continuation lines are supported if a line ends with a
8206 C<autobundle> writes a bundle file into the
8207 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
8208 a list of all modules that are both available from CPAN and currently
8209 installed within @INC. The name of the bundle file is based on the
8210 current date and a counter.
8214 recompile() is a very special command in that it takes no argument and
8215 runs the make/test/install cycle with brute force over all installed
8216 dynamically loadable extensions (aka XS modules) with 'force' in
8217 effect. The primary purpose of this command is to finish a network
8218 installation. Imagine, you have a common source tree for two different
8219 architectures. You decide to do a completely independent fresh
8220 installation. You start on one architecture with the help of a Bundle
8221 file produced earlier. CPAN installs the whole Bundle for you, but
8222 when you try to repeat the job on the second architecture, CPAN
8223 responds with a C<"Foo up to date"> message for all modules. So you
8224 invoke CPAN's recompile on the second architecture and you're done.
8226 Another popular use for C<recompile> is to act as a rescue in case your
8227 perl breaks binary compatibility. If one of the modules that CPAN uses
8228 is in turn depending on binary compatibility (so you cannot run CPAN
8229 commands), then you should try the CPAN::Nox module for recovery.
8231 =head2 report Bundle|Distribution|Module
8233 The C<report> command temporarily turns on the C<test_report> config
8234 variable, then runs the C<force test> command with the given
8235 arguments. The C<force> pragma is used to re-run the tests and repeat
8236 every step that might have failed before.
8238 =head2 upgrade [Module|/Regex/]...
8240 The C<upgrade> command first runs an C<r> command with the given
8241 arguments and then installs the newest versions of all modules that
8242 were listed by that.
8246 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
8247 directory so that you can save your own preferences instead of the
8250 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
8252 Although it may be considered internal, the class hierarchy does matter
8253 for both users and programmer. CPAN.pm deals with above mentioned four
8254 classes, and all those classes share a set of methods. A classical
8255 single polymorphism is in effect. A metaclass object registers all
8256 objects of all kinds and indexes them with a string. The strings
8257 referencing objects have a separated namespace (well, not completely
8262 words containing a "/" (slash) Distribution
8263 words starting with Bundle:: Bundle
8264 everything else Module or Author
8266 Modules know their associated Distribution objects. They always refer
8267 to the most recent official release. Developers may mark their releases
8268 as unstable development versions (by inserting an underbar into the
8269 module version number which will also be reflected in the distribution
8270 name when you run 'make dist'), so the really hottest and newest
8271 distribution is not always the default. If a module Foo circulates
8272 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
8273 way to install version 1.23 by saying
8277 This would install the complete distribution file (say
8278 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
8279 like to install version 1.23_90, you need to know where the
8280 distribution file resides on CPAN relative to the authors/id/
8281 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
8282 so you would have to say
8284 install BAR/Foo-1.23_90.tar.gz
8286 The first example will be driven by an object of the class
8287 CPAN::Module, the second by an object of class CPAN::Distribution.
8289 =head2 Integrating local directories
8291 Distribution objects are normally distributions from the CPAN, but
8292 there is a slightly degenerate case for Distribution objects, too,
8293 normally only needed by developers. If a distribution object ends with
8294 a dot or is a dot by itself, then it represents a local directory and
8295 all actions such as C<make>, C<test>, and C<install> are applied
8296 directly to that directory. This gives the command C<cpan .> an
8297 interesting touch: while the normal mantra of installing a CPAN module
8298 without CPAN.pm is one of
8300 perl Makefile.PL perl Build.PL
8301 ( go and get prerequisites )
8303 make test ./Build test
8304 make install ./Build install
8306 the command C<cpan .> does all of this at once. It figures out which
8307 of the two mantras is appropriate, fetches and installs all
8308 prerequisites, cares for them recursively and finally finishes the
8309 installation of the module in the current directory, be it a CPAN
8312 =head1 PROGRAMMER'S INTERFACE
8314 If you do not enter the shell, the available shell commands are both
8315 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
8316 functions in the calling package (C<install(...)>).
8318 There's currently only one class that has a stable interface -
8319 CPAN::Shell. All commands that are available in the CPAN shell are
8320 methods of the class CPAN::Shell. Each of the commands that produce
8321 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
8322 the IDs of all modules within the list.
8326 =item expand($type,@things)
8328 The IDs of all objects available within a program are strings that can
8329 be expanded to the corresponding real objects with the
8330 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
8331 list of CPAN::Module objects according to the C<@things> arguments
8332 given. In scalar context it only returns the first element of the
8335 =item expandany(@things)
8337 Like expand, but returns objects of the appropriate type, i.e.
8338 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
8339 CPAN::Distribution objects for distributions. Note: it does not expand
8340 to CPAN::Author objects.
8342 =item Programming Examples
8344 This enables the programmer to do operations that combine
8345 functionalities that are available in the shell.
8347 # install everything that is outdated on my disk:
8348 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
8350 # install my favorite programs if necessary:
8351 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
8352 CPAN::Shell->install($mod);
8355 # list all modules on my disk that have no VERSION number
8356 for $mod (CPAN::Shell->expand("Module","/./")){
8357 next unless $mod->inst_file;
8358 # MakeMaker convention for undefined $VERSION:
8359 next unless $mod->inst_version eq "undef";
8360 print "No VERSION in ", $mod->id, "\n";
8363 # find out which distribution on CPAN contains a module:
8364 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
8366 Or if you want to write a cronjob to watch The CPAN, you could list
8367 all modules that need updating. First a quick and dirty way:
8369 perl -e 'use CPAN; CPAN::Shell->r;'
8371 If you don't want to get any output in the case that all modules are
8372 up to date, you can parse the output of above command for the regular
8373 expression //modules are up to date// and decide to mail the output
8374 only if it doesn't match. Ick?
8376 If you prefer to do it more in a programmer style in one single
8377 process, maybe something like this suits you better:
8379 # list all modules on my disk that have newer versions on CPAN
8380 for $mod (CPAN::Shell->expand("Module","/./")){
8381 next unless $mod->inst_file;
8382 next if $mod->uptodate;
8383 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
8384 $mod->id, $mod->inst_version, $mod->cpan_version;
8387 If that gives you too much output every day, you maybe only want to
8388 watch for three modules. You can write
8390 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
8392 as the first line instead. Or you can combine some of the above
8395 # watch only for a new mod_perl module
8396 $mod = CPAN::Shell->expand("Module","mod_perl");
8397 exit if $mod->uptodate;
8398 # new mod_perl arrived, let me know all update recommendations
8403 =head2 Methods in the other Classes
8405 The programming interface for the classes CPAN::Module,
8406 CPAN::Distribution, CPAN::Bundle, and CPAN::Author is still considered
8407 beta and partially even alpha. In the following paragraphs only those
8408 methods are documented that have proven useful over a longer time and
8409 thus are unlikely to change.
8413 =item CPAN::Author::as_glimpse()
8415 Returns a one-line description of the author
8417 =item CPAN::Author::as_string()
8419 Returns a multi-line description of the author
8421 =item CPAN::Author::email()
8423 Returns the author's email address
8425 =item CPAN::Author::fullname()
8427 Returns the author's name
8429 =item CPAN::Author::name()
8431 An alias for fullname
8433 =item CPAN::Bundle::as_glimpse()
8435 Returns a one-line description of the bundle
8437 =item CPAN::Bundle::as_string()
8439 Returns a multi-line description of the bundle
8441 =item CPAN::Bundle::clean()
8443 Recursively runs the C<clean> method on all items contained in the bundle.
8445 =item CPAN::Bundle::contains()
8447 Returns a list of objects' IDs contained in a bundle. The associated
8448 objects may be bundles, modules or distributions.
8450 =item CPAN::Bundle::force($method,@args)
8452 Forces CPAN to perform a task that normally would have failed. Force
8453 takes as arguments a method name to be called and any number of
8454 additional arguments that should be passed to the called method. The
8455 internals of the object get the needed changes so that CPAN.pm does
8456 not refuse to take the action. The C<force> is passed recursively to
8457 all contained objects.
8459 =item CPAN::Bundle::get()
8461 Recursively runs the C<get> method on all items contained in the bundle
8463 =item CPAN::Bundle::inst_file()
8465 Returns the highest installed version of the bundle in either @INC or
8466 C<$CPAN::Config->{cpan_home}>. Note that this is different from
8467 CPAN::Module::inst_file.
8469 =item CPAN::Bundle::inst_version()
8471 Like CPAN::Bundle::inst_file, but returns the $VERSION
8473 =item CPAN::Bundle::uptodate()
8475 Returns 1 if the bundle itself and all its members are uptodate.
8477 =item CPAN::Bundle::install()
8479 Recursively runs the C<install> method on all items contained in the bundle
8481 =item CPAN::Bundle::make()
8483 Recursively runs the C<make> method on all items contained in the bundle
8485 =item CPAN::Bundle::readme()
8487 Recursively runs the C<readme> method on all items contained in the bundle
8489 =item CPAN::Bundle::test()
8491 Recursively runs the C<test> method on all items contained in the bundle
8493 =item CPAN::Distribution::as_glimpse()
8495 Returns a one-line description of the distribution
8497 =item CPAN::Distribution::as_string()
8499 Returns a multi-line description of the distribution
8501 =item CPAN::Distribution::author
8503 Returns the CPAN::Author object of the maintainer who uploaded this
8506 =item CPAN::Distribution::clean()
8508 Changes to the directory where the distribution has been unpacked and
8509 runs C<make clean> there.
8511 =item CPAN::Distribution::containsmods()
8513 Returns a list of IDs of modules contained in a distribution file.
8514 Only works for distributions listed in the 02packages.details.txt.gz
8515 file. This typically means that only the most recent version of a
8516 distribution is covered.
8518 =item CPAN::Distribution::cvs_import()
8520 Changes to the directory where the distribution has been unpacked and
8523 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
8527 =item CPAN::Distribution::dir()
8529 Returns the directory into which this distribution has been unpacked.
8531 =item CPAN::Distribution::force($method,@args)
8533 Forces CPAN to perform a task that normally would have failed. Force
8534 takes as arguments a method name to be called and any number of
8535 additional arguments that should be passed to the called method. The
8536 internals of the object get the needed changes so that CPAN.pm does
8537 not refuse to take the action.
8539 =item CPAN::Distribution::get()
8541 Downloads the distribution from CPAN and unpacks it. Does nothing if
8542 the distribution has already been downloaded and unpacked within the
8545 =item CPAN::Distribution::install()
8547 Changes to the directory where the distribution has been unpacked and
8548 runs the external command C<make install> there. If C<make> has not
8549 yet been run, it will be run first. A C<make test> will be issued in
8550 any case and if this fails, the install will be canceled. The
8551 cancellation can be avoided by letting C<force> run the C<install> for
8554 This install method has only the power to install the distribution if
8555 there are no dependencies in the way. To install an object and all of
8556 its dependencies, use CPAN::Shell->install.
8558 Note that install() gives no meaningful return value. See uptodate().
8560 =item CPAN::Distribution::isa_perl()
8562 Returns 1 if this distribution file seems to be a perl distribution.
8563 Normally this is derived from the file name only, but the index from
8564 CPAN can contain a hint to achieve a return value of true for other
8567 =item CPAN::Distribution::look()
8569 Changes to the directory where the distribution has been unpacked and
8570 opens a subshell there. Exiting the subshell returns.
8572 =item CPAN::Distribution::make()
8574 First runs the C<get> method to make sure the distribution is
8575 downloaded and unpacked. Changes to the directory where the
8576 distribution has been unpacked and runs the external commands C<perl
8577 Makefile.PL> or C<perl Build.PL> and C<make> there.
8579 =item CPAN::Distribution::perldoc()
8581 Downloads the pod documentation of the file associated with a
8582 distribution (in html format) and runs it through the external
8583 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
8584 isn't available, it converts it to plain text with external
8585 command html2text and runs it through the pager specified
8586 in C<$CPAN::Config->{pager}>
8588 =item CPAN::Distribution::prefs()
8590 Returns the hash reference from the first matching YAML file that the
8591 user has deposited in the C<prefs_dir/> directory. The first
8592 succeeding match wins. The files in the C<prefs_dir/> are processed
8593 alphabetically and the canonical distroname (e.g.
8594 AUTHOR/Foo-Bar-3.14.tar.gz) is matched against the regular expressions
8595 stored in the $root->{match}{distribution} attribute value.
8596 Additionally all module names contained in a distribution are matched
8597 agains the regular expressions in the $root->{match}{module} attribute
8598 value. The two match values are ANDed together. Each of the two
8599 attributes are optional.
8601 =item CPAN::Distribution::prereq_pm()
8603 Returns the hash reference that has been announced by a distribution
8604 as the merge of the C<requires> element and the C<build_requires>
8605 element of the META.yml or the C<PREREQ_PM> hash in the
8606 C<Makefile.PL>. Note: works only after an attempt has been made to
8607 C<make> the distribution. Returns undef otherwise.
8609 =item CPAN::Distribution::readme()
8611 Downloads the README file associated with a distribution and runs it
8612 through the pager specified in C<$CPAN::Config->{pager}>.
8614 =item CPAN::Distribution::read_yaml()
8616 Returns the content of the META.yml of this distro as a hashref. Note:
8617 works only after an attempt has been made to C<make> the distribution.
8618 Returns undef otherwise. Also returns undef if the content of META.yml
8621 =item CPAN::Distribution::test()
8623 Changes to the directory where the distribution has been unpacked and
8624 runs C<make test> there.
8626 =item CPAN::Distribution::uptodate()
8628 Returns 1 if all the modules contained in the distribution are
8629 uptodate. Relies on containsmods.
8631 =item CPAN::Index::force_reload()
8633 Forces a reload of all indices.
8635 =item CPAN::Index::reload()
8637 Reloads all indices if they have not been read for more than
8638 C<$CPAN::Config->{index_expire}> days.
8640 =item CPAN::InfoObj::dump()
8642 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
8643 inherit this method. It prints the data structure associated with an
8644 object. Useful for debugging. Note: the data structure is considered
8645 internal and thus subject to change without notice.
8647 =item CPAN::Module::as_glimpse()
8649 Returns a one-line description of the module in four columns: The
8650 first column contains the word C<Module>, the second column consists
8651 of one character: an equals sign if this module is already installed
8652 and uptodate, a less-than sign if this module is installed but can be
8653 upgraded, and a space if the module is not installed. The third column
8654 is the name of the module and the fourth column gives maintainer or
8655 distribution information.
8657 =item CPAN::Module::as_string()
8659 Returns a multi-line description of the module
8661 =item CPAN::Module::clean()
8663 Runs a clean on the distribution associated with this module.
8665 =item CPAN::Module::cpan_file()
8667 Returns the filename on CPAN that is associated with the module.
8669 =item CPAN::Module::cpan_version()
8671 Returns the latest version of this module available on CPAN.
8673 =item CPAN::Module::cvs_import()
8675 Runs a cvs_import on the distribution associated with this module.
8677 =item CPAN::Module::description()
8679 Returns a 44 character description of this module. Only available for
8680 modules listed in The Module List (CPAN/modules/00modlist.long.html
8681 or 00modlist.long.txt.gz)
8683 =item CPAN::Module::distribution()
8685 Returns the CPAN::Distribution object that contains the current
8686 version of this module.
8688 =item CPAN::Module::dslip_status()
8690 Returns a hash reference. The keys of the hash are the letters C<D>,
8691 C<S>, C<L>, C<I>, and <P>, for development status, support level,
8692 language, interface and public licence respectively. The data for the
8693 DSLIP status are collected by pause.perl.org when authors register
8694 their namespaces. The values of the 5 hash elements are one-character
8695 words whose meaning is described in the table below. There are also 5
8696 hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
8697 verbose value of the 5 status variables.
8699 Where the 'DSLIP' characters have the following meanings:
8701 D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
8702 i - Idea, listed to gain consensus or as a placeholder
8703 c - under construction but pre-alpha (not yet released)
8704 a/b - Alpha/Beta testing
8706 M - Mature (no rigorous definition)
8707 S - Standard, supplied with Perl 5
8712 u - Usenet newsgroup comp.lang.perl.modules
8713 n - None known, try comp.lang.perl.modules
8714 a - abandoned; volunteers welcome to take over maintainance
8717 p - Perl-only, no compiler needed, should be platform independent
8718 c - C and perl, a C compiler will be needed
8719 h - Hybrid, written in perl with optional C code, no compiler needed
8720 + - C++ and perl, a C++ compiler will be needed
8721 o - perl and another language other than C or C++
8724 f - plain Functions, no references used
8725 h - hybrid, object and function interfaces available
8726 n - no interface at all (huh?)
8727 r - some use of unblessed References or ties
8728 O - Object oriented using blessed references and/or inheritance
8731 p - Standard-Perl: user may choose between GPL and Artistic
8732 g - GPL: GNU General Public License
8733 l - LGPL: "GNU Lesser General Public License" (previously known as
8734 "GNU Library General Public License")
8735 b - BSD: The BSD License
8736 a - Artistic license alone
8737 o - open source: appoved by www.opensource.org
8738 d - allows distribution without restrictions
8739 r - restricted distribtion
8740 n - no license at all
8742 =item CPAN::Module::force($method,@args)
8744 Forces CPAN to perform a task that normally would have failed. Force
8745 takes as arguments a method name to be called and any number of
8746 additional arguments that should be passed to the called method. The
8747 internals of the object get the needed changes so that CPAN.pm does
8748 not refuse to take the action.
8750 =item CPAN::Module::get()
8752 Runs a get on the distribution associated with this module.
8754 =item CPAN::Module::inst_file()
8756 Returns the filename of the module found in @INC. The first file found
8757 is reported just like perl itself stops searching @INC when it finds a
8760 =item CPAN::Module::inst_version()
8762 Returns the version number of the module in readable format.
8764 =item CPAN::Module::install()
8766 Runs an C<install> on the distribution associated with this module.
8768 =item CPAN::Module::look()
8770 Changes to the directory where the distribution associated with this
8771 module has been unpacked and opens a subshell there. Exiting the
8774 =item CPAN::Module::make()
8776 Runs a C<make> on the distribution associated with this module.
8778 =item CPAN::Module::manpage_headline()
8780 If module is installed, peeks into the module's manpage, reads the
8781 headline and returns it. Moreover, if the module has been downloaded
8782 within this session, does the equivalent on the downloaded module even
8783 if it is not installed.
8785 =item CPAN::Module::perldoc()
8787 Runs a C<perldoc> on this module.
8789 =item CPAN::Module::readme()
8791 Runs a C<readme> on the distribution associated with this module.
8793 =item CPAN::Module::test()
8795 Runs a C<test> on the distribution associated with this module.
8797 =item CPAN::Module::uptodate()
8799 Returns 1 if the module is installed and up-to-date.
8801 =item CPAN::Module::userid()
8803 Returns the author's ID of the module.
8807 =head2 Cache Manager
8809 Currently the cache manager only keeps track of the build directory
8810 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
8811 deletes complete directories below C<build_dir> as soon as the size of
8812 all directories there gets bigger than $CPAN::Config->{build_cache}
8813 (in MB). The contents of this cache may be used for later
8814 re-installations that you intend to do manually, but will never be
8815 trusted by CPAN itself. This is due to the fact that the user might
8816 use these directories for building modules on different architectures.
8818 There is another directory ($CPAN::Config->{keep_source_where}) where
8819 the original distribution files are kept. This directory is not
8820 covered by the cache manager and must be controlled by the user. If
8821 you choose to have the same directory as build_dir and as
8822 keep_source_where directory, then your sources will be deleted with
8823 the same fifo mechanism.
8827 A bundle is just a perl module in the namespace Bundle:: that does not
8828 define any functions or methods. It usually only contains documentation.
8830 It starts like a perl module with a package declaration and a $VERSION
8831 variable. After that the pod section looks like any other pod with the
8832 only difference being that I<one special pod section> exists starting with
8837 In this pod section each line obeys the format
8839 Module_Name [Version_String] [- optional text]
8841 The only required part is the first field, the name of a module
8842 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
8843 of the line is optional. The comment part is delimited by a dash just
8844 as in the man page header.
8846 The distribution of a bundle should follow the same convention as
8847 other distributions.
8849 Bundles are treated specially in the CPAN package. If you say 'install
8850 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
8851 the modules in the CONTENTS section of the pod. You can install your
8852 own Bundles locally by placing a conformant Bundle file somewhere into
8853 your @INC path. The autobundle() command which is available in the
8854 shell interface does that for you by including all currently installed
8855 modules in a snapshot bundle file.
8857 =head1 PREREQUISITES
8859 If you have a local mirror of CPAN and can access all files with
8860 "file:" URLs, then you only need a perl better than perl5.003 to run
8861 this module. Otherwise Net::FTP is strongly recommended. LWP may be
8862 required for non-UNIX systems or if your nearest CPAN site is
8863 associated with a URL that is not C<ftp:>.
8865 If you have neither Net::FTP nor LWP, there is a fallback mechanism
8866 implemented for an external ftp command or for an external lynx
8871 =head2 Finding packages and VERSION
8873 This module presumes that all packages on CPAN
8879 declare their $VERSION variable in an easy to parse manner. This
8880 prerequisite can hardly be relaxed because it consumes far too much
8881 memory to load all packages into the running program just to determine
8882 the $VERSION variable. Currently all programs that are dealing with
8883 version use something like this
8885 perl -MExtUtils::MakeMaker -le \
8886 'print MM->parse_version(shift)' filename
8888 If you are author of a package and wonder if your $VERSION can be
8889 parsed, please try the above method.
8893 come as compressed or gzipped tarfiles or as zip files and contain a
8894 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
8895 without much enthusiasm).
8901 The debugging of this module is a bit complex, because we have
8902 interferences of the software producing the indices on CPAN, of the
8903 mirroring process on CPAN, of packaging, of configuration, of
8904 synchronicity, and of bugs within CPAN.pm.
8906 For debugging the code of CPAN.pm itself in interactive mode some more
8907 or less useful debugging aid can be turned on for most packages within
8912 =item o debug package...
8914 sets debug mode for packages.
8916 =item o debug -package...
8918 unsets debug mode for packages.
8922 turns debugging on for all packages.
8924 =item o debug number
8928 which sets the debugging packages directly. Note that C<o debug 0>
8929 turns debugging off.
8931 What seems quite a successful strategy is the combination of C<reload
8932 cpan> and the debugging switches. Add a new debug statement while
8933 running in the shell and then issue a C<reload cpan> and see the new
8934 debugging messages immediately without losing the current context.
8936 C<o debug> without an argument lists the valid package names and the
8937 current set of packages in debugging mode. C<o debug> has built-in
8940 For debugging of CPAN data there is the C<dump> command which takes
8941 the same arguments as make/test/install and outputs each object's
8942 Data::Dumper dump. If an argument looks like a perl variable and
8943 contains one of C<$>, C<@> or C<%>, it is eval()ed and fed to
8944 Data::Dumper directly.
8946 =head2 Floppy, Zip, Offline Mode
8948 CPAN.pm works nicely without network too. If you maintain machines
8949 that are not networked at all, you should consider working with file:
8950 URLs. Of course, you have to collect your modules somewhere first. So
8951 you might use CPAN.pm to put together all you need on a networked
8952 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
8953 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
8954 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
8955 with this floppy. See also below the paragraph about CD-ROM support.
8957 =head2 Basic Utilities for Programmers
8961 =item has_inst($module)
8963 Returns true if the module is installed. See the source for details.
8965 =item has_usable($module)
8967 Returns true if the module is installed and several and is in a usable
8968 state. Only useful for a handful of modules that are used internally.
8969 See the source for details.
8971 =item instance($module)
8973 The constructor for all the singletons used to represent modules,
8974 distributions, authors and bundles. If the object already exists, this
8975 method returns the object, otherwise it calls the constructor.
8979 =head1 CONFIGURATION
8981 When the CPAN module is used for the first time, a configuration
8982 dialog tries to determine a couple of site specific options. The
8983 result of the dialog is stored in a hash reference C< $CPAN::Config >
8984 in a file CPAN/Config.pm.
8986 The default values defined in the CPAN/Config.pm file can be
8987 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
8988 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
8989 added to the search path of the CPAN module before the use() or
8990 require() statements.
8992 The configuration dialog can be started any time later again by
8993 issuing the command C< o conf init > in the CPAN shell. A subset of
8994 the configuration dialog can be run by issuing C<o conf init WORD>
8995 where WORD is any valid config variable or a regular expression.
8997 Currently the following keys in the hash reference $CPAN::Config are
9000 build_cache size of cache for directories to build modules
9001 build_dir locally accessible directory to build modules
9002 build_requires_install_policy
9003 to install or not to install: when a module is
9004 only needed for building. yes|no|ask/yes|ask/no
9005 bzip2 path to external prg
9006 cache_metadata use serializer to cache metadata
9007 commands_quote prefered character to use for quoting external
9008 commands when running them. Defaults to double
9009 quote on Windows, single tick everywhere else;
9010 can be set to space to disable quoting
9011 check_sigs if signatures should be verified
9012 colorize_output boolean if Term::ANSIColor should colorize output
9013 colorize_print Term::ANSIColor attributes for normal output
9014 colorize_warn Term::ANSIColor attributes for warnings
9015 commandnumber_in_prompt
9016 boolean if you want to see current command number
9017 cpan_home local directory reserved for this package
9018 curl path to external prg
9019 dontload_hash DEPRECATED
9020 dontload_list arrayref: modules in the list will not be
9021 loaded by the CPAN::has_inst() routine
9022 ftp path to external prg
9023 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
9024 ftp_proxy proxy host for ftp requests
9026 gpg path to external prg
9027 gzip location of external program gzip
9028 histfile file to maintain history between sessions
9029 histsize maximum number of lines to keep in histfile
9030 http_proxy proxy host for http requests
9031 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
9032 after this many seconds inactivity. Set to 0 to
9034 index_expire after this many days refetch index files
9035 inhibit_startup_message
9036 if true, does not print the startup message
9037 keep_source_where directory in which to keep the source (if we do)
9038 lynx path to external prg
9039 make location of external make program
9040 make_arg arguments that should always be passed to 'make'
9041 make_install_make_command
9042 the make command for running 'make install', for
9044 make_install_arg same as make_arg for 'make install'
9045 makepl_arg arguments passed to 'perl Makefile.PL'
9046 mbuild_arg arguments passed to './Build'
9047 mbuild_install_arg arguments passed to './Build install'
9048 mbuild_install_build_command
9049 command to use instead of './Build' when we are
9050 in the install stage, for example 'sudo ./Build'
9051 mbuildpl_arg arguments passed to 'perl Build.PL'
9052 ncftp path to external prg
9053 ncftpget path to external prg
9054 no_proxy don't proxy to these hosts/domains (comma separated list)
9055 pager location of external program more (or any pager)
9056 password your password if you CPAN server wants one
9057 patch path to external prg
9058 prefer_installer legal values are MB and EUMM: if a module comes
9059 with both a Makefile.PL and a Build.PL, use the
9060 former (EUMM) or the latter (MB); if the module
9061 comes with only one of the two, that one will be
9063 prerequisites_policy
9064 what to do if you are missing module prerequisites
9065 ('follow' automatically, 'ask' me, or 'ignore')
9066 prefs_dir local directory to store per-distro build options
9067 proxy_user username for accessing an authenticating proxy
9068 proxy_pass password for accessing an authenticating proxy
9069 scan_cache controls scanning of cache ('atstart' or 'never')
9070 shell your favorite shell
9071 show_upload_date boolean if commands should try to determine upload date
9072 tar location of external program tar
9073 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
9074 (and nonsense for characters outside latin range)
9075 term_ornaments boolean to turn ReadLine ornamenting on/off
9076 test_report email test reports (if CPAN::Reporter is installed)
9077 unzip location of external program unzip
9078 urllist arrayref to nearby CPAN sites (or equivalent locations)
9079 username your username if you CPAN server wants one
9080 wait_list arrayref to a wait server to try (See CPAN::WAIT)
9081 wget path to external prg
9082 yaml_module which module to use to read/write YAML files
9084 You can set and query each of these options interactively in the cpan
9085 shell with the command set defined within the C<o conf> command:
9089 =item C<o conf E<lt>scalar optionE<gt>>
9091 prints the current value of the I<scalar option>
9093 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
9095 Sets the value of the I<scalar option> to I<value>
9097 =item C<o conf E<lt>list optionE<gt>>
9099 prints the current value of the I<list option> in MakeMaker's
9102 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
9104 shifts or pops the array in the I<list option> variable
9106 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
9108 works like the corresponding perl commands.
9112 =head2 CPAN::anycwd($path): Note on config variable getcwd
9114 CPAN.pm changes the current working directory often and needs to
9115 determine its own current working directory. Per default it uses
9116 Cwd::cwd but if this doesn't work on your system for some reason,
9117 alternatives can be configured according to the following table:
9135 Calls the external command cwd.
9139 =head2 Note on urllist parameter's format
9141 urllist parameters are URLs according to RFC 1738. We do a little
9142 guessing if your URL is not compliant, but if you have problems with
9143 file URLs, please try the correct format. Either:
9145 file://localhost/whatever/ftp/pub/CPAN/
9149 file:///home/ftp/pub/CPAN/
9151 =head2 urllist parameter has CD-ROM support
9153 The C<urllist> parameter of the configuration table contains a list of
9154 URLs that are to be used for downloading. If the list contains any
9155 C<file> URLs, CPAN always tries to get files from there first. This
9156 feature is disabled for index files. So the recommendation for the
9157 owner of a CD-ROM with CPAN contents is: include your local, possibly
9158 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
9160 o conf urllist push file://localhost/CDROM/CPAN
9162 CPAN.pm will then fetch the index files from one of the CPAN sites
9163 that come at the beginning of urllist. It will later check for each
9164 module if there is a local copy of the most recent version.
9166 Another peculiarity of urllist is that the site that we could
9167 successfully fetch the last file from automatically gets a preference
9168 token and is tried as the first site for the next request. So if you
9169 add a new site at runtime it may happen that the previously preferred
9170 site will be tried another time. This means that if you want to disallow
9171 a site for the next transfer, it must be explicitly removed from
9174 =head2 prefs_dir for avoiding interactive questions (ALPHA)
9176 (B<Note:> This feature has been introduced in CPAN.pm 1.8854 and is
9177 still considered experimental and may still be changed)
9179 The files in the directory specified in C<prefs_dir> are YAML files
9180 that specify how CPAN.pm shall treat distributions that deviate from
9181 the normal non-interactive model of building and installing CPAN
9184 Some modules try to get some data from the user interactively thus
9185 disturbing the installation of large bundles like Phalanx100 or
9186 modules like Plagger.
9188 CPAN.pm can use YAML files to either pass additional arguments to one
9189 of the four commands, set environment variables or instantiate an
9190 Expect object that reads from the console and enters answers on your
9191 behalf (latter option requires Expect.pm installed). A further option
9192 is to apply patches from the local disk or from CPAN.
9194 CPAN.pm comes with a couple of such YAML files. The structure is
9195 currently not documented because in flux. Please see the distroprefs
9196 directory of the CPAN distribution for examples and follow the README
9199 Please note that setting the environment variable PERL_MM_USE_DEFAULT
9200 to a true value can also get you a long way if you want to always pick
9201 the default answers. But this only works if the author of a package
9202 used the prompt function provided by ExtUtils::MakeMaker and if the
9203 defaults are OK for you.
9207 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
9208 install foreign, unmasked, unsigned code on your machine. We compare
9209 to a checksum that comes from the net just as the distribution file
9210 itself. But we try to make it easy to add security on demand:
9212 =head2 Cryptographically signed modules
9214 Since release 1.77 CPAN.pm has been able to verify cryptographically
9215 signed module distributions using Module::Signature. The CPAN modules
9216 can be signed by their authors, thus giving more security. The simple
9217 unsigned MD5 checksums that were used before by CPAN protect mainly
9218 against accidental file corruption.
9220 You will need to have Module::Signature installed, which in turn
9221 requires that you have at least one of Crypt::OpenPGP module or the
9222 command-line F<gpg> tool installed.
9224 You will also need to be able to connect over the Internet to the public
9225 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
9227 The configuration parameter check_sigs is there to turn signature
9232 Most functions in package CPAN are exported per default. The reason
9233 for this is that the primary use is intended for the cpan shell or for
9238 When the CPAN shell enters a subshell via the look command, it sets
9239 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
9242 When the config variable ftp_passive is set, all downloads will be run
9243 with the environment variable FTP_PASSIVE set to this value. This is
9244 in general a good idea as it influences both Net::FTP and LWP based
9245 connections. The same effect can be achieved by starting the cpan
9246 shell with this environment variable set. For Net::FTP alone, one can
9247 also always set passive mode by running libnetcfg.
9249 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
9251 Populating a freshly installed perl with my favorite modules is pretty
9252 easy if you maintain a private bundle definition file. To get a useful
9253 blueprint of a bundle definition file, the command autobundle can be used
9254 on the CPAN shell command line. This command writes a bundle definition
9255 file for all modules that are installed for the currently running perl
9256 interpreter. It's recommended to run this command only once and from then
9257 on maintain the file manually under a private name, say
9258 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
9260 cpan> install Bundle::my_bundle
9262 then answer a few questions and then go out for a coffee.
9264 Maintaining a bundle definition file means keeping track of two
9265 things: dependencies and interactivity. CPAN.pm sometimes fails on
9266 calculating dependencies because not all modules define all MakeMaker
9267 attributes correctly, so a bundle definition file should specify
9268 prerequisites as early as possible. On the other hand, it's a bit
9269 annoying that many distributions need some interactive configuring. So
9270 what I try to accomplish in my private bundle file is to have the
9271 packages that need to be configured early in the file and the gentle
9272 ones later, so I can go out after a few minutes and leave CPAN.pm
9275 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
9277 Thanks to Graham Barr for contributing the following paragraphs about
9278 the interaction between perl, and various firewall configurations. For
9279 further information on firewalls, it is recommended to consult the
9280 documentation that comes with the ncftp program. If you are unable to
9281 go through the firewall with a simple Perl setup, it is very likely
9282 that you can configure ncftp so that it works for your firewall.
9284 =head2 Three basic types of firewalls
9286 Firewalls can be categorized into three basic types.
9292 This is where the firewall machine runs a web server and to access the
9293 outside world you must do it via the web server. If you set environment
9294 variables like http_proxy or ftp_proxy to a values beginning with http://
9295 or in your web browser you have to set proxy information then you know
9296 you are running an http firewall.
9298 To access servers outside these types of firewalls with perl (even for
9299 ftp) you will need to use LWP.
9303 This where the firewall machine runs an ftp server. This kind of
9304 firewall will only let you access ftp servers outside the firewall.
9305 This is usually done by connecting to the firewall with ftp, then
9306 entering a username like "user@outside.host.com"
9308 To access servers outside these type of firewalls with perl you
9309 will need to use Net::FTP.
9311 =item One way visibility
9313 I say one way visibility as these firewalls try to make themselves look
9314 invisible to the users inside the firewall. An FTP data connection is
9315 normally created by sending the remote server your IP address and then
9316 listening for the connection. But the remote server will not be able to
9317 connect to you because of the firewall. So for these types of firewall
9318 FTP connections need to be done in a passive mode.
9320 There are two that I can think off.
9326 If you are using a SOCKS firewall you will need to compile perl and link
9327 it with the SOCKS library, this is what is normally called a 'socksified'
9328 perl. With this executable you will be able to connect to servers outside
9329 the firewall as if it is not there.
9333 This is the firewall implemented in the Linux kernel, it allows you to
9334 hide a complete network behind one IP address. With this firewall no
9335 special compiling is needed as you can access hosts directly.
9337 For accessing ftp servers behind such firewalls you usually need to
9338 set the environment variable C<FTP_PASSIVE> or the config variable
9339 ftp_passive to a true value.
9345 =head2 Configuring lynx or ncftp for going through a firewall
9347 If you can go through your firewall with e.g. lynx, presumably with a
9350 /usr/local/bin/lynx -pscott:tiger
9352 then you would configure CPAN.pm with the command
9354 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
9356 That's all. Similarly for ncftp or ftp, you would configure something
9359 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
9361 Your mileage may vary...
9369 I installed a new version of module X but CPAN keeps saying,
9370 I have the old version installed
9372 Most probably you B<do> have the old version installed. This can
9373 happen if a module installs itself into a different directory in the
9374 @INC path than it was previously installed. This is not really a
9375 CPAN.pm problem, you would have the same problem when installing the
9376 module manually. The easiest way to prevent this behaviour is to add
9377 the argument C<UNINST=1> to the C<make install> call, and that is why
9378 many people add this argument permanently by configuring
9380 o conf make_install_arg UNINST=1
9384 So why is UNINST=1 not the default?
9386 Because there are people who have their precise expectations about who
9387 may install where in the @INC path and who uses which @INC array. In
9388 fine tuned environments C<UNINST=1> can cause damage.
9392 I want to clean up my mess, and install a new perl along with
9393 all modules I have. How do I go about it?
9395 Run the autobundle command for your old perl and optionally rename the
9396 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
9397 with the Configure option prefix, e.g.
9399 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
9401 Install the bundle file you produced in the first step with something like
9403 cpan> install Bundle::mybundle
9409 When I install bundles or multiple modules with one command
9410 there is too much output to keep track of.
9412 You may want to configure something like
9414 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
9415 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
9417 so that STDOUT is captured in a file for later inspection.
9422 I am not root, how can I install a module in a personal directory?
9424 First of all, you will want to use your own configuration, not the one
9425 that your root user installed. If you do not have permission to write
9426 in the cpan directory that root has configured, you will be asked if
9427 you want to create your own config. Answering "yes" will bring you into
9428 CPAN's configuration stage, using the system config for all defaults except
9429 things that have to do with CPAN's work directory, saving your choices to
9430 your MyConfig.pm file.
9432 You can also manually initiate this process with the following command:
9434 % perl -MCPAN -e 'mkmyconfig'
9440 from the CPAN shell.
9442 You will most probably also want to configure something like this:
9444 o conf makepl_arg "LIB=~/myperl/lib \
9445 INSTALLMAN1DIR=~/myperl/man/man1 \
9446 INSTALLMAN3DIR=~/myperl/man/man3"
9448 You can make this setting permanent like all C<o conf> settings with
9451 You will have to add ~/myperl/man to the MANPATH environment variable
9452 and also tell your perl programs to look into ~/myperl/lib, e.g. by
9455 use lib "$ENV{HOME}/myperl/lib";
9457 or setting the PERL5LIB environment variable.
9459 While we're speaking about $ENV{HOME}, it might be worth mentioning,
9460 that for Windows we use the File::HomeDir module that provides an
9461 equivalent to the concept of the home directory on Unix.
9463 Another thing you should bear in mind is that the UNINST parameter can
9464 be dnagerous when you are installing into a private area because you
9465 might accidentally remove modules that other people depend on that are
9466 not using the private area.
9470 How to get a package, unwrap it, and make a change before building it?
9472 Have a look at the C<look> (!) command.
9476 I installed a Bundle and had a couple of fails. When I
9477 retried, everything resolved nicely. Can this be fixed to work
9480 The reason for this is that CPAN does not know the dependencies of all
9481 modules when it starts out. To decide about the additional items to
9482 install, it just uses data found in the META.yml file or the generated
9483 Makefile. An undetected missing piece breaks the process. But it may
9484 well be that your Bundle installs some prerequisite later than some
9485 depending item and thus your second try is able to resolve everything.
9486 Please note, CPAN.pm does not know the dependency tree in advance and
9487 cannot sort the queue of things to install in a topologically correct
9488 order. It resolves perfectly well IF all modules declare the
9489 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
9490 the C<requires> stanza of Module::Build. For bundles which fail and
9491 you need to install often, it is recommended to sort the Bundle
9492 definition file manually.
9496 In our intranet we have many modules for internal use. How
9497 can I integrate these modules with CPAN.pm but without uploading
9498 the modules to CPAN?
9500 Have a look at the CPAN::Site module.
9504 When I run CPAN's shell, I get an error message about things in my
9505 /etc/inputrc (or ~/.inputrc) file.
9507 These are readline issues and can only be fixed by studying readline
9508 configuration on your architecture and adjusting the referenced file
9509 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
9510 and edit them. Quite often harmless changes like uppercasing or
9511 lowercasing some arguments solves the problem.
9515 Some authors have strange characters in their names.
9517 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
9518 expecting ISO-8859-1 charset, a converter can be activated by setting
9519 term_is_latin to a true value in your config file. One way of doing so
9522 cpan> o conf term_is_latin 1
9524 If other charset support is needed, please file a bugreport against
9525 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
9526 the support or maybe UTF-8 terminals become widely available.
9530 When an install fails for some reason and then I correct the error
9531 condition and retry, CPAN.pm refuses to install the module, saying
9532 C<Already tried without success>.
9534 Use the force pragma like so
9536 force install Foo::Bar
9538 This does a bit more than really needed because it untars the
9539 distribution again and runs make and test and only then install.
9541 Or, if you find this is too fast and you would prefer to do smaller
9546 first and then continue as always. C<Force get> I<forgets> previous
9553 and then 'make install' directly in the subshell.
9555 Or you leave the CPAN shell and start it again.
9557 For the really curious, by accessing internals directly, you I<could>
9559 !delete CPAN::Shell->expandany("Foo::Bar")->distribution->{install}
9561 but this is neither guaranteed to work in the future nor is it a
9566 How do I install a "DEVELOPER RELEASE" of a module?
9568 By default, CPAN will install the latest non-developer release of a
9569 module. If you want to install a dev release, you have to specify the
9570 partial path starting with the author id to the tarball you wish to
9573 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
9575 Note that you can use the C<ls> command to get this path listed.
9579 How do I install a module and all its dependencies from the commandline,
9580 without being prompted for anything, despite my CPAN configuration
9583 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
9584 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
9585 asked any questions at all (assuming the modules you are installing are
9586 nice about obeying that variable as well):
9588 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
9592 How do I create a Module::Build based Build.PL derived from an
9593 ExtUtils::MakeMaker focused Makefile.PL?
9595 http://search.cpan.org/search?query=Module::Build::Convert
9597 http://accognoscere.org/papers/perl-module-build-convert/module-build-convert.html
9604 Please report bugs via http://rt.cpan.org/
9606 Before submitting a bug, please make sure that the traditional method
9607 of building a Perl module package from a shell by following the
9608 installation instructions of that package still works in your
9611 =head1 SECURITY ADVICE
9613 This software enables you to upgrade software on your computer and so
9614 is inherently dangerous because the newly installed software may
9615 contain bugs and may alter the way your computer works or even make it
9616 unusable. Please consider backing up your data before every upgrade.
9620 Andreas Koenig C<< <andk@cpan.org> >>
9624 This program is free software; you can redistribute it and/or
9625 modify it under the same terms as Perl itself.
9627 See L<http://www.perl.com/perl/misc/Artistic.html>
9631 Kawai,Takanori provides a Japanese translation of this manpage at
9632 http://member.nifty.ne.jp/hippo2000/perltips/CPAN.htm
9636 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)