1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 $CPAN::VERSION = '1.88_54';
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";
61 use vars qw($VERSION @EXPORT $AUTOLOAD
62 $DEBUG $META $HAS_USABLE $term
64 $Signal $Suppress_readline $Frontend
65 @Defaultsites $Have_warned $Defaultdocs $Defaultrecent
70 @CPAN::ISA = qw(CPAN::Debug Exporter);
72 # note that these functions live in CPAN::Shell and get executed via
73 # AUTOLOAD when called directly
95 sub soft_chdir_with_alternatives ($);
98 $autoload_recursion ||= 0;
100 #-> sub CPAN::AUTOLOAD ;
102 $autoload_recursion++;
106 warn "Refusing to autoload '$l' while signal pending";
107 $autoload_recursion--;
110 if ($autoload_recursion > 1) {
111 my $fullcommand = join " ", map { "'$_'" } $l, @_;
112 warn "Refusing to autoload $fullcommand in recursion\n";
113 $autoload_recursion--;
117 @export{@EXPORT} = '';
118 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
119 if (exists $export{$l}){
122 die(qq{Unknown CPAN command "$AUTOLOAD". }.
123 qq{Type ? for help.\n});
125 $autoload_recursion--;
129 #-> sub CPAN::shell ;
132 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
133 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
135 my $oprompt = shift || CPAN::Prompt->new;
136 my $prompt = $oprompt;
137 my $commandline = shift || "";
138 $CPAN::CurrentCommandId ||= 1;
141 unless ($Suppress_readline) {
142 require Term::ReadLine;
145 $term->ReadLine eq "Term::ReadLine::Stub"
147 $term = Term::ReadLine->new('CPAN Monitor');
149 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
150 my $attribs = $term->Attribs;
151 $attribs->{attempted_completion_function} = sub {
152 &CPAN::Complete::gnu_cpl;
155 $readline::rl_completion_function =
156 $readline::rl_completion_function = 'CPAN::Complete::cpl';
158 if (my $histfile = $CPAN::Config->{'histfile'}) {{
159 unless ($term->can("AddHistory")) {
160 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
163 my($fh) = FileHandle->new;
164 open $fh, "<$histfile" or last;
168 $term->AddHistory($_);
172 for ($CPAN::Config->{term_ornaments}) { # alias
173 local $Term::ReadLine::termcap_nowarn = 1;
174 $term->ornaments($_) if defined;
176 # $term->OUT is autoflushed anyway
177 my $odef = select STDERR;
184 # no strict; # I do not recall why no strict was here (2000-09-03)
186 my @cwd = grep { defined $_ and length $_ }
188 File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
189 File::Spec->rootdir();
190 my $try_detect_readline;
191 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
192 my $rl_avail = $Suppress_readline ? "suppressed" :
193 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
194 "available (try 'install Bundle::CPAN')";
196 unless ($CPAN::Config->{'inhibit_startup_message'}){
197 $CPAN::Frontend->myprint(
199 cpan shell -- CPAN exploration and modules installation (v%s)
207 my($continuation) = "";
208 my $last_term_ornaments;
209 SHELLCOMMAND: while () {
210 if ($Suppress_readline) {
212 last SHELLCOMMAND unless defined ($_ = <> );
215 last SHELLCOMMAND unless
216 defined ($_ = $term->readline($prompt, $commandline));
218 $_ = "$continuation$_" if $continuation;
220 next SHELLCOMMAND if /^$/;
221 $_ = 'h' if /^\s*\?/;
222 if (/^(?:q(?:uit)?|bye|exit)$/i) {
233 use vars qw($import_done);
234 CPAN->import(':DEFAULT') unless $import_done++;
235 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
242 eval { @line = Text::ParseWords::shellwords($_) };
243 warn($@), next SHELLCOMMAND if $@;
244 warn("Text::Parsewords could not parse the line [$_]"),
245 next SHELLCOMMAND unless @line;
246 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
247 my $command = shift @line;
248 eval { CPAN::Shell->$command(@line) };
250 if ($command =~ /^(make|test|install|force|notest|clean|upgrade)$/) {
251 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
253 soft_chdir_with_alternatives(\@cwd);
254 $CPAN::Frontend->myprint("\n");
256 $CPAN::CurrentCommandId++;
260 $commandline = ""; # I do want to be able to pass a default to
261 # shell, but on the second command I see no
264 CPAN::Queue->nullify_queue;
265 if ($try_detect_readline) {
266 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
268 $CPAN::META->has_inst("Term::ReadLine::Perl")
270 delete $INC{"Term/ReadLine.pm"};
272 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
273 require Term::ReadLine;
274 $CPAN::Frontend->myprint("\n$redef subroutines in ".
275 "Term::ReadLine redefined\n");
279 if ($term and $term->can("ornaments")) {
280 for ($CPAN::Config->{term_ornaments}) { # alias
282 if (not defined $last_term_ornaments
283 or $_ != $last_term_ornaments
285 local $Term::ReadLine::termcap_nowarn = 1;
286 $term->ornaments($_);
287 $last_term_ornaments = $_;
290 undef $last_term_ornaments;
294 if ($CPAN::DEBUG && $CPAN::DEBUG & $CPAN::DEBUG{CPAN}) {
295 # debugging 'incommandcolor': should always be off at the end of a command
296 # (incommandcolor is used to detect recursive dependencies)
297 for my $class (qw(Module Distribution)) {
298 for my $dm (keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) {
299 next unless $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
300 CPAN->debug("BUG: $class '$dm' was in command state, resetting");
301 delete $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
306 $GOTOSHELL = 0; # not too often
307 $META->savehist if $CPAN::term && $CPAN::term->can("GetHistory");
312 soft_chdir_with_alternatives(\@cwd);
315 sub soft_chdir_with_alternatives ($) {
318 my $root = File::Spec->rootdir();
319 $CPAN::Frontend->mywarn(qq{Warning: no good directory to chdir to!
320 Trying '$root' as temporary haven.
325 if (chdir $cwd->[0]) {
329 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
330 Trying to chdir to "$cwd->[1]" instead.
334 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
340 # CPAN::_yaml_loadfile
342 my($self,$local_file) = @_;
343 my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
344 if ($CPAN::META->has_inst($yaml_module)) {
345 my $code = UNIVERSAL::can($yaml_module, "LoadFile");
347 eval { $yaml = $code->($local_file); };
349 $CPAN::Frontend->mydie("Alert: While trying to parse YAML file\n".
351 "with $yaml_module the following error was encountered:\n".
357 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot parse '$local_file'\n");
362 package CPAN::CacheMgr;
364 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
369 use vars qw($Ua $Thesite $ThesiteURL $Themethod);
370 @CPAN::FTP::ISA = qw(CPAN::Debug);
372 package CPAN::LWP::UserAgent;
374 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
375 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
377 package CPAN::Complete;
379 @CPAN::Complete::ISA = qw(CPAN::Debug);
380 @CPAN::Complete::COMMANDS = sort qw(
381 ! a b d h i m o q r u
405 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03);
406 @CPAN::Index::ISA = qw(CPAN::Debug);
409 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
412 package CPAN::InfoObj;
414 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
416 package CPAN::Author;
418 @CPAN::Author::ISA = qw(CPAN::InfoObj);
420 package CPAN::Distribution;
422 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
424 package CPAN::Bundle;
426 @CPAN::Bundle::ISA = qw(CPAN::Module);
428 package CPAN::Module;
430 @CPAN::Module::ISA = qw(CPAN::InfoObj);
432 package CPAN::Exception::RecursiveDependency;
434 use overload '""' => "as_string";
441 for my $dep (@$deps) {
443 last if $seen{$dep}++;
445 bless { deps => \@deps }, $class;
450 "\nRecursive dependency detected:\n " .
451 join("\n => ", @{$self->{deps}}) .
452 ".\nCannot continue.\n";
455 package CPAN::Prompt; use overload '""' => "as_string";
456 use vars qw($prompt);
458 $CPAN::CurrentCommandId ||= 0;
463 if ($CPAN::Config->{commandnumber_in_prompt}) {
464 sprintf "cpan[%d]> ", $CPAN::CurrentCommandId;
470 package CPAN::URL; use overload '""' => "as_string", fallback => 1;
471 # accessors: TEXT(the url string), FROM(DEF=>defaultlist,USER=>urllist),
472 # planned are things like age or quality
474 my($class,%args) = @_;
486 $self->{TEXT} = $set;
491 package CPAN::Distrostatus;
492 use overload '""' => "as_string",
495 my($class,$arg) = @_;
498 FAILED => substr($arg,0,2) eq "NO",
499 COMMANDID => $CPAN::CurrentCommandId,
502 sub commandid { shift->{COMMANDID} }
503 sub failed { shift->{FAILED} }
507 $self->{TEXT} = $set;
526 @CPAN::Shell::ISA = qw(CPAN::Debug);
527 $COLOR_REGISTERED ||= 0;
530 # $GLOBAL_AUTOLOAD_RECURSION = 12;
531 $autoload_recursion ||= 0;
533 #-> sub CPAN::Shell::AUTOLOAD ;
535 $autoload_recursion++;
537 my $class = shift(@_);
538 # warn "autoload[$l] class[$class]";
541 warn "Refusing to autoload '$l' while signal pending";
542 $autoload_recursion--;
545 if ($autoload_recursion > 1) {
546 my $fullcommand = join " ", map { "'$_'" } $l, @_;
547 warn "Refusing to autoload $fullcommand in recursion\n";
548 $autoload_recursion--;
552 # XXX needs to be reconsidered
553 if ($CPAN::META->has_inst('CPAN::WAIT')) {
556 $CPAN::Frontend->mywarn(qq{
557 Commands starting with "w" require CPAN::WAIT to be installed.
558 Please consider installing CPAN::WAIT to use the fulltext index.
559 For this you just need to type
564 $CPAN::Frontend->mywarn(qq{Unknown shell command '$l'. }.
568 $autoload_recursion--;
575 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
577 # from here on only subs.
578 ################################################################################
580 sub suggest_myconfig () {
581 SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
582 $CPAN::Frontend->myprint("You don't seem to have a user ".
583 "configuration (MyConfig.pm) yet.\n");
584 my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ".
585 "user configuration now? (Y/n)",
588 CPAN::Shell->mkmyconfig();
591 $CPAN::Frontend->mydie("OK, giving up.");
596 #-> sub CPAN::all_objects ;
598 my($mgr,$class) = @_;
599 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
600 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
602 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
605 # Called by shell, not in batch mode. In batch mode I see no risk in
606 # having many processes updating something as installations are
607 # continually checked at runtime. In shell mode I suspect it is
608 # unintentional to open more than one shell at a time
610 #-> sub CPAN::checklock ;
613 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
614 if (-f $lockfile && -M _ > 0) {
615 my $fh = FileHandle->new($lockfile) or
616 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
617 my $otherpid = <$fh>;
618 my $otherhost = <$fh>;
620 if (defined $otherpid && $otherpid) {
623 if (defined $otherhost && $otherhost) {
626 my $thishost = hostname();
627 if (defined $otherhost && defined $thishost &&
628 $otherhost ne '' && $thishost ne '' &&
629 $otherhost ne $thishost) {
630 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
631 "reports other host $otherhost and other ".
632 "process $otherpid.\n".
633 "Cannot proceed.\n"));
635 elsif (defined $otherpid && $otherpid) {
636 return if $$ == $otherpid; # should never happen
637 $CPAN::Frontend->mywarn(
639 There seems to be running another CPAN process (pid $otherpid). Contacting...
641 if (kill 0, $otherpid) {
642 $CPAN::Frontend->mydie(qq{Other job is running.
643 You may want to kill it and delete the lockfile, maybe. On UNIX try:
647 } elsif (-w $lockfile) {
649 CPAN::Shell::colorable_makemaker_prompt
650 (qq{Other job not responding. Shall I overwrite }.
651 qq{the lockfile '$lockfile'? (Y/n)},"y");
652 $CPAN::Frontend->myexit("Ok, bye\n")
653 unless $ans =~ /^y/i;
656 qq{Lockfile '$lockfile' not writeable by you. }.
657 qq{Cannot proceed.\n}.
659 qq{ rm '$lockfile'\n}.
660 qq{ and then rerun us.\n}
664 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
665 "reports other process with ID ".
666 "$otherpid. Cannot proceed.\n"));
669 my $dotcpan = $CPAN::Config->{cpan_home};
670 eval { File::Path::mkpath($dotcpan);};
672 # A special case at least for Jarkko.
677 $symlinkcpan = readlink $dotcpan;
678 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
679 eval { File::Path::mkpath($symlinkcpan); };
683 $CPAN::Frontend->mywarn(qq{
684 Working directory $symlinkcpan created.
688 unless (-d $dotcpan) {
690 Your configuration suggests "$dotcpan" as your
691 CPAN.pm working directory. I could not create this directory due
692 to this error: $firsterror\n};
694 As "$dotcpan" is a symlink to "$symlinkcpan",
695 I tried to create that, but I failed with this error: $seconderror
698 Please make sure the directory exists and is writable.
700 $CPAN::Frontend->myprint($mess);
701 return suggest_myconfig;
703 } # $@ after eval mkpath $dotcpan
705 unless ($fh = FileHandle->new(">$lockfile")) {
706 if ($! =~ /Permission/) {
707 $CPAN::Frontend->myprint(qq{
709 Your configuration suggests that CPAN.pm should use a working
711 $CPAN::Config->{cpan_home}
712 Unfortunately we could not create the lock file
714 due to permission problems.
716 Please make sure that the configuration variable
717 \$CPAN::Config->{cpan_home}
718 points to a directory where you can write a .lock file. You can set
719 this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
722 return suggest_myconfig;
725 $fh->print($$, "\n");
726 $fh->print(hostname(), "\n");
727 $self->{LOCK} = $lockfile;
732 $CPAN::Frontend->mydie("Got SIG$sig, leaving");
738 die "Got yet another signal" if $Signal > 1;
739 $CPAN::Frontend->mydie("Got another SIG$sig") if $Signal;
740 $CPAN::Frontend->mywarn("Caught SIG$sig, trying to continue\n");
744 # From: Larry Wall <larry@wall.org>
745 # Subject: Re: deprecating SIGDIE
746 # To: perl5-porters@perl.org
747 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
749 # The original intent of __DIE__ was only to allow you to substitute one
750 # kind of death for another on an application-wide basis without respect
751 # to whether you were in an eval or not. As a global backstop, it should
752 # not be used any more lightly (or any more heavily :-) than class
753 # UNIVERSAL. Any attempt to build a general exception model on it should
754 # be politely squashed. Any bug that causes every eval {} to have to be
755 # modified should be not so politely squashed.
757 # Those are my current opinions. It is also my optinion that polite
758 # arguments degenerate to personal arguments far too frequently, and that
759 # when they do, it's because both people wanted it to, or at least didn't
760 # sufficiently want it not to.
764 # global backstop to cleanup if we should really die
765 $SIG{__DIE__} = \&cleanup;
766 $self->debug("Signal handler set.") if $CPAN::DEBUG;
769 #-> sub CPAN::DESTROY ;
771 &cleanup; # need an eval?
774 #-> sub CPAN::anycwd ;
777 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
782 sub cwd {Cwd::cwd();}
784 #-> sub CPAN::getcwd ;
785 sub getcwd {Cwd::getcwd();}
787 #-> sub CPAN::fastcwd ;
788 sub fastcwd {Cwd::fastcwd();}
790 #-> sub CPAN::backtickcwd ;
791 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
793 #-> sub CPAN::find_perl ;
795 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
796 my $pwd = $CPAN::iCwd = CPAN::anycwd();
797 my $candidate = File::Spec->catfile($pwd,$^X);
798 $perl ||= $candidate if MM->maybe_command($candidate);
801 my ($component,$perl_name);
802 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
803 PATH_COMPONENT: foreach $component (File::Spec->path(),
804 $Config::Config{'binexp'}) {
805 next unless defined($component) && $component;
806 my($abs) = File::Spec->catfile($component,$perl_name);
807 if (MM->maybe_command($abs)) {
819 #-> sub CPAN::exists ;
821 my($mgr,$class,$id) = @_;
822 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
824 ### Carp::croak "exists called without class argument" unless $class;
826 $id =~ s/:+/::/g if $class eq "CPAN::Module";
827 exists $META->{readonly}{$class}{$id} or
828 exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
831 #-> sub CPAN::delete ;
833 my($mgr,$class,$id) = @_;
834 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
835 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
838 #-> sub CPAN::has_usable
839 # has_inst is sometimes too optimistic, we should replace it with this
840 # has_usable whenever a case is given
842 my($self,$mod,$message) = @_;
843 return 1 if $HAS_USABLE->{$mod};
844 my $has_inst = $self->has_inst($mod,$message);
845 return unless $has_inst;
848 LWP => [ # we frequently had "Can't locate object
849 # method "new" via package "LWP::UserAgent" at
850 # (eval 69) line 2006
852 sub {require LWP::UserAgent},
853 sub {require HTTP::Request},
854 sub {require URI::URL},
857 sub {require Net::FTP},
858 sub {require Net::Config},
861 sub {require File::HomeDir;
862 unless (File::HomeDir->VERSION >= 0.52){
863 for ("Will not use File::HomeDir, need 0.52\n") {
864 $CPAN::Frontend->mywarn($_);
871 if ($usable->{$mod}) {
872 for my $c (0..$#{$usable->{$mod}}) {
873 my $code = $usable->{$mod}[$c];
874 my $ret = eval { &$code() };
875 $ret = "" unless defined $ret;
877 # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
882 return $HAS_USABLE->{$mod} = 1;
885 #-> sub CPAN::has_inst
887 my($self,$mod,$message) = @_;
888 Carp::croak("CPAN->has_inst() called without an argument")
890 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
891 keys %{$CPAN::Config->{dontload_hash}||{}},
892 @{$CPAN::Config->{dontload_list}||[]};
893 if (defined $message && $message eq "no" # afair only used by Nox
897 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
905 # checking %INC is wrong, because $INC{LWP} may be true
906 # although $INC{"URI/URL.pm"} may have failed. But as
907 # I really want to say "bla loaded OK", I have to somehow
909 ### warn "$file in %INC"; #debug
911 } elsif (eval { require $file }) {
912 # eval is good: if we haven't yet read the database it's
913 # perfect and if we have installed the module in the meantime,
914 # it tries again. The second require is only a NOOP returning
915 # 1 if we had success, otherwise it's retrying
917 my $v = eval "\$$mod\::VERSION";
918 $v = $v ? " (v$v)" : "";
919 $CPAN::Frontend->myprint("CPAN: $mod loaded ok$v\n");
920 if ($mod eq "CPAN::WAIT") {
921 push @CPAN::Shell::ISA, 'CPAN::WAIT';
924 } elsif ($mod eq "Net::FTP") {
925 $CPAN::Frontend->mywarn(qq{
926 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
928 install Bundle::libnet
930 }) unless $Have_warned->{"Net::FTP"}++;
931 $CPAN::Frontend->mysleep(3);
932 } elsif ($mod eq "Digest::SHA"){
933 if ($Have_warned->{"Digest::SHA"}++) {
934 $CPAN::Frontend->myprint(qq{CPAN: checksum security checks disabled}.
935 qq{because Digest::SHA not installed.\n});
937 $CPAN::Frontend->mywarn(qq{
938 CPAN: checksum security checks disabled because Digest::SHA not installed.
939 Please consider installing the Digest::SHA module.
942 $CPAN::Frontend->mysleep(2);
944 } elsif ($mod eq "Module::Signature"){
945 if (not $CPAN::Config->{check_sigs}) {
946 # they do not want us:-(
947 } elsif (not $Have_warned->{"Module::Signature"}++) {
948 # No point in complaining unless the user can
949 # reasonably install and use it.
950 if (eval { require Crypt::OpenPGP; 1 } ||
952 defined $CPAN::Config->{'gpg'}
954 $CPAN::Config->{'gpg'} =~ /\S/
957 $CPAN::Frontend->mywarn(qq{
958 CPAN: Module::Signature security checks disabled because Module::Signature
959 not installed. Please consider installing the Module::Signature module.
960 You may also need to be able to connect over the Internet to the public
961 keyservers like pgp.mit.edu (port 11371).
964 $CPAN::Frontend->mysleep(2);
968 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
973 #-> sub CPAN::instance ;
975 my($mgr,$class,$id) = @_;
978 # unsafe meta access, ok?
979 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
980 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
988 #-> sub CPAN::cleanup ;
990 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
991 local $SIG{__DIE__} = '';
996 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
998 $subroutine eq '(eval)';
1000 return if $ineval && !$CPAN::End;
1001 return unless defined $META->{LOCK};
1002 return unless -f $META->{LOCK};
1004 unlink $META->{LOCK};
1006 # Carp::cluck("DEBUGGING");
1007 $CPAN::Frontend->myprint("Lockfile removed.\n");
1010 #-> sub CPAN::savehist
1013 my($histfile,$histsize);
1014 unless ($histfile = $CPAN::Config->{'histfile'}){
1015 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
1018 $histsize = $CPAN::Config->{'histsize'} || 100;
1020 unless ($CPAN::term->can("GetHistory")) {
1021 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
1027 my @h = $CPAN::term->GetHistory;
1028 splice @h, 0, @h-$histsize if @h>$histsize;
1029 my($fh) = FileHandle->new;
1030 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
1031 local $\ = local $, = "\n";
1037 my($self,$what) = @_;
1038 $self->{is_tested}{$what} = 1;
1041 # unsets the is_tested flag: as soon as the thing is installed, it is
1042 # not needed in set_perl5lib anymore
1044 my($self,$what) = @_;
1045 delete $self->{is_tested}{$what};
1050 $self->{is_tested} ||= {};
1051 return unless %{$self->{is_tested}};
1052 my $env = $ENV{PERL5LIB};
1053 $env = $ENV{PERLLIB} unless defined $env;
1055 push @env, $env if defined $env and length $env;
1056 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1057 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1058 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1061 package CPAN::CacheMgr;
1064 #-> sub CPAN::CacheMgr::as_string ;
1066 eval { require Data::Dumper };
1068 return shift->SUPER::as_string;
1070 return Data::Dumper::Dumper(shift);
1074 #-> sub CPAN::CacheMgr::cachesize ;
1079 #-> sub CPAN::CacheMgr::tidyup ;
1082 return unless -d $self->{ID};
1083 while ($self->{DU} > $self->{'MAX'} ) {
1084 my($toremove) = shift @{$self->{FIFO}};
1085 $CPAN::Frontend->myprint(sprintf(
1086 "Deleting from cache".
1087 ": $toremove (%.1f>%.1f MB)\n",
1088 $self->{DU}, $self->{'MAX'})
1090 return if $CPAN::Signal;
1091 $self->force_clean_cache($toremove);
1092 return if $CPAN::Signal;
1096 #-> sub CPAN::CacheMgr::dir ;
1101 #-> sub CPAN::CacheMgr::entries ;
1103 my($self,$dir) = @_;
1104 return unless defined $dir;
1105 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1106 $dir ||= $self->{ID};
1107 my($cwd) = CPAN::anycwd();
1108 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1109 my $dh = DirHandle->new(File::Spec->curdir)
1110 or Carp::croak("Couldn't opendir $dir: $!");
1113 next if $_ eq "." || $_ eq "..";
1115 push @entries, File::Spec->catfile($dir,$_);
1117 push @entries, File::Spec->catdir($dir,$_);
1119 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1122 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1123 sort { -M $b <=> -M $a} @entries;
1126 #-> sub CPAN::CacheMgr::disk_usage ;
1128 my($self,$dir) = @_;
1129 return if exists $self->{SIZE}{$dir};
1130 return if $CPAN::Signal;
1134 unless (chmod 0755, $dir) {
1135 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1136 "permission to change the permission; cannot ".
1137 "estimate disk usage of '$dir'\n");
1138 $CPAN::Frontend->mysleep(5);
1143 $CPAN::Frontend->mywarn("Directory '$dir' has gone. Cannot continue.\n");
1148 $File::Find::prune++ if $CPAN::Signal;
1150 if ($^O eq 'MacOS') {
1152 my $cat = Mac::Files::FSpGetCatInfo($_);
1153 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1157 unless (chmod 0755, $_) {
1158 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1159 "the permission to change the permission; ".
1160 "can only partially estimate disk usage ".
1162 $CPAN::Frontend->mysleep(5);
1173 return if $CPAN::Signal;
1174 $self->{SIZE}{$dir} = $Du/1024/1024;
1175 push @{$self->{FIFO}}, $dir;
1176 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1177 $self->{DU} += $Du/1024/1024;
1181 #-> sub CPAN::CacheMgr::force_clean_cache ;
1182 sub force_clean_cache {
1183 my($self,$dir) = @_;
1184 return unless -e $dir;
1185 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1187 File::Path::rmtree($dir);
1188 $self->{DU} -= $self->{SIZE}{$dir};
1189 delete $self->{SIZE}{$dir};
1192 #-> sub CPAN::CacheMgr::new ;
1199 ID => $CPAN::Config->{'build_dir'},
1200 MAX => $CPAN::Config->{'build_cache'},
1201 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1204 File::Path::mkpath($self->{ID});
1205 my $dh = DirHandle->new($self->{ID});
1206 bless $self, $class;
1209 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1211 CPAN->debug($debug) if $CPAN::DEBUG;
1215 #-> sub CPAN::CacheMgr::scan_cache ;
1218 return if $self->{SCAN} eq 'never';
1219 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1220 unless $self->{SCAN} eq 'atstart';
1221 $CPAN::Frontend->myprint(
1222 sprintf("Scanning cache %s for sizes\n",
1225 for $e ($self->entries($self->{ID})) {
1226 next if $e eq ".." || $e eq ".";
1227 $self->disk_usage($e);
1228 return if $CPAN::Signal;
1233 package CPAN::Shell;
1236 #-> sub CPAN::Shell::h ;
1238 my($class,$about) = @_;
1239 if (defined $about) {
1240 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1242 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1243 $CPAN::Frontend->myprint(qq{
1244 Display Information $filler (ver $CPAN::VERSION)
1245 command argument description
1246 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1247 i WORD or /REGEXP/ about any of the above
1248 ls AUTHOR or GLOB about files in the author's directory
1249 (with WORD being a module, bundle or author name or a distribution
1250 name of the form AUTHOR/DISTRIBUTION)
1252 Download, Test, Make, Install...
1253 get download clean make clean
1254 make make (implies get) look open subshell in dist directory
1255 test make test (implies make) readme display these README files
1256 install make install (implies test) perldoc display POD documentation
1259 r WORDs or /REGEXP/ or NONE report updates for some/matching/all modules
1260 upgrade WORDs or /REGEXP/ or NONE upgrade some/matching/all modules
1263 force COMMAND unconditionally do command
1264 notest COMMAND skip testing
1267 h,? display this menu ! perl-code eval a perl command
1268 o conf [opt] set and query options q quit the cpan shell
1269 reload cpan load CPAN.pm again reload index load newer indices
1270 autobundle Snapshot recent latest CPAN uploads});
1276 #-> sub CPAN::Shell::a ;
1278 my($self,@arg) = @_;
1279 # authors are always UPPERCASE
1281 $_ = uc $_ unless /=/;
1283 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1286 #-> sub CPAN::Shell::globls ;
1288 my($self,$s,$pragmas) = @_;
1289 # ls is really very different, but we had it once as an ordinary
1290 # command in the Shell (upto rev. 321) and we could not handle
1292 my(@accept,@preexpand);
1293 if ($s =~ /[\*\?\/]/) {
1294 if ($CPAN::META->has_inst("Text::Glob")) {
1295 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1296 my $rau = Text::Glob::glob_to_regex(uc $au);
1297 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1299 push @preexpand, map { $_->id . "/" . $pathglob }
1300 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1302 my $rau = Text::Glob::glob_to_regex(uc $s);
1303 push @preexpand, map { $_->id }
1304 CPAN::Shell->expand_by_method('CPAN::Author',
1309 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1312 push @preexpand, uc $s;
1315 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1316 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1321 my $silent = @accept>1;
1322 my $last_alpha = "";
1324 for my $a (@accept){
1325 my($author,$pathglob);
1326 if ($a =~ m|(.*?)/(.*)|) {
1329 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1331 $a2) or die "No author found for $a2";
1333 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1335 $a) or die "No author found for $a";
1338 my $alpha = substr $author->id, 0, 1;
1340 if ($alpha eq $last_alpha) {
1344 $last_alpha = $alpha;
1346 $CPAN::Frontend->myprint($ad);
1348 for my $pragma (@$pragmas) {
1349 if ($author->can($pragma)) {
1353 push @results, $author->ls($pathglob,$silent); # silent if
1356 for my $pragma (@$pragmas) {
1357 my $meth = "un$pragma";
1358 if ($author->can($meth)) {
1366 #-> sub CPAN::Shell::local_bundles ;
1368 my($self,@which) = @_;
1369 my($incdir,$bdir,$dh);
1370 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1371 my @bbase = "Bundle";
1372 while (my $bbase = shift @bbase) {
1373 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1374 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1375 if ($dh = DirHandle->new($bdir)) { # may fail
1377 for $entry ($dh->read) {
1378 next if $entry =~ /^\./;
1379 next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
1380 if (-d File::Spec->catdir($bdir,$entry)){
1381 push @bbase, "$bbase\::$entry";
1383 next unless $entry =~ s/\.pm(?!\n)\Z//;
1384 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1392 #-> sub CPAN::Shell::b ;
1394 my($self,@which) = @_;
1395 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1396 $self->local_bundles;
1397 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1400 #-> sub CPAN::Shell::d ;
1401 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1403 #-> sub CPAN::Shell::m ;
1404 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1406 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1409 #-> sub CPAN::Shell::i ;
1413 @args = '/./' unless @args;
1415 for my $type (qw/Bundle Distribution Module/) {
1416 push @result, $self->expand($type,@args);
1418 # Authors are always uppercase.
1419 push @result, $self->expand("Author", map { uc $_ } @args);
1421 my $result = @result == 1 ?
1422 $result[0]->as_string :
1424 "No objects found of any type for argument @args\n" :
1426 (map {$_->as_glimpse} @result),
1427 scalar @result, " items found\n",
1429 $CPAN::Frontend->myprint($result);
1432 #-> sub CPAN::Shell::o ;
1434 # CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o
1435 # conf' calls through to CPAN::HandleConfig::edit. 'o conf' should
1436 # probably have been called 'set' and 'o debug' maybe 'set debug' or
1437 # 'debug'; 'o conf ARGS' calls ->edit in CPAN/HandleConfig.pm
1439 my($self,$o_type,@o_what) = @_;
1442 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1443 if ($o_type eq 'conf') {
1444 if (!@o_what) { # print all things, "o conf"
1446 $CPAN::Frontend->myprint("\$CPAN::Config options from ");
1448 if (exists $INC{'CPAN/Config.pm'}) {
1449 push @from, $INC{'CPAN/Config.pm'};
1451 if (exists $INC{'CPAN/MyConfig.pm'}) {
1452 push @from, $INC{'CPAN/MyConfig.pm'};
1454 $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
1455 $CPAN::Frontend->myprint(":\n");
1456 for $k (sort keys %CPAN::HandleConfig::can) {
1457 $v = $CPAN::HandleConfig::can{$k};
1458 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
1460 $CPAN::Frontend->myprint("\n");
1461 for $k (sort keys %$CPAN::Config) {
1462 CPAN::HandleConfig->prettyprint($k);
1464 $CPAN::Frontend->myprint("\n");
1465 } elsif (!CPAN::HandleConfig->edit(@o_what)) {
1466 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
1469 } elsif ($o_type eq 'debug') {
1471 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1474 my($what) = shift @o_what;
1475 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1476 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1479 if ( exists $CPAN::DEBUG{$what} ) {
1480 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1481 } elsif ($what =~ /^\d/) {
1482 $CPAN::DEBUG = $what;
1483 } elsif (lc $what eq 'all') {
1485 for (values %CPAN::DEBUG) {
1488 $CPAN::DEBUG = $max;
1491 for (keys %CPAN::DEBUG) {
1492 next unless lc($_) eq lc($what);
1493 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1496 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1501 my $raw = "Valid options for debug are ".
1502 join(", ",sort(keys %CPAN::DEBUG), 'all').
1503 qq{ or a number. Completion works on the options. }.
1504 qq{Case is ignored.};
1506 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1507 $CPAN::Frontend->myprint("\n\n");
1510 $CPAN::Frontend->myprint("Options set for debugging ($CPAN::DEBUG):\n");
1512 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1513 $v = $CPAN::DEBUG{$k};
1514 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1515 if $v & $CPAN::DEBUG;
1518 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1521 $CPAN::Frontend->myprint(qq{
1523 conf set or get configuration variables
1524 debug set or get debugging options
1529 # CPAN::Shell::paintdots_onreload
1530 sub paintdots_onreload {
1533 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
1537 # $CPAN::Frontend->myprint(".($subr)");
1538 $CPAN::Frontend->myprint(".");
1539 if ($subr =~ /\bshell\b/i) {
1540 # warn "debug[$_[0]]";
1542 # It would be nice if we could detect that a
1543 # subroutine has actually changed, but for now we
1544 # practically always set the GOTOSHELL global
1554 #-> sub CPAN::Shell::reload ;
1556 my($self,$command,@arg) = @_;
1558 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1559 if ($command =~ /^cpan$/i) {
1561 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
1565 "CPAN/HandleConfig.pm",
1566 "CPAN/FirstTime.pm",
1573 MFILE: for my $f (@relo) {
1574 next unless exists $INC{$f};
1578 $CPAN::Frontend->myprint("($p");
1579 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
1580 $self->reload_this($f) or $failed++;
1581 my $v = eval "$p\::->VERSION";
1582 $CPAN::Frontend->myprint("v$v)");
1584 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1586 my $errors = $failed == 1 ? "error" : "errors";
1587 $CPAN::Frontend->mywarn("\n$failed $errors during reload. You better quit ".
1590 } elsif ($command =~ /^index$/i) {
1591 CPAN::Index->force_reload;
1593 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN modules
1594 index re-reads the index files\n});
1598 # reload means only load again what we have loaded before
1599 #-> sub CPAN::Shell::reload_this ;
1601 my($self,$f,$args) = @_;
1602 CPAN->debug("f[$f]") if $CPAN::DEBUG;
1603 return 1 unless $INC{$f}; # we never loaded this, so we do not
1605 my $pwd = CPAN::anycwd();
1606 CPAN->debug("pwd[$pwd]") if $CPAN::DEBUG;
1608 for my $inc (@INC) {
1609 $file = File::Spec->catfile($inc,split /\//, $f);
1613 CPAN->debug("file[$file]") if $CPAN::DEBUG;
1615 unless ($file && -f $file) {
1616 # this thingie is not in the INC path, maybe CPAN/MyConfig.pm?
1618 @inc = substr($file,0,-length($f)); # bring in back to me!
1620 CPAN->debug("file[$file]inc[@inc]") if $CPAN::DEBUG;
1622 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
1625 my $mtime = (stat $file)[9];
1626 $reload->{$f} ||= $^T;
1627 my $must_reload = $mtime > $reload->{$f};
1629 $must_reload ||= $args->{force};
1631 my $fh = FileHandle->new($file) or
1632 $CPAN::Frontend->mydie("Could not open $file: $!");
1635 my $content = <$fh>;
1636 CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128)))
1640 eval "require '$f'";
1645 $reload->{$f} = time;
1647 $CPAN::Frontend->myprint("__unchanged__");
1652 #-> sub CPAN::Shell::mkmyconfig ;
1654 my($self, $cpanpm, %args) = @_;
1655 require CPAN::FirstTime;
1656 my $home = CPAN::HandleConfig::home;
1657 $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
1658 File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
1659 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
1660 CPAN::HandleConfig::require_myconfig_or_config;
1661 $CPAN::Config ||= {};
1666 keep_source_where => undef,
1669 CPAN::FirstTime::init($cpanpm, %args);
1672 #-> sub CPAN::Shell::_binary_extensions ;
1673 sub _binary_extensions {
1674 my($self) = shift @_;
1675 my(@result,$module,%seen,%need,$headerdone);
1676 for $module ($self->expand('Module','/./')) {
1677 my $file = $module->cpan_file;
1678 next if $file eq "N/A";
1679 next if $file =~ /^Contact Author/;
1680 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
1681 next if $dist->isa_perl;
1682 next unless $module->xs_file;
1684 $CPAN::Frontend->myprint(".");
1685 push @result, $module;
1687 # print join " | ", @result;
1688 $CPAN::Frontend->myprint("\n");
1692 #-> sub CPAN::Shell::recompile ;
1694 my($self) = shift @_;
1695 my($module,@module,$cpan_file,%dist);
1696 @module = $self->_binary_extensions();
1697 for $module (@module){ # we force now and compile later, so we
1699 $cpan_file = $module->cpan_file;
1700 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1702 $dist{$cpan_file}++;
1704 for $cpan_file (sort keys %dist) {
1705 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1706 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1708 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1709 # stop a package from recompiling,
1710 # e.g. IO-1.12 when we have perl5.003_10
1714 #-> sub CPAN::Shell::scripts ;
1716 my($self, $arg) = @_;
1717 $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n");
1719 for my $req (qw( HTML::LinkExtor Sort::Versions List::Util )) {
1720 unless ($CPAN::META->has_inst($req)) {
1721 $CPAN::Frontend->mywarn(" $req not available\n");
1724 my $p = HTML::LinkExtor->new();
1725 my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html";
1726 unless (-f $indexfile) {
1727 $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n");
1729 $p->parse_file($indexfile);
1732 if ($arg =~ s|^/(.+)/$|$1|) {
1733 $qrarg = eval 'qr/$arg/'; # hide construct from 5.004
1735 for my $l ($p->links) {
1736 my $tag = shift @$l;
1737 next unless $tag eq "a";
1739 my $href = $att{href};
1740 next unless $href =~ s|^\.\./authors/id/./../||;
1743 if ($href =~ $qrarg) {
1747 if ($href =~ /\Q$arg\E/) {
1755 # now filter for the latest version if there is more than one of a name
1761 $stems{$stem} ||= [];
1762 push @{$stems{$stem}}, $href;
1764 for (sort keys %stems) {
1766 if (@{$stems{$_}} > 1) {
1767 $highest = List::Util::reduce {
1768 Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b
1771 $highest = $stems{$_}[0];
1773 $CPAN::Frontend->myprint("$highest\n");
1777 #-> sub CPAN::Shell::upgrade ;
1779 my($self,@args) = @_;
1780 $self->install($self->r(@args));
1783 #-> sub CPAN::Shell::_u_r_common ;
1785 my($self) = shift @_;
1786 my($what) = shift @_;
1787 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1788 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
1789 $what && $what =~ /^[aru]$/;
1791 @args = '/./' unless @args;
1792 my(@result,$module,%seen,%need,$headerdone,
1793 $version_undefs,$version_zeroes);
1794 $version_undefs = $version_zeroes = 0;
1795 my $sprintf = "%s%-25s%s %9s %9s %s\n";
1796 my @expand = $self->expand('Module',@args);
1797 my $expand = scalar @expand;
1798 if (0) { # Looks like noise to me, was very useful for debugging
1799 # for metadata cache
1800 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
1802 MODULE: for $module (@expand) {
1803 my $file = $module->cpan_file;
1804 next MODULE unless defined $file; # ??
1805 $file =~ s|^./../||;
1806 my($latest) = $module->cpan_version;
1807 my($inst_file) = $module->inst_file;
1809 return if $CPAN::Signal;
1812 $have = $module->inst_version;
1813 } elsif ($what eq "r") {
1814 $have = $module->inst_version;
1816 if ($have eq "undef"){
1818 } elsif ($have == 0){
1821 next MODULE unless CPAN::Version->vgt($latest, $have);
1822 # to be pedantic we should probably say:
1823 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
1824 # to catch the case where CPAN has a version 0 and we have a version undef
1825 } elsif ($what eq "u") {
1831 } elsif ($what eq "r") {
1833 } elsif ($what eq "u") {
1837 return if $CPAN::Signal; # this is sometimes lengthy
1840 push @result, sprintf "%s %s\n", $module->id, $have;
1841 } elsif ($what eq "r") {
1842 push @result, $module->id;
1843 next MODULE if $seen{$file}++;
1844 } elsif ($what eq "u") {
1845 push @result, $module->id;
1846 next MODULE if $seen{$file}++;
1847 next MODULE if $file =~ /^Contact/;
1849 unless ($headerdone++){
1850 $CPAN::Frontend->myprint("\n");
1851 $CPAN::Frontend->myprint(sprintf(
1854 "Package namespace",
1863 # $GLOBAL_AUTOLOAD_RECURSION = 12;
1867 $CPAN::META->has_inst("Term::ANSIColor")
1869 $module->description
1871 $color_on = Term::ANSIColor::color("green");
1872 $color_off = Term::ANSIColor::color("reset");
1874 $CPAN::Frontend->myprint(sprintf $sprintf,
1881 $need{$module->id}++;
1885 $CPAN::Frontend->myprint("No modules found for @args\n");
1886 } elsif ($what eq "r") {
1887 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
1891 if ($version_zeroes) {
1892 my $s_has = $version_zeroes > 1 ? "s have" : " has";
1893 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
1894 qq{a version number of 0\n});
1896 if ($version_undefs) {
1897 my $s_has = $version_undefs > 1 ? "s have" : " has";
1898 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
1899 qq{parseable version number\n});
1905 #-> sub CPAN::Shell::r ;
1907 shift->_u_r_common("r",@_);
1910 #-> sub CPAN::Shell::u ;
1912 shift->_u_r_common("u",@_);
1915 #-> sub CPAN::Shell::failed ;
1917 my($self,$only_id,$silent) = @_;
1919 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
1921 NAY: for my $nosayer (
1929 next unless exists $d->{$nosayer};
1931 $d->{$nosayer}->can("failed") ?
1932 $d->{$nosayer}->failed :
1933 $d->{$nosayer} =~ /^NO/
1935 next NAY if $only_id && $only_id != (
1936 $d->{$nosayer}->can("commandid")
1938 $d->{$nosayer}->commandid
1940 $CPAN::CurrentCommandId
1945 next DIST unless $failed;
1949 # " %-45s: %s %s\n",
1952 $d->{$failed}->can("failed") ?
1954 $d->{$failed}->commandid,
1957 $d->{$failed}->text,
1967 my $scope = $only_id ? "command" : "session";
1969 my $print = join "",
1970 map { sprintf " %-45s: %s %s\n", @$_[1,2,3] }
1971 sort { $a->[0] <=> $b->[0] } @failed;
1972 $CPAN::Frontend->myprint("Failed during this $scope:\n$print");
1973 } elsif (!$only_id || !$silent) {
1974 $CPAN::Frontend->myprint("Nothing failed in this $scope\n");
1978 # XXX intentionally undocumented because completely bogus, unportable,
1981 #-> sub CPAN::Shell::status ;
1984 require Devel::Size;
1985 my $ps = FileHandle->new;
1986 open $ps, "/proc/$$/status";
1989 next unless /VmSize:\s+(\d+)/;
1993 $CPAN::Frontend->mywarn(sprintf(
1994 "%-27s %6d\n%-27s %6d\n",
1998 Devel::Size::total_size($CPAN::META)/1024,
2000 for my $k (sort keys %$CPAN::META) {
2001 next unless substr($k,0,4) eq "read";
2002 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
2003 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
2004 warn sprintf " %-25s %6d (keys: %6d)\n",
2006 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
2007 scalar keys %{$CPAN::META->{$k}{$k2}};
2012 #-> sub CPAN::Shell::autobundle ;
2015 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
2016 my(@bundle) = $self->_u_r_common("a",@_);
2017 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2018 File::Path::mkpath($todir);
2019 unless (-d $todir) {
2020 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
2023 my($y,$m,$d) = (localtime)[5,4,3];
2027 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
2028 my($to) = File::Spec->catfile($todir,"$me.pm");
2030 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
2031 $to = File::Spec->catfile($todir,"$me.pm");
2033 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
2035 "package Bundle::$me;\n\n",
2036 "\$VERSION = '0.01';\n\n",
2040 "Bundle::$me - Snapshot of installation on ",
2041 $Config::Config{'myhostname'},
2044 "\n\n=head1 SYNOPSIS\n\n",
2045 "perl -MCPAN -e 'install Bundle::$me'\n\n",
2046 "=head1 CONTENTS\n\n",
2047 join("\n", @bundle),
2048 "\n\n=head1 CONFIGURATION\n\n",
2050 "\n\n=head1 AUTHOR\n\n",
2051 "This Bundle has been generated automatically ",
2052 "by the autobundle routine in CPAN.pm.\n",
2055 $CPAN::Frontend->myprint("\nWrote bundle file
2059 #-> sub CPAN::Shell::expandany ;
2062 CPAN->debug("s[$s]") if $CPAN::DEBUG;
2063 if ($s =~ m|/|) { # looks like a file
2064 $s = CPAN::Distribution->normalize($s);
2065 return $CPAN::META->instance('CPAN::Distribution',$s);
2066 # Distributions spring into existence, not expand
2067 } elsif ($s =~ m|^Bundle::|) {
2068 $self->local_bundles; # scanning so late for bundles seems
2069 # both attractive and crumpy: always
2070 # current state but easy to forget
2072 return $self->expand('Bundle',$s);
2074 return $self->expand('Module',$s)
2075 if $CPAN::META->exists('CPAN::Module',$s);
2080 #-> sub CPAN::Shell::expand ;
2083 my($type,@args) = @_;
2084 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
2085 my $class = "CPAN::$type";
2086 my $methods = ['id'];
2087 for my $meth (qw(name)) {
2088 next if $] < 5.00303; # no "can"
2089 next unless $class->can($meth);
2090 push @$methods, $meth;
2092 $self->expand_by_method($class,$methods,@args);
2095 sub expand_by_method {
2097 my($class,$methods,@args) = @_;
2100 my($regex,$command);
2101 if ($arg =~ m|^/(.*)/$|) {
2103 } elsif ($arg =~ m/=/) {
2107 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
2109 defined $regex ? $regex : "UNDEFINED",
2110 defined $command ? $command : "UNDEFINED",
2112 if (defined $regex) {
2114 $CPAN::META->all_objects($class)
2117 # BUG, we got an empty object somewhere
2118 require Data::Dumper;
2119 CPAN->debug(sprintf(
2120 "Bug in CPAN: Empty id on obj[%s][%s]",
2122 Data::Dumper::Dumper($obj)
2126 for my $method (@$methods) {
2127 my $match = eval {$obj->$method() =~ /$regex/i};
2129 my($err) = $@ =~ /^(.+) at .+? line \d+\.$/;
2130 $err ||= $@; # if we were too restrictive above
2131 $CPAN::Frontend->mydie("$err\n");
2138 } elsif ($command) {
2139 die "equal sign in command disabled (immature interface), ".
2141 ! \$CPAN::Shell::ADVANCED_QUERY=1
2142 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
2143 that may go away anytime.\n"
2144 unless $ADVANCED_QUERY;
2145 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
2146 my($matchcrit) = $criterion =~ m/^~(.+)/;
2150 $CPAN::META->all_objects($class)
2152 my $lhs = $self->$method() or next; # () for 5.00503
2154 push @m, $self if $lhs =~ m/$matchcrit/;
2156 push @m, $self if $lhs eq $criterion;
2161 if ( $class eq 'CPAN::Bundle' ) {
2162 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
2163 } elsif ($class eq "CPAN::Distribution") {
2164 $xarg = CPAN::Distribution->normalize($arg);
2168 if ($CPAN::META->exists($class,$xarg)) {
2169 $obj = $CPAN::META->instance($class,$xarg);
2170 } elsif ($CPAN::META->exists($class,$arg)) {
2171 $obj = $CPAN::META->instance($class,$arg);
2178 @m = sort {$a->id cmp $b->id} @m;
2179 if ( $CPAN::DEBUG ) {
2180 my $wantarray = wantarray;
2181 my $join_m = join ",", map {$_->id} @m;
2182 $self->debug("wantarray[$wantarray]join_m[$join_m]");
2184 return wantarray ? @m : $m[0];
2187 #-> sub CPAN::Shell::format_result ;
2190 my($type,@args) = @_;
2191 @args = '/./' unless @args;
2192 my(@result) = $self->expand($type,@args);
2193 my $result = @result == 1 ?
2194 $result[0]->as_string :
2196 "No objects of type $type found for argument @args\n" :
2198 (map {$_->as_glimpse} @result),
2199 scalar @result, " items found\n",
2204 #-> sub CPAN::Shell::report_fh ;
2206 my $installation_report_fh;
2207 my $previously_noticed = 0;
2210 return $installation_report_fh if $installation_report_fh;
2211 if ($CPAN::META->has_inst("File::Temp")) {
2212 $installation_report_fh
2214 template => 'cpan_install_XXXX',
2219 unless ( $installation_report_fh ) {
2220 warn("Couldn't open installation report file; " .
2221 "no report file will be generated."
2222 ) unless $previously_noticed++;
2228 # The only reason for this method is currently to have a reliable
2229 # debugging utility that reveals which output is going through which
2230 # channel. No, I don't like the colors ;-)
2232 # to turn colordebugging on, write
2233 # cpan> o conf colorize_output 1
2235 #-> sub CPAN::Shell::print_ornamented ;
2237 my $print_ornamented_have_warned = 0;
2238 sub colorize_output {
2239 my $colorize_output = $CPAN::Config->{colorize_output};
2240 if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) {
2241 unless ($print_ornamented_have_warned++) {
2242 # no myprint/mywarn within myprint/mywarn!
2243 warn "Colorize_output is set to true but Term::ANSIColor is not
2244 installed. To activate colorized output, please install Term::ANSIColor.\n\n";
2246 $colorize_output = 0;
2248 return $colorize_output;
2253 sub print_ornamented {
2254 my($self,$what,$ornament) = @_;
2255 return unless defined $what;
2257 local $| = 1; # Flush immediately
2258 if ( $CPAN::Be_Silent ) {
2259 print {report_fh()} $what;
2262 my $swhat = "$what"; # stringify if it is an object
2263 if ($CPAN::Config->{term_is_latin}){
2266 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
2268 if ($self->colorize_output) {
2269 if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) {
2270 # if you want to have this configurable, please file a bugreport
2271 $ornament = "black on_cyan";
2273 my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
2275 print "Term::ANSIColor rejects color[$ornament]: $@\n
2276 Please choose a different color (Hint: try 'o conf init color.*')\n";
2280 Term::ANSIColor::color("reset");
2286 # where is myprint/mywarn/Frontend/etc. documented? We need guidelines
2287 # where to use what! I think, we send everything to STDOUT and use
2288 # print for normal/good news and warn for news that need more
2289 # attention. Yes, this is our working contract for now.
2291 my($self,$what) = @_;
2293 $self->print_ornamented($what, $CPAN::Config->{colorize_print}||'bold blue on_white');
2297 my($self,$what) = @_;
2298 $self->myprint($what);
2303 my($self,$what) = @_;
2304 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2307 # only to be used for shell commands
2309 my($self,$what) = @_;
2310 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2312 # If it is the shell, we want that the following die to be silent,
2313 # but if it is not the shell, we would need a 'die $what'. We need
2314 # to take care that only shell commands use mydie. Is this
2320 # sub CPAN::Shell::colorable_makemaker_prompt
2321 sub colorable_makemaker_prompt {
2323 if (CPAN::Shell->colorize_output) {
2324 my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white';
2325 my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
2328 my $ans = ExtUtils::MakeMaker::prompt($foo,$bar);
2329 if (CPAN::Shell->colorize_output) {
2330 print Term::ANSIColor::color('reset');
2335 # use this only for unrecoverable errors!
2336 sub unrecoverable_error {
2337 my($self,$what) = @_;
2338 my @lines = split /\n/, $what;
2340 for my $l (@lines) {
2341 $longest = length $l if length $l > $longest;
2343 $longest = 62 if $longest > 62;
2344 for my $l (@lines) {
2350 if (length $l < 66) {
2351 $l = pack "A66 A*", $l, "<==";
2355 unshift @lines, "\n";
2356 $self->mydie(join "", @lines);
2360 my($self, $sleep) = @_;
2365 return if -t STDOUT;
2366 my $odef = select STDERR;
2373 #-> sub CPAN::Shell::rematein ;
2374 # RE-adme||MA-ke||TE-st||IN-stall
2377 my($meth,@some) = @_;
2379 while($meth =~ /^(force|notest)$/) {
2380 push @pragma, $meth;
2381 $meth = shift @some or
2382 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
2386 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
2388 # Here is the place to set "test_count" on all involved parties to
2389 # 0. We then can pass this counter on to the involved
2390 # distributions and those can refuse to test if test_count > X. In
2391 # the first stab at it we could use a 1 for "X".
2393 # But when do I reset the distributions to start with 0 again?
2394 # Jost suggested to have a random or cycling interaction ID that
2395 # we pass through. But the ID is something that is just left lying
2396 # around in addition to the counter, so I'd prefer to set the
2397 # counter to 0 now, and repeat at the end of the loop. But what
2398 # about dependencies? They appear later and are not reset, they
2399 # enter the queue but not its copy. How do they get a sensible
2402 # construct the queue
2404 STHING: foreach $s (@some) {
2407 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
2409 } elsif ($s =~ m|[\$\@\%]|) { # looks like a perl variable
2410 } elsif ($s =~ m|^/|) { # looks like a regexp
2411 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
2412 "not supported.\nRejecting argument '$s'\n");
2413 $CPAN::Frontend->mysleep(2);
2415 } elsif ($meth eq "ls") {
2416 $self->globls($s,\@pragma);
2419 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
2420 $obj = CPAN::Shell->expandany($s);
2423 } elsif (ref $obj) {
2424 $obj->color_cmd_tmps(0,1);
2425 CPAN::Queue->new(qmod => $obj->id, reqtype => "c");
2427 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
2428 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
2429 if ($meth =~ /^(dump|ls)$/) {
2432 $CPAN::Frontend->mywarn(
2434 "Don't be silly, you can't $meth ",
2438 $CPAN::Frontend->mysleep(2);
2440 } elsif ($s =~ m|[\$\@\%]| && $meth eq "dump") {
2441 CPAN::InfoObj->dump($s);
2444 ->mywarn(qq{Warning: Cannot $meth $s, }.
2445 qq{don't know what it is.
2450 to find objects with matching identifiers.
2452 $CPAN::Frontend->mysleep(2);
2456 # queuerunner (please be warned: when I started to change the
2457 # queue to hold objects instead of names, I made one or two
2458 # mistakes and never found which. I reverted back instead)
2459 while (my $q = CPAN::Queue->first) {
2461 my $s = $q->as_string;
2462 my $reqtype = $q->reqtype || "";
2463 $obj = CPAN::Shell->expandany($s);
2464 $obj->{reqtype} ||= "";
2465 CPAN->debug("obj-reqtype[$obj->{reqtype}]".
2466 "q-reqtype[$reqtype]") if $CPAN::DEBUG;
2467 if ($obj->{reqtype}) {
2468 if ($obj->{reqtype} eq "b" && $reqtype =~ /^[rc]$/) {
2469 $obj->{reqtype} = $reqtype;
2471 exists $obj->{install}
2474 $obj->{install}->can("failed") ?
2475 $obj->{install}->failed :
2476 $obj->{install} =~ /^NO/
2479 delete $obj->{install};
2480 $CPAN::Frontend->mywarn
2481 ("Promoting $obj->{ID} from 'build_requires' to 'requires'");
2485 $obj->{reqtype} = $reqtype;
2488 for my $pragma (@pragma) {
2491 ($] < 5.00303 || $obj->can($pragma))){
2492 ### compatibility with 5.003
2493 $obj->$pragma($meth); # the pragma "force" in
2494 # "CPAN::Distribution" must know
2495 # what we are intending
2498 if ($]>=5.00303 && $obj->can('called_for')) {
2499 $obj->called_for($s);
2501 CPAN->debug(qq{pragma[@pragma]meth[$meth]}.
2502 qq{ID[$obj->{ID}]}) if $CPAN::DEBUG;
2506 CPAN::Queue->delete($s);
2508 CPAN->debug("failed");
2512 CPAN::Queue->delete_first($s);
2514 for my $obj (@qcopy) {
2515 $obj->color_cmd_tmps(0,0);
2519 #-> sub CPAN::Shell::recent ;
2523 CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
2528 # set up the dispatching methods
2530 for my $command (qw(
2545 *$command = sub { shift->rematein($command, @_); };
2549 package CPAN::LWP::UserAgent;
2553 return if $SETUPDONE;
2554 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2555 require LWP::UserAgent;
2556 @ISA = qw(Exporter LWP::UserAgent);
2559 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
2563 sub get_basic_credentials {
2564 my($self, $realm, $uri, $proxy) = @_;
2565 if ($USER && $PASSWD) {
2566 return ($USER, $PASSWD);
2569 ($USER,$PASSWD) = $self->get_proxy_credentials();
2571 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
2573 return($USER,$PASSWD);
2576 sub get_proxy_credentials {
2578 my ($user, $password);
2579 if ( defined $CPAN::Config->{proxy_user} &&
2580 defined $CPAN::Config->{proxy_pass}) {
2581 $user = $CPAN::Config->{proxy_user};
2582 $password = $CPAN::Config->{proxy_pass};
2583 return ($user, $password);
2585 my $username_prompt = "\nProxy authentication needed!
2586 (Note: to permanently configure username and password run
2587 o conf proxy_user your_username
2588 o conf proxy_pass your_password
2590 ($user, $password) =
2591 _get_username_and_password_from_user($username_prompt);
2592 return ($user,$password);
2595 sub get_non_proxy_credentials {
2597 my ($user,$password);
2598 if ( defined $CPAN::Config->{username} &&
2599 defined $CPAN::Config->{password}) {
2600 $user = $CPAN::Config->{username};
2601 $password = $CPAN::Config->{password};
2602 return ($user, $password);
2604 my $username_prompt = "\nAuthentication needed!
2605 (Note: to permanently configure username and password run
2606 o conf username your_username
2607 o conf password your_password
2610 ($user, $password) =
2611 _get_username_and_password_from_user($username_prompt);
2612 return ($user,$password);
2615 sub _get_username_and_password_from_user {
2617 my $username_message = shift;
2618 my ($username,$password);
2620 ExtUtils::MakeMaker->import(qw(prompt));
2621 $username = prompt($username_message);
2622 if ($CPAN::META->has_inst("Term::ReadKey")) {
2623 Term::ReadKey::ReadMode("noecho");
2626 $CPAN::Frontend->mywarn(
2627 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
2630 $password = prompt("Password:");
2632 if ($CPAN::META->has_inst("Term::ReadKey")) {
2633 Term::ReadKey::ReadMode("restore");
2635 $CPAN::Frontend->myprint("\n\n");
2636 return ($username,$password);
2639 # mirror(): Its purpose is to deal with proxy authentication. When we
2640 # call SUPER::mirror, we relly call the mirror method in
2641 # LWP::UserAgent. LWP::UserAgent will then call
2642 # $self->get_basic_credentials or some equivalent and this will be
2643 # $self->dispatched to our own get_basic_credentials method.
2645 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2647 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2648 # although we have gone through our get_basic_credentials, the proxy
2649 # server refuses to connect. This could be a case where the username or
2650 # password has changed in the meantime, so I'm trying once again without
2651 # $USER and $PASSWD to give the get_basic_credentials routine another
2652 # chance to set $USER and $PASSWD.
2654 # mirror(): Its purpose is to deal with proxy authentication. When we
2655 # call SUPER::mirror, we relly call the mirror method in
2656 # LWP::UserAgent. LWP::UserAgent will then call
2657 # $self->get_basic_credentials or some equivalent and this will be
2658 # $self->dispatched to our own get_basic_credentials method.
2660 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2662 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2663 # although we have gone through our get_basic_credentials, the proxy
2664 # server refuses to connect. This could be a case where the username or
2665 # password has changed in the meantime, so I'm trying once again without
2666 # $USER and $PASSWD to give the get_basic_credentials routine another
2667 # chance to set $USER and $PASSWD.
2670 my($self,$url,$aslocal) = @_;
2671 my $result = $self->SUPER::mirror($url,$aslocal);
2672 if ($result->code == 407) {
2675 $result = $self->SUPER::mirror($url,$aslocal);
2683 #-> sub CPAN::FTP::ftp_get ;
2685 my($class,$host,$dir,$file,$target) = @_;
2687 qq[Going to fetch file [$file] from dir [$dir]
2688 on host [$host] as local [$target]\n]
2690 my $ftp = Net::FTP->new($host);
2692 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
2695 return 0 unless defined $ftp;
2696 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
2697 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
2698 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
2699 my $msg = $ftp->message;
2700 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
2703 unless ( $ftp->cwd($dir) ){
2704 my $msg = $ftp->message;
2705 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
2709 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
2710 unless ( $ftp->get($file,$target) ){
2711 my $msg = $ftp->message;
2712 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
2715 $ftp->quit; # it's ok if this fails
2719 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
2721 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
2722 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
2724 # > *** 1562,1567 ****
2725 # > --- 1562,1580 ----
2726 # > return 1 if substr($url,0,4) eq "file";
2727 # > return 1 unless $url =~ m|://([^/]+)|;
2729 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
2731 # > + $proxy =~ m|://([^/:]+)|;
2733 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
2734 # > + if ($noproxy) {
2735 # > + if ($host !~ /$noproxy$/) {
2736 # > + $host = $proxy;
2739 # > + $host = $proxy;
2742 # > require Net::Ping;
2743 # > return 1 unless $Net::Ping::VERSION >= 2;
2747 #-> sub CPAN::FTP::localize ;
2749 my($self,$file,$aslocal,$force) = @_;
2751 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
2752 unless defined $aslocal;
2753 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
2756 if ($^O eq 'MacOS') {
2757 # Comment by AK on 2000-09-03: Uniq short filenames would be
2758 # available in CHECKSUMS file
2759 my($name, $path) = File::Basename::fileparse($aslocal, '');
2760 if (length($name) > 31) {
2771 my $size = 31 - length($suf);
2772 while (length($name) > $size) {
2776 $aslocal = File::Spec->catfile($path, $name);
2780 if (-f $aslocal && -r _ && !($force & 1)){
2782 if ($size = -s $aslocal) {
2783 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
2786 # empty file from a previous unsuccessful attempt to download it
2788 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
2789 "could not remove.");
2794 rename $aslocal, "$aslocal.bak";
2798 my($aslocal_dir) = File::Basename::dirname($aslocal);
2799 File::Path::mkpath($aslocal_dir);
2800 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
2801 qq{directory "$aslocal_dir".
2802 I\'ll continue, but if you encounter problems, they may be due
2803 to insufficient permissions.\n}) unless -w $aslocal_dir;
2805 # Inheritance is not easier to manage than a few if/else branches
2806 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2808 CPAN::LWP::UserAgent->config;
2809 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
2811 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
2815 $Ua->proxy('ftp', $var)
2816 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
2817 $Ua->proxy('http', $var)
2818 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
2821 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
2823 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
2824 # > use ones that require basic autorization.
2826 # > Example of when I use it manually in my own stuff:
2828 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
2829 # > $req->proxy_authorization_basic("username","password");
2830 # > $res = $ua->request($req);
2834 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
2838 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
2839 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
2842 # Try the list of urls for each single object. We keep a record
2843 # where we did get a file from
2844 my(@reordered,$last);
2845 $CPAN::Config->{urllist} ||= [];
2846 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
2847 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
2848 $CPAN::Config->{urllist} = [];
2850 $last = $#{$CPAN::Config->{urllist}};
2851 if ($force & 2) { # local cpans probably out of date, don't reorder
2852 @reordered = (0..$last);
2856 (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
2858 (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
2860 defined($ThesiteURL)
2862 ($CPAN::Config->{urllist}[$b] eq $ThesiteURL)
2864 ($CPAN::Config->{urllist}[$a] eq $ThesiteURL)
2869 $self->debug("Themethod[$Themethod]") if $CPAN::DEBUG;
2871 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
2873 @levels = qw/easy hard hardest/;
2875 @levels = qw/easy/ if $^O eq 'MacOS';
2877 local $ENV{FTP_PASSIVE} =
2878 exists $CPAN::Config->{ftp_passive} ?
2879 $CPAN::Config->{ftp_passive} : 1;
2880 for $levelno (0..$#levels) {
2881 my $level = $levels[$levelno];
2882 my $method = "host$level";
2883 my @host_seq = $level eq "easy" ?
2884 @reordered : 0..$last; # reordered has CDROM up front
2885 my @urllist = map { $CPAN::Config->{urllist}[$_] } @host_seq;
2886 for my $u (@urllist) {
2887 if ($u->can("text")) {
2888 $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
2890 $u .= "/" unless substr($u,-1) eq "/";
2891 $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
2894 for my $u (@CPAN::Defaultsites) {
2895 push @urllist, $u unless grep { $_ eq $u } @urllist;
2897 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
2898 my $ret = $self->$method(\@urllist,$file,$aslocal);
2900 $Themethod = $level;
2902 # utime $now, $now, $aslocal; # too bad, if we do that, we
2903 # might alter a local mirror
2904 $self->debug("level[$level]") if $CPAN::DEBUG;
2908 last if $CPAN::Signal; # need to cleanup
2911 unless ($CPAN::Signal) {
2914 if (@{$CPAN::Config->{urllist}}) {
2916 qq{Please check, if the URLs I found in your configuration file \(}.
2917 join(", ", @{$CPAN::Config->{urllist}}).
2920 push @mess, qq{Your urllist is empty!};
2922 push @mess, qq{The urllist can be edited.},
2923 qq{E.g. with 'o conf urllist push ftp://myurl/'};
2924 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
2925 $CPAN::Frontend->mywarn("Could not fetch $file\n");
2926 $CPAN::Frontend->mysleep(2);
2929 rename "$aslocal.bak", $aslocal;
2930 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
2931 $self->ls($aslocal));
2937 # package CPAN::FTP;
2939 my($self,$host_seq,$file,$aslocal) = @_;
2941 HOSTEASY: for $ro_url (@$host_seq) {
2942 my $url .= "$ro_url$file";
2943 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
2944 if ($url =~ /^file:/) {
2946 if ($CPAN::META->has_inst('URI::URL')) {
2947 my $u = URI::URL->new($url);
2949 } else { # works only on Unix, is poorly constructed, but
2950 # hopefully better than nothing.
2951 # RFC 1738 says fileurl BNF is
2952 # fileurl = "file://" [ host | "localhost" ] "/" fpath
2953 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
2955 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
2956 $l =~ s|^file:||; # assume they
2960 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
2962 $self->debug("local file[$l]") if $CPAN::DEBUG;
2963 if ( -f $l && -r _) {
2964 $ThesiteURL = $ro_url;
2967 if ($l =~ /(.+)\.gz$/) {
2969 if ( -f $ungz && -r _) {
2970 $ThesiteURL = $ro_url;
2974 # Maybe mirror has compressed it?
2976 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
2977 CPAN::Tarzip->new("$l.gz")->gunzip($aslocal);
2979 $ThesiteURL = $ro_url;
2984 if ($CPAN::META->has_usable('LWP')) {
2985 $CPAN::Frontend->myprint("Fetching with LWP:
2989 CPAN::LWP::UserAgent->config;
2990 eval { $Ua = CPAN::LWP::UserAgent->new; };
2992 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
2995 my $res = $Ua->mirror($url, $aslocal);
2996 if ($res->is_success) {
2997 $ThesiteURL = $ro_url;
2999 utime $now, $now, $aslocal; # download time is more
3000 # important than upload
3003 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3004 my $gzurl = "$url.gz";
3005 $CPAN::Frontend->myprint("Fetching with LWP:
3008 $res = $Ua->mirror($gzurl, "$aslocal.gz");
3009 if ($res->is_success &&
3010 CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)
3012 $ThesiteURL = $ro_url;
3016 $CPAN::Frontend->myprint(sprintf(
3017 "LWP failed with code[%s] message[%s]\n",
3021 # Alan Burlison informed me that in firewall environments
3022 # Net::FTP can still succeed where LWP fails. So we do not
3023 # skip Net::FTP anymore when LWP is available.
3026 $ro_url->can("text")
3028 $ro_url->{FROM} eq "USER"
3030 my $ret = $self->hosthard([$ro_url],$file,$aslocal);
3031 return $ret if $ret;
3033 $CPAN::Frontend->mywarn(" LWP not available\n");
3035 return if $CPAN::Signal;
3036 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3037 # that's the nice and easy way thanks to Graham
3038 my($host,$dir,$getfile) = ($1,$2,$3);
3039 if ($CPAN::META->has_usable('Net::FTP')) {
3041 $CPAN::Frontend->myprint("Fetching with Net::FTP:
3044 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
3045 "aslocal[$aslocal]") if $CPAN::DEBUG;
3046 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
3047 $ThesiteURL = $ro_url;
3050 if ($aslocal !~ /\.gz(?!\n)\Z/) {
3051 my $gz = "$aslocal.gz";
3052 $CPAN::Frontend->myprint("Fetching with Net::FTP
3055 if (CPAN::FTP->ftp_get($host,
3059 CPAN::Tarzip->new($gz)->gunzip($aslocal)
3061 $ThesiteURL = $ro_url;
3068 return if $CPAN::Signal;
3072 # package CPAN::FTP;
3074 my($self,$host_seq,$file,$aslocal) = @_;
3076 # Came back if Net::FTP couldn't establish connection (or
3077 # failed otherwise) Maybe they are behind a firewall, but they
3078 # gave us a socksified (or other) ftp program...
3081 my($devnull) = $CPAN::Config->{devnull} || "";
3083 my($aslocal_dir) = File::Basename::dirname($aslocal);
3084 File::Path::mkpath($aslocal_dir);
3085 HOSTHARD: for $ro_url (@$host_seq) {
3086 my $url = "$ro_url$file";
3087 my($proto,$host,$dir,$getfile);
3089 # Courtesy Mark Conty mark_conty@cargill.com change from
3090 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3092 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
3093 # proto not yet used
3094 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
3096 next HOSTHARD; # who said, we could ftp anything except ftp?
3098 next HOSTHARD if $proto eq "file"; # file URLs would have had
3099 # success above. Likely a bogus URL
3101 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
3103 # Try the most capable first and leave ncftp* for last as it only
3105 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
3106 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
3107 next unless defined $funkyftp;
3108 next if $funkyftp =~ /^\s*$/;
3110 my($asl_ungz, $asl_gz);
3111 ($asl_ungz = $aslocal) =~ s/\.gz//;
3112 $asl_gz = "$asl_ungz.gz";
3114 my($src_switch) = "";
3116 my($stdout_redir) = " > $asl_ungz";
3118 $src_switch = " -source";
3119 } elsif ($f eq "ncftp"){
3120 $src_switch = " -c";
3121 } elsif ($f eq "wget"){
3122 $src_switch = " -O $asl_ungz";
3124 } elsif ($f eq 'curl'){
3125 $src_switch = ' -L -f -s -S --netrc-optional';
3128 if ($f eq "ncftpget"){
3129 $chdir = "cd $aslocal_dir && ";
3132 $CPAN::Frontend->myprint(
3134 Trying with "$funkyftp$src_switch" to get
3138 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
3139 $self->debug("system[$system]") if $CPAN::DEBUG;
3140 my($wstatus) = system($system);
3142 # lynx returns 0 when it fails somewhere
3144 my $content = do { local *FH; open FH, $asl_ungz or die; local $/; <FH> };
3145 if ($content =~ /^<.*<title>[45]/si) {
3146 $CPAN::Frontend->mywarn(qq{
3147 No success, the file that lynx has has downloaded looks like an error message:
3150 $CPAN::Frontend->mysleep(1);
3154 $CPAN::Frontend->myprint(qq{
3155 No success, the file that lynx has has downloaded is an empty file.
3160 if ($wstatus == 0) {
3163 } elsif ($asl_ungz ne $aslocal) {
3164 # test gzip integrity
3165 if (CPAN::Tarzip->new($asl_ungz)->gtest) {
3166 # e.g. foo.tar is gzipped --> foo.tar.gz
3167 rename $asl_ungz, $aslocal;
3169 CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz);
3172 $ThesiteURL = $ro_url;
3174 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3176 -f $asl_ungz && -s _ == 0;
3177 my $gz = "$aslocal.gz";
3178 my $gzurl = "$url.gz";
3179 $CPAN::Frontend->myprint(
3181 Trying with "$funkyftp$src_switch" to get
3184 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
3185 $self->debug("system[$system]") if $CPAN::DEBUG;
3187 if (($wstatus = system($system)) == 0
3191 # test gzip integrity
3192 my $ct = CPAN::Tarzip->new($asl_gz);
3194 $ct->gunzip($aslocal);
3196 # somebody uncompressed file for us?
3197 rename $asl_ungz, $aslocal;
3199 $ThesiteURL = $ro_url;
3202 unlink $asl_gz if -f $asl_gz;
3205 my $estatus = $wstatus >> 8;
3206 my $size = -f $aslocal ?
3207 ", left\n$aslocal with size ".-s _ :
3208 "\nWarning: expected file [$aslocal] doesn't exist";
3209 $CPAN::Frontend->myprint(qq{
3210 System call "$system"
3211 returned status $estatus (wstat $wstatus)$size
3214 return if $CPAN::Signal;
3215 } # transfer programs
3219 # package CPAN::FTP;
3221 my($self,$host_seq,$file,$aslocal) = @_;
3224 my($aslocal_dir) = File::Basename::dirname($aslocal);
3225 File::Path::mkpath($aslocal_dir);
3226 my $ftpbin = $CPAN::Config->{ftp};
3227 unless (length $ftpbin && MM->maybe_command($ftpbin)) {
3228 $CPAN::Frontend->myprint("No external ftp command available\n\n");
3231 $CPAN::Frontend->mywarn(qq{
3232 As a last ressort we now switch to the external ftp command '$ftpbin'
3235 Doing so often leads to problems that are hard to diagnose.
3237 If you're victim of such problems, please consider unsetting the ftp
3238 config variable with
3244 $CPAN::Frontend->mysleep(2);
3245 HOSTHARDEST: for $ro_url (@$host_seq) {
3246 my $url = "$ro_url$file";
3247 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
3248 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3251 my($host,$dir,$getfile) = ($1,$2,$3);
3253 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
3254 $ctime,$blksize,$blocks) = stat($aslocal);
3255 $timestamp = $mtime ||= 0;
3256 my($netrc) = CPAN::FTP::netrc->new;
3257 my($netrcfile) = $netrc->netrc;
3258 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
3259 my $targetfile = File::Basename::basename($aslocal);
3265 map("cd $_", split /\//, $dir), # RFC 1738
3267 "get $getfile $targetfile",
3271 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
3272 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
3273 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
3275 $netrc->contains($host))) if $CPAN::DEBUG;
3276 if ($netrc->protected) {
3277 my $dialog = join "", map { " $_\n" } @dialog;
3279 if ($netrc->contains($host)) {
3280 $netrc_explain = "Relying that your .netrc entry for '$host' ".
3281 "manages the login";
3283 $netrc_explain = "Relying that your default .netrc entry ".
3284 "manages the login";
3286 $CPAN::Frontend->myprint(qq{
3287 Trying with external ftp to get
3290 Going to send the dialog
3294 $self->talk_ftp("$ftpbin$verbose $host",
3296 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3297 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3299 if ($mtime > $timestamp) {
3300 $CPAN::Frontend->myprint("GOT $aslocal\n");
3301 $ThesiteURL = $ro_url;
3304 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
3306 return if $CPAN::Signal;
3308 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
3309 qq{correctly protected.\n});
3312 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
3313 nor does it have a default entry\n");
3316 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
3317 # then and login manually to host, using e-mail as
3319 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
3323 "user anonymous $Config::Config{'cf_email'}"
3325 my $dialog = join "", map { " $_\n" } @dialog;
3326 $CPAN::Frontend->myprint(qq{
3327 Trying with external ftp to get
3329 Going to send the dialog
3333 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
3334 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3335 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3337 if ($mtime > $timestamp) {
3338 $CPAN::Frontend->myprint("GOT $aslocal\n");
3339 $ThesiteURL = $ro_url;
3342 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
3344 return if $CPAN::Signal;
3345 $CPAN::Frontend->mywarn("Can't access URL $url.\n\n");
3346 $CPAN::Frontend->mysleep(2);
3350 # package CPAN::FTP;
3352 my($self,$command,@dialog) = @_;
3353 my $fh = FileHandle->new;
3354 $fh->open("|$command") or die "Couldn't open ftp: $!";
3355 foreach (@dialog) { $fh->print("$_\n") }
3356 $fh->close; # Wait for process to complete
3358 my $estatus = $wstatus >> 8;
3359 $CPAN::Frontend->myprint(qq{
3360 Subprocess "|$command"
3361 returned status $estatus (wstat $wstatus)
3365 # find2perl needs modularization, too, all the following is stolen
3369 my($self,$name) = @_;
3370 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
3371 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
3373 my($perms,%user,%group);
3377 $blocks = int(($blocks + 1) / 2);
3380 $blocks = int(($sizemm + 1023) / 1024);
3383 if (-f _) { $perms = '-'; }
3384 elsif (-d _) { $perms = 'd'; }
3385 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
3386 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
3387 elsif (-p _) { $perms = 'p'; }
3388 elsif (-S _) { $perms = 's'; }
3389 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
3391 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
3392 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
3393 my $tmpmode = $mode;
3394 my $tmp = $rwx[$tmpmode & 7];
3396 $tmp = $rwx[$tmpmode & 7] . $tmp;
3398 $tmp = $rwx[$tmpmode & 7] . $tmp;
3399 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
3400 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
3401 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
3404 my $user = $user{$uid} || $uid; # too lazy to implement lookup
3405 my $group = $group{$gid} || $gid;
3407 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
3409 my($moname) = $moname[$mon];
3410 if (-M _ > 365.25 / 2) {
3411 $timeyear = $year + 1900;
3414 $timeyear = sprintf("%02d:%02d", $hour, $min);
3417 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
3431 package CPAN::FTP::netrc;
3434 # package CPAN::FTP::netrc;
3437 my $home = CPAN::HandleConfig::home;
3438 my $file = File::Spec->catfile($home,".netrc");
3440 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3441 $atime,$mtime,$ctime,$blksize,$blocks)
3446 my($fh,@machines,$hasdefault);
3448 $fh = FileHandle->new or die "Could not create a filehandle";
3450 if($fh->open($file)){
3451 $protected = ($mode & 077) == 0;
3453 NETRC: while (<$fh>) {
3454 my(@tokens) = split " ", $_;
3455 TOKEN: while (@tokens) {
3456 my($t) = shift @tokens;
3457 if ($t eq "default"){
3461 last TOKEN if $t eq "macdef";
3462 if ($t eq "machine") {
3463 push @machines, shift @tokens;
3468 $file = $hasdefault = $protected = "";
3472 'mach' => [@machines],
3474 'hasdefault' => $hasdefault,
3475 'protected' => $protected,
3479 # CPAN::FTP::netrc::hasdefault;
3480 sub hasdefault { shift->{'hasdefault'} }
3481 sub netrc { shift->{'netrc'} }
3482 sub protected { shift->{'protected'} }
3484 my($self,$mach) = @_;
3485 for ( @{$self->{'mach'}} ) {
3486 return 1 if $_ eq $mach;
3491 package CPAN::Complete;
3495 my($text, $line, $start, $end) = @_;
3496 my(@perlret) = cpl($text, $line, $start);
3497 # find longest common match. Can anybody show me how to peruse
3498 # T::R::Gnu to have this done automatically? Seems expensive.
3499 return () unless @perlret;
3500 my($newtext) = $text;
3501 for (my $i = length($text)+1;;$i++) {
3502 last unless length($perlret[0]) && length($perlret[0]) >= $i;
3503 my $try = substr($perlret[0],0,$i);
3504 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
3505 # warn "try[$try]tries[@tries]";
3506 if (@tries == @perlret) {
3512 ($newtext,@perlret);
3515 #-> sub CPAN::Complete::cpl ;
3517 my($word,$line,$pos) = @_;
3521 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3523 if ($line =~ s/^(force\s*)//) {
3528 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
3529 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
3531 } elsif ($line =~ /^(a|ls)\s/) {
3532 @return = cplx('CPAN::Author',uc($word));
3533 } elsif ($line =~ /^b\s/) {
3534 CPAN::Shell->local_bundles;
3535 @return = cplx('CPAN::Bundle',$word);
3536 } elsif ($line =~ /^d\s/) {
3537 @return = cplx('CPAN::Distribution',$word);
3538 } elsif ($line =~ m/^(
3539 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
3541 if ($word =~ /^Bundle::/) {
3542 CPAN::Shell->local_bundles;
3544 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3545 } elsif ($line =~ /^i\s/) {
3546 @return = cpl_any($word);
3547 } elsif ($line =~ /^reload\s/) {
3548 @return = cpl_reload($word,$line,$pos);
3549 } elsif ($line =~ /^o\s/) {
3550 @return = cpl_option($word,$line,$pos);
3551 } elsif ($line =~ m/^\S+\s/ ) {
3552 # fallback for future commands and what we have forgotten above
3553 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3560 #-> sub CPAN::Complete::cplx ;
3562 my($class, $word) = @_;
3563 # I believed for many years that this was sorted, today I
3564 # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
3565 # make it sorted again. Maybe sort was dropped when GNU-readline
3566 # support came in? The RCS file is difficult to read on that:-(
3567 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
3570 #-> sub CPAN::Complete::cpl_any ;
3574 cplx('CPAN::Author',$word),
3575 cplx('CPAN::Bundle',$word),
3576 cplx('CPAN::Distribution',$word),
3577 cplx('CPAN::Module',$word),
3581 #-> sub CPAN::Complete::cpl_reload ;
3583 my($word,$line,$pos) = @_;
3585 my(@words) = split " ", $line;
3586 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3587 my(@ok) = qw(cpan index);
3588 return @ok if @words == 1;
3589 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
3592 #-> sub CPAN::Complete::cpl_option ;
3594 my($word,$line,$pos) = @_;
3596 my(@words) = split " ", $line;
3597 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3598 my(@ok) = qw(conf debug);
3599 return @ok if @words == 1;
3600 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
3602 } elsif ($words[1] eq 'index') {
3604 } elsif ($words[1] eq 'conf') {
3605 return CPAN::HandleConfig::cpl(@_);
3606 } elsif ($words[1] eq 'debug') {
3607 return sort grep /^\Q$word\E/i,
3608 sort keys %CPAN::DEBUG, 'all';
3612 package CPAN::Index;
3615 #-> sub CPAN::Index::force_reload ;
3618 $CPAN::Index::LAST_TIME = 0;
3622 #-> sub CPAN::Index::reload ;
3624 my($cl,$force) = @_;
3627 # XXX check if a newer one is available. (We currently read it
3628 # from time to time)
3629 for ($CPAN::Config->{index_expire}) {
3630 $_ = 0.001 unless $_ && $_ > 0.001;
3632 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
3633 # debug here when CPAN doesn't seem to read the Metadata
3635 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
3637 unless ($CPAN::META->{PROTOCOL}) {
3638 $cl->read_metadata_cache;
3639 $CPAN::META->{PROTOCOL} ||= "1.0";
3641 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
3642 # warn "Setting last_time to 0";
3643 $LAST_TIME = 0; # No warning necessary
3645 return if $LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
3648 # IFF we are developing, it helps to wipe out the memory
3649 # between reloads, otherwise it is not what a user expects.
3650 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
3651 $CPAN::META = CPAN->new;
3655 local $LAST_TIME = $time;
3656 local $CPAN::META->{PROTOCOL} = PROTOCOL;
3658 my $needshort = $^O eq "dos";
3660 $cl->rd_authindex($cl
3662 "authors/01mailrc.txt.gz",
3664 File::Spec->catfile('authors', '01mailrc.gz') :
3665 File::Spec->catfile('authors', '01mailrc.txt.gz'),
3668 $debug = "timing reading 01[".($t2 - $time)."]";
3670 return if $CPAN::Signal; # this is sometimes lengthy
3671 $cl->rd_modpacks($cl
3673 "modules/02packages.details.txt.gz",
3675 File::Spec->catfile('modules', '02packag.gz') :
3676 File::Spec->catfile('modules', '02packages.details.txt.gz'),
3679 $debug .= "02[".($t2 - $time)."]";
3681 return if $CPAN::Signal; # this is sometimes lengthy
3684 "modules/03modlist.data.gz",
3686 File::Spec->catfile('modules', '03mlist.gz') :
3687 File::Spec->catfile('modules', '03modlist.data.gz'),
3689 $cl->write_metadata_cache;
3691 $debug .= "03[".($t2 - $time)."]";
3693 CPAN->debug($debug) if $CPAN::DEBUG;
3696 $CPAN::META->{PROTOCOL} = PROTOCOL;
3699 #-> sub CPAN::Index::reload_x ;
3701 my($cl,$wanted,$localname,$force) = @_;
3702 $force |= 2; # means we're dealing with an index here
3703 CPAN::HandleConfig->load; # we should guarantee loading wherever
3704 # we rely on Config XXX
3705 $localname ||= $wanted;
3706 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
3710 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
3713 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
3714 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
3715 qq{day$s. I\'ll use that.});
3718 $force |= 1; # means we're quite serious about it.
3720 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
3723 #-> sub CPAN::Index::rd_authindex ;
3725 my($cl, $index_target) = @_;
3727 return unless defined $index_target;
3728 $CPAN::Frontend->myprint("Going to read $index_target\n");
3730 tie *FH, 'CPAN::Tarzip', $index_target;
3733 push @lines, split /\012/ while <FH>;
3735 my $modulus = int($#lines/75) || 1;
3736 CPAN->debug(sprintf "modulus[%d]lines[%s]", $modulus, scalar @lines) if $CPAN::DEBUG;
3738 my($userid,$fullname,$email) =
3739 m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
3740 next unless $userid && $fullname && $email;
3742 # instantiate an author object
3743 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
3744 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
3745 $CPAN::Frontend->myprint(".") unless $i++ % $modulus;
3746 return if $CPAN::Signal;
3748 $CPAN::Frontend->myprint("DONE\n");
3752 my($self,$dist) = @_;
3753 $dist = $self->{'id'} unless defined $dist;
3754 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
3758 #-> sub CPAN::Index::rd_modpacks ;
3760 my($self, $index_target) = @_;
3761 return unless defined $index_target;
3762 $CPAN::Frontend->myprint("Going to read $index_target\n");
3763 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3765 CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
3768 while (my $bytes = $fh->READ(\$chunk,8192)) {
3771 my @lines = split /\012/, $slurp;
3772 CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG;
3775 my($line_count,$last_updated);
3777 my $shift = shift(@lines);
3778 last if $shift =~ /^\s*$/;
3779 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
3780 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
3782 CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
3783 if (not defined $line_count) {
3785 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
3786 Please check the validity of the index file by comparing it to more
3787 than one CPAN mirror. I'll continue but problems seem likely to
3791 $CPAN::Frontend->mysleep(5);
3792 } elsif ($line_count != scalar @lines) {
3794 $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
3795 contains a Line-Count header of %d but I see %d lines there. Please
3796 check the validity of the index file by comparing it to more than one
3797 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
3798 $index_target, $line_count, scalar(@lines));
3801 if (not defined $last_updated) {
3803 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
3804 Please check the validity of the index file by comparing it to more
3805 than one CPAN mirror. I'll continue but problems seem likely to
3809 $CPAN::Frontend->mysleep(5);
3813 ->myprint(sprintf qq{ Database was generated on %s\n},
3815 $DATE_OF_02 = $last_updated;
3818 if ($CPAN::META->has_inst('HTTP::Date')) {
3820 $age -= HTTP::Date::str2time($last_updated);
3822 $CPAN::Frontend->mywarn(" HTTP::Date not available\n");
3823 require Time::Local;
3824 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
3825 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
3826 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
3833 qq{Warning: This index file is %d days old.
3834 Please check the host you chose as your CPAN mirror for staleness.
3835 I'll continue but problems seem likely to happen.\a\n},
3838 } elsif ($age < -1) {
3842 qq{Warning: Your system date is %d days behind this index file!
3844 Timestamp index file: %s
3845 Please fix your system time, problems with the make command expected.\n},
3855 # A necessity since we have metadata_cache: delete what isn't
3857 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
3858 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
3861 my $modulus = int($#lines/75) || 1;
3863 # before 1.56 we split into 3 and discarded the rest. From
3864 # 1.57 we assign remaining text to $comment thus allowing to
3865 # influence isa_perl
3866 my($mod,$version,$dist,$comment) = split " ", $_, 4;
3867 my($bundle,$id,$userid);
3869 if ($mod eq 'CPAN' &&
3871 CPAN::Queue->exists('Bundle::CPAN') ||
3872 CPAN::Queue->exists('CPAN')
3876 if ($version > $CPAN::VERSION){
3877 $CPAN::Frontend->mywarn(qq{
3878 New CPAN.pm version (v$version) available.
3879 [Currently running version is v$CPAN::VERSION]
3880 You might want to try
3883 to both upgrade CPAN.pm and run the new version without leaving
3884 the current session.
3887 $CPAN::Frontend->mysleep(2);
3888 $CPAN::Frontend->myprint(qq{\n});
3890 last if $CPAN::Signal;
3891 } elsif ($mod =~ /^Bundle::(.*)/) {
3896 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
3897 # Let's make it a module too, because bundles have so much
3898 # in common with modules.
3900 # Changed in 1.57_63: seems like memory bloat now without
3901 # any value, so commented out
3903 # $CPAN::META->instance('CPAN::Module',$mod);
3907 # instantiate a module object
3908 $id = $CPAN::META->instance('CPAN::Module',$mod);
3912 # Although CPAN prohibits same name with different version the
3913 # indexer may have changed the version for the same distro
3914 # since the last time ("Force Reindexing" feature)
3915 if ($id->cpan_file ne $dist
3917 $id->cpan_version ne $version
3919 $userid = $id->userid || $self->userid($dist);
3921 'CPAN_USERID' => $userid,
3922 'CPAN_VERSION' => $version,
3923 'CPAN_FILE' => $dist,
3927 # instantiate a distribution object
3928 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
3929 # we do not need CONTAINSMODS unless we do something with
3930 # this dist, so we better produce it on demand.
3932 ## my $obj = $CPAN::META->instance(
3933 ## 'CPAN::Distribution' => $dist
3935 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
3937 $CPAN::META->instance(
3938 'CPAN::Distribution' => $dist
3940 'CPAN_USERID' => $userid,
3941 'CPAN_COMMENT' => $comment,
3945 for my $name ($mod,$dist) {
3946 # $self->debug("exists name[$name]") if $CPAN::DEBUG;
3947 $exists{$name} = undef;
3950 $CPAN::Frontend->myprint(".") unless $i++ % $modulus;
3951 return if $CPAN::Signal;
3953 $CPAN::Frontend->myprint("DONE\n");
3955 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
3956 for my $o ($CPAN::META->all_objects($class)) {
3957 next if exists $exists{$o->{ID}};
3958 $CPAN::META->delete($class,$o->{ID});
3959 # CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
3966 #-> sub CPAN::Index::rd_modlist ;
3968 my($cl,$index_target) = @_;
3969 return unless defined $index_target;
3970 $CPAN::Frontend->myprint("Going to read $index_target\n");
3971 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3975 while (my $bytes = $fh->READ(\$chunk,8192)) {
3978 my @eval2 = split /\012/, $slurp;
3981 my $shift = shift(@eval2);
3982 if ($shift =~ /^Date:\s+(.*)/){
3983 if ($DATE_OF_03 eq $1){
3984 $CPAN::Frontend->myprint("Unchanged.\n");
3989 last if $shift =~ /^\s*$/;
3991 push @eval2, q{CPAN::Modulelist->data;};
3993 my($comp) = Safe->new("CPAN::Safe1");
3994 my($eval2) = join("\n", @eval2);
3995 CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
3996 my $ret = $comp->reval($eval2);
3997 Carp::confess($@) if $@;
3998 return if $CPAN::Signal;
4000 my $until = keys(%$ret) - 1;
4001 my $modulus = int($until/75) || 1;
4002 CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
4004 my $obj = $CPAN::META->instance("CPAN::Module",$_);
4005 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
4006 $obj->set(%{$ret->{$_}});
4007 $CPAN::Frontend->myprint(".") unless $i++ % $modulus;
4008 return if $CPAN::Signal;
4010 $CPAN::Frontend->myprint("DONE\n");
4013 #-> sub CPAN::Index::write_metadata_cache ;
4014 sub write_metadata_cache {
4016 return unless $CPAN::Config->{'cache_metadata'};
4017 return unless $CPAN::META->has_usable("Storable");
4019 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
4020 CPAN::Distribution)) {
4021 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
4023 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4024 $cache->{last_time} = $LAST_TIME;
4025 $cache->{DATE_OF_02} = $DATE_OF_02;
4026 $cache->{PROTOCOL} = PROTOCOL;
4027 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
4028 eval { Storable::nstore($cache, $metadata_file) };
4029 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4032 #-> sub CPAN::Index::read_metadata_cache ;
4033 sub read_metadata_cache {
4035 return unless $CPAN::Config->{'cache_metadata'};
4036 return unless $CPAN::META->has_usable("Storable");
4037 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4038 return unless -r $metadata_file and -f $metadata_file;
4039 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
4041 eval { $cache = Storable::retrieve($metadata_file) };
4042 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4043 if (!$cache || !UNIVERSAL::isa($cache, 'HASH')){
4047 if (exists $cache->{PROTOCOL}) {
4048 if (PROTOCOL > $cache->{PROTOCOL}) {
4049 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
4050 "with protocol v%s, requiring v%s\n",
4057 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
4058 "with protocol v1.0\n");
4063 while(my($class,$v) = each %$cache) {
4064 next unless $class =~ /^CPAN::/;
4065 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
4066 while (my($id,$ro) = each %$v) {
4067 $CPAN::META->{readwrite}{$class}{$id} ||=
4068 $class->new(ID=>$id, RO=>$ro);
4073 unless ($clcnt) { # sanity check
4074 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
4077 if ($idcnt < 1000) {
4078 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
4079 "in $metadata_file\n");
4082 $CPAN::META->{PROTOCOL} ||=
4083 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
4084 # does initialize to some protocol
4085 $LAST_TIME = $cache->{last_time};
4086 $DATE_OF_02 = $cache->{DATE_OF_02};
4087 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
4088 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
4092 package CPAN::InfoObj;
4097 exists $self->{RO} and return $self->{RO};
4102 my $ro = $self->ro or return "N/A"; # N/A for bundles found locally
4103 return $ro->{CPAN_USERID} || "N/A";
4106 sub id { shift->{ID}; }
4108 #-> sub CPAN::InfoObj::new ;
4110 my $this = bless {}, shift;
4115 # The set method may only be used by code that reads index data or
4116 # otherwise "objective" data from the outside world. All session
4117 # related material may do anything else with instance variables but
4118 # must not touch the hash under the RO attribute. The reason is that
4119 # the RO hash gets written to Metadata file and is thus persistent.
4121 #-> sub CPAN::InfoObj::safe_chdir ;
4123 my($self,$todir) = @_;
4124 # we die if we cannot chdir and we are debuggable
4125 Carp::confess("safe_chdir called without todir argument")
4126 unless defined $todir and length $todir;
4128 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4132 unless (-x $todir) {
4133 unless (chmod 0755, $todir) {
4134 my $cwd = CPAN::anycwd();
4135 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
4136 "permission to change the permission; cannot ".
4137 "chdir to '$todir'\n");
4138 $CPAN::Frontend->mysleep(5);
4139 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4140 qq{to todir[$todir]: $!});
4144 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
4147 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4150 my $cwd = CPAN::anycwd();
4151 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4152 qq{to todir[$todir] (a chmod has been issued): $!});
4157 #-> sub CPAN::InfoObj::set ;
4159 my($self,%att) = @_;
4160 my $class = ref $self;
4162 # This must be ||=, not ||, because only if we write an empty
4163 # reference, only then the set method will write into the readonly
4164 # area. But for Distributions that spring into existence, maybe
4165 # because of a typo, we do not like it that they are written into
4166 # the readonly area and made permanent (at least for a while) and
4167 # that is why we do not "allow" other places to call ->set.
4168 unless ($self->id) {
4169 CPAN->debug("Bug? Empty ID, rejecting");
4172 my $ro = $self->{RO} =
4173 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
4175 while (my($k,$v) = each %att) {
4180 #-> sub CPAN::InfoObj::as_glimpse ;
4184 my $class = ref($self);
4185 $class =~ s/^CPAN:://;
4186 my $id = $self->can("pretty_id") ? $self->pretty_id : $self->{ID};
4187 push @m, sprintf "%-15s %s\n", $class, $id;
4191 #-> sub CPAN::InfoObj::as_string ;
4195 my $class = ref($self);
4196 $class =~ s/^CPAN:://;
4197 push @m, $class, " id = $self->{ID}\n";
4199 unless ($ro = $self->ro) {
4200 $CPAN::Frontend->mydie("Unknown object $self->{ID}");
4202 for (sort keys %$ro) {
4203 # next if m/^(ID|RO)$/;
4205 if ($_ eq "CPAN_USERID") {
4207 $extra .= $self->fullname;
4208 my $email; # old perls!
4209 if ($email = $CPAN::META->instance("CPAN::Author",
4212 $extra .= " <$email>";
4214 $extra .= " <no email>";
4217 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
4218 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
4221 next unless defined $ro->{$_};
4222 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
4224 for (sort keys %$self) {
4225 next if m/^(ID|RO)$/;
4226 if (ref($self->{$_}) eq "ARRAY") {
4227 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
4228 } elsif (ref($self->{$_}) eq "HASH") {
4232 join(" ",sort keys %{$self->{$_}}),
4235 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
4241 #-> sub CPAN::InfoObj::fullname ;
4244 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
4247 #-> sub CPAN::InfoObj::dump ;
4249 my($self, $what) = @_;
4250 unless ($CPAN::META->has_inst("Data::Dumper")) {
4251 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
4253 local $Data::Dumper::Sortkeys;
4254 $Data::Dumper::Sortkeys = 1;
4255 my $out = Data::Dumper::Dumper($what ? eval $what : $self);
4256 if (length $out > 100000) {
4257 my $fh_pager = FileHandle->new;
4258 local($SIG{PIPE}) = "IGNORE";
4259 my $pager = $CPAN::Config->{'pager'} || "cat";
4260 $fh_pager->open("|$pager")
4261 or die "Could not open pager $pager\: $!";
4262 $fh_pager->print($out);
4265 $CPAN::Frontend->myprint($out);
4269 package CPAN::Author;
4272 #-> sub CPAN::Author::force
4278 #-> sub CPAN::Author::force
4281 delete $self->{force};
4284 #-> sub CPAN::Author::id
4287 my $id = $self->{ID};
4288 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
4292 #-> sub CPAN::Author::as_glimpse ;
4296 my $class = ref($self);
4297 $class =~ s/^CPAN:://;
4298 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
4306 #-> sub CPAN::Author::fullname ;
4308 shift->ro->{FULLNAME};
4312 #-> sub CPAN::Author::email ;
4313 sub email { shift->ro->{EMAIL}; }
4315 #-> sub CPAN::Author::ls ;
4318 my $glob = shift || "";
4319 my $silent = shift || 0;
4322 # adapted from CPAN::Distribution::verifyCHECKSUM ;
4323 my(@csf); # chksumfile
4324 @csf = $self->id =~ /(.)(.)(.*)/;
4325 $csf[1] = join "", @csf[0,1];
4326 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
4328 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
4329 unless (grep {$_->[2] eq $csf[1]} @dl) {
4330 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
4333 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
4334 unless (grep {$_->[2] eq $csf[2]} @dl) {
4335 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
4338 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
4340 if ($CPAN::META->has_inst("Text::Glob")) {
4341 my $rglob = Text::Glob::glob_to_regex($glob);
4342 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
4344 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
4347 $CPAN::Frontend->myprint(join "", map {
4348 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
4349 } sort { $a->[2] cmp $b->[2] } @dl);
4353 # returns an array of arrays, the latter contain (size,mtime,filename)
4354 #-> sub CPAN::Author::dir_listing ;
4357 my $chksumfile = shift;
4358 my $recursive = shift;
4359 my $may_ftp = shift;
4362 File::Spec->catfile($CPAN::Config->{keep_source_where},
4363 "authors", "id", @$chksumfile);
4367 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
4368 # hazard. (Without GPG installed they are not that much better,
4370 $fh = FileHandle->new;
4371 if (open($fh, $lc_want)) {
4372 my $line = <$fh>; close $fh;
4373 unlink($lc_want) unless $line =~ /PGP/;
4377 # connect "force" argument with "index_expire".
4378 my $force = $self->{force};
4379 if (my @stat = stat $lc_want) {
4380 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
4384 $lc_file = CPAN::FTP->localize(
4385 "authors/id/@$chksumfile",
4390 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
4391 $chksumfile->[-1] .= ".gz";
4392 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
4395 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
4396 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
4402 $lc_file = $lc_want;
4403 # we *could* second-guess and if the user has a file: URL,
4404 # then we could look there. But on the other hand, if they do
4405 # have a file: URL, wy did they choose to set
4406 # $CPAN::Config->{show_upload_date} to false?
4409 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
4410 $fh = FileHandle->new;
4412 if (open $fh, $lc_file){
4415 $eval =~ s/\015?\012/\n/g;
4417 my($comp) = Safe->new();
4418 $cksum = $comp->reval($eval);
4420 rename $lc_file, "$lc_file.bad";
4421 Carp::confess($@) if $@;
4423 } elsif ($may_ftp) {
4424 Carp::carp "Could not open '$lc_file' for reading.";
4426 # Maybe should warn: "You may want to set show_upload_date to a true value"
4430 for $f (sort keys %$cksum) {
4431 if (exists $cksum->{$f}{isdir}) {
4433 my(@dir) = @$chksumfile;
4435 push @dir, $f, "CHECKSUMS";
4437 [$_->[0], $_->[1], "$f/$_->[2]"]
4438 } $self->dir_listing(\@dir,1,$may_ftp);
4440 push @result, [ 0, "-", $f ];
4444 ($cksum->{$f}{"size"}||0),
4445 $cksum->{$f}{"mtime"}||"---",
4453 package CPAN::Distribution;
4459 my $ro = $self->ro or return;
4463 # CPAN::Distribution::undelay
4466 delete $self->{later};
4469 # add the A/AN/ stuff
4470 # CPAN::Distribution::normalize
4473 $s = $self->id unless defined $s;
4477 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
4479 return $s if $s =~ m:^N/A|^Contact Author: ;
4480 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
4481 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
4482 CPAN->debug("s[$s]") if $CPAN::DEBUG;
4487 #-> sub CPAN::Distribution::author ;
4490 my($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
4491 CPAN::Shell->expand("Author",$authorid);
4494 # tries to get the yaml from CPAN instead of the distro itself:
4495 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
4498 my $meta = $self->pretty_id;
4499 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
4500 my(@ls) = CPAN::Shell->globls($meta);
4501 my $norm = $self->normalize($meta);
4505 File::Spec->catfile(
4506 $CPAN::Config->{keep_source_where},
4511 $self->debug("Doing localize") if $CPAN::DEBUG;
4512 unless ($local_file =
4513 CPAN::FTP->localize("authors/id/$norm",
4515 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
4517 my $yaml = CPAN->_yaml_loadfile($local_file);
4520 #-> sub CPAN::Distribution::pretty_id
4524 return $id unless $id =~ m|^./../|;
4528 # mark as dirty/clean
4529 #-> sub CPAN::Distribution::color_cmd_tmps ;
4530 sub color_cmd_tmps {
4532 my($depth) = shift || 0;
4533 my($color) = shift || 0;
4534 my($ancestors) = shift || [];
4535 # a distribution needs to recurse into its prereq_pms
4537 return if exists $self->{incommandcolor}
4538 && $self->{incommandcolor}==$color;
4540 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
4542 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
4543 my $prereq_pm = $self->prereq_pm;
4544 if (defined $prereq_pm) {
4545 PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
4546 keys %{$prereq_pm->{build_requires}||{}}) {
4547 next PREREQ if $pre eq "perl";
4549 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
4550 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
4551 $CPAN::Frontend->mysleep(2);
4554 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
4558 delete $self->{sponsored_mods};
4559 delete $self->{badtestcnt};
4561 $self->{incommandcolor} = $color;
4564 #-> sub CPAN::Distribution::as_string ;
4567 $self->containsmods;
4569 $self->SUPER::as_string(@_);
4572 #-> sub CPAN::Distribution::containsmods ;
4575 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
4576 my $dist_id = $self->{ID};
4577 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
4578 my $mod_file = $mod->cpan_file or next;
4579 my $mod_id = $mod->{ID} or next;
4580 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
4582 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
4584 keys %{$self->{CONTAINSMODS}};
4587 #-> sub CPAN::Distribution::upload_date ;
4590 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
4591 my(@local_wanted) = split(/\//,$self->id);
4592 my $filename = pop @local_wanted;
4593 push @local_wanted, "CHECKSUMS";
4594 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
4595 return unless $author;
4596 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
4598 my($dirent) = grep { $_->[2] eq $filename } @dl;
4599 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
4600 return unless $dirent->[1];
4601 return $self->{UPLOAD_DATE} = $dirent->[1];
4604 #-> sub CPAN::Distribution::uptodate ;
4608 foreach $c ($self->containsmods) {
4609 my $obj = CPAN::Shell->expandany($c);
4610 unless ($obj->uptodate){
4611 my $id = $self->pretty_id;
4612 $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG;
4619 #-> sub CPAN::Distribution::called_for ;
4622 $self->{CALLED_FOR} = $id if defined $id;
4623 return $self->{CALLED_FOR};
4626 #-> sub CPAN::Distribution::get ;
4631 exists $self->{'build_dir'} and push @e,
4632 "Is already unwrapped into directory $self->{'build_dir'}";
4633 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4635 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
4638 # Get the file on local disk
4643 File::Spec->catfile(
4644 $CPAN::Config->{keep_source_where},
4647 split(/\//,$self->id)
4650 $self->debug("Doing localize") if $CPAN::DEBUG;
4651 unless ($local_file =
4652 CPAN::FTP->localize("authors/id/$self->{ID}",
4655 if ($CPAN::Index::DATE_OF_02) {
4656 $note = "Note: Current database in memory was generated ".
4657 "on $CPAN::Index::DATE_OF_02\n";
4659 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
4661 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4662 $self->{localfile} = $local_file;
4663 return if $CPAN::Signal;
4668 if ($CPAN::META->has_inst("Digest::SHA")) {
4669 $self->debug("Digest::SHA is installed, verifying");
4670 $self->verifyCHECKSUM;
4672 $self->debug("Digest::SHA is NOT installed");
4674 return if $CPAN::Signal;
4677 # Create a clean room and go there
4679 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
4680 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
4681 $self->safe_chdir($builddir);
4682 $self->debug("Removing tmp") if $CPAN::DEBUG;
4683 File::Path::rmtree("tmp");
4684 unless (mkdir "tmp", 0755) {
4685 $CPAN::Frontend->unrecoverable_error(<<EOF);
4686 Couldn't mkdir '$builddir/tmp': $!
4688 Cannot continue: Please find the reason why I cannot make the
4691 and fix the problem, then retry.
4696 $self->safe_chdir($sub_wd);
4699 $self->safe_chdir("tmp");
4704 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4705 my $ct = CPAN::Tarzip->new($local_file);
4706 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
4707 $self->{was_uncompressed}++ unless $ct->gtest();
4708 $self->untar_me($ct);
4709 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
4710 $self->unzip_me($ct);
4712 $self->{was_uncompressed}++ unless $ct->gtest();
4713 $self->debug("calling pm2dir for local_file[$local_file]")
4715 $local_file = $self->handle_singlefile($local_file);
4717 # $self->{archived} = "NO";
4718 # $self->safe_chdir($sub_wd);
4722 # we are still in the tmp directory!
4723 # Let's check if the package has its own directory.
4724 my $dh = DirHandle->new(File::Spec->curdir)
4725 or Carp::croak("Couldn't opendir .: $!");
4726 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
4728 my ($distdir,$packagedir);
4729 if (@readdir == 1 && -d $readdir[0]) {
4730 $distdir = $readdir[0];
4731 $packagedir = File::Spec->catdir($builddir,$distdir);
4732 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
4734 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
4736 File::Path::rmtree($packagedir);
4737 unless (File::Copy::move($distdir,$packagedir)) {
4738 $CPAN::Frontend->unrecoverable_error(<<EOF);
4739 Couldn't move '$distdir' to '$packagedir': $!
4741 Cannot continue: Please find the reason why I cannot move
4742 $builddir/tmp/$distdir
4745 and fix the problem, then retry
4749 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
4756 my $userid = $self->cpan_userid;
4758 CPAN->debug("no userid? self[$self]");
4761 my $pragmatic_dir = $userid . '000';
4762 $pragmatic_dir =~ s/\W_//g;
4763 $pragmatic_dir++ while -d "../$pragmatic_dir";
4764 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
4765 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
4766 File::Path::mkpath($packagedir);
4768 for $f (@readdir) { # is already without "." and ".."
4769 my $to = File::Spec->catdir($packagedir,$f);
4770 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
4774 $self->safe_chdir($sub_wd);
4778 $self->{'build_dir'} = $packagedir;
4779 $self->safe_chdir($builddir);
4780 File::Path::rmtree("tmp");
4782 $self->safe_chdir($packagedir);
4783 if ($CPAN::Config->{check_sigs}) {
4784 if ($CPAN::META->has_inst("Module::Signature")) {
4785 if (-f "SIGNATURE") {
4786 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
4787 my $rv = Module::Signature::verify();
4788 if ($rv != Module::Signature::SIGNATURE_OK() and
4789 $rv != Module::Signature::SIGNATURE_MISSING()) {
4790 $CPAN::Frontend->myprint(
4791 qq{\nSignature invalid for }.
4792 qq{distribution file. }.
4793 qq{Please investigate.\n\n}.
4795 $CPAN::META->instance(
4802 sprintf(qq{I'd recommend removing %s. Its signature
4803 is invalid. Maybe you have configured your 'urllist' with
4804 a bad URL. Please check this array with 'o conf urllist', and
4805 retry. For more information, try opening a subshell with
4813 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
4814 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
4815 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
4817 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
4818 $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
4821 $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n});
4824 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
4827 $self->safe_chdir($builddir);
4828 return if $CPAN::Signal;
4831 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
4832 my($mpl_exists) = -f $mpl;
4833 unless ($mpl_exists) {
4834 # NFS has been reported to have racing problems after the
4835 # renaming of a directory in some environments.
4837 $CPAN::Frontend->mysleep(1);
4838 my $mpldh = DirHandle->new($packagedir)
4839 or Carp::croak("Couldn't opendir $packagedir: $!");
4840 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
4843 my $prefer_installer = "eumm"; # eumm|mb
4844 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
4845 if ($mpl_exists) { # they *can* choose
4846 if ($CPAN::META->has_inst("Module::Build")) {
4847 $prefer_installer = $CPAN::Config->{prefer_installer};
4850 $prefer_installer = "mb";
4853 if (lc($prefer_installer) eq "mb") {
4854 $self->{modulebuild} = 1;
4855 } elsif (! $mpl_exists) {
4856 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
4860 my($configure) = File::Spec->catfile($packagedir,"Configure");
4861 if (-f $configure) {
4862 # do we have anything to do?
4863 $self->{'configure'} = $configure;
4864 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
4865 $CPAN::Frontend->mywarn(qq{
4866 Package comes with a Makefile and without a Makefile.PL.
4867 We\'ll try to build it with that Makefile then.
4869 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
4870 $CPAN::Frontend->mysleep(2);
4872 my $cf = $self->called_for || "unknown";
4877 $cf =~ s|[/\\:]||g; # risk of filesystem damage
4878 $cf = "unknown" unless length($cf);
4879 $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
4880 (The test -f "$mpl" returned false.)
4881 Writing one on our own (setting NAME to $cf)\a\n});
4882 $self->{had_no_makefile_pl}++;
4883 $CPAN::Frontend->mysleep(3);
4885 # Writing our own Makefile.PL
4888 if ($self->{archived} eq "maybe_pl"){
4889 my $fh = FileHandle->new;
4890 my $script_file = File::Spec->catfile($packagedir,$local_file);
4891 $fh->open($script_file)
4892 or Carp::croak("Could not open $script_file: $!");
4894 # name parsen und prereq
4895 my($state) = "poddir";
4896 my($name, $prereq) = ("", "");
4898 if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
4901 } elsif ($1 eq 'PREREQUISITES') {
4904 } elsif ($state =~ m{^(name|prereq)$}) {
4909 } elsif ($state eq "name") {
4914 } elsif ($state eq "prereq") {
4917 } elsif (/^=cut\b/) {
4924 s{.*<}{}; # strip X<...>
4928 $prereq = join " ", split /\s+/, $prereq;
4929 my($PREREQ_PM) = join("\n", map {
4930 s{.*<}{}; # strip X<...>
4932 if (/[\s\'\"]/) { # prose?
4934 s/[^\w:]$//; # period?
4935 " "x28 . "'$_' => 0,";
4937 } split /\s*,\s*/, $prereq);
4940 EXE_FILES => ['$name'],
4946 my $to_file = File::Spec->catfile($packagedir, $name);
4947 rename $script_file, $to_file
4948 or die "Can't rename $script_file to $to_file: $!";
4951 my $fh = FileHandle->new;
4953 or Carp::croak("Could not open >$mpl: $!");
4955 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
4956 # because there was no Makefile.PL supplied.
4957 # Autogenerated on: }.scalar localtime().qq{
4959 use ExtUtils::MakeMaker;
4961 NAME => q[$cf],$script
4971 # CPAN::Distribution::untar_me ;
4974 $self->{archived} = "tar";
4976 $self->{unwrapped} = "YES";
4978 $self->{unwrapped} = "NO";
4982 # CPAN::Distribution::unzip_me ;
4985 $self->{archived} = "zip";
4987 $self->{unwrapped} = "YES";
4989 $self->{unwrapped} = "NO";
4994 sub handle_singlefile {
4995 my($self,$local_file) = @_;
4997 if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ){
4998 $self->{archived} = "pm";
5000 $self->{archived} = "maybe_pl";
5003 my $to = File::Basename::basename($local_file);
5004 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
5005 if (CPAN::Tarzip->new($local_file)->gunzip($to)) {
5006 $self->{unwrapped} = "YES";
5008 $self->{unwrapped} = "NO";
5011 File::Copy::cp($local_file,".");
5012 $self->{unwrapped} = "YES";
5017 #-> sub CPAN::Distribution::new ;
5019 my($class,%att) = @_;
5021 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
5023 my $this = { %att };
5024 return bless $this, $class;
5027 #-> sub CPAN::Distribution::look ;
5031 if ($^O eq 'MacOS') {
5032 $self->Mac::BuildTools::look;
5036 if ( $CPAN::Config->{'shell'} ) {
5037 $CPAN::Frontend->myprint(qq{
5038 Trying to open a subshell in the build directory...
5041 $CPAN::Frontend->myprint(qq{
5042 Your configuration does not define a value for subshells.
5043 Please define it with "o conf shell <your shell>"
5047 my $dist = $self->id;
5049 unless ($dir = $self->dir) {
5052 unless ($dir ||= $self->dir) {
5053 $CPAN::Frontend->mywarn(qq{
5054 Could not determine which directory to use for looking at $dist.
5058 my $pwd = CPAN::anycwd();
5059 $self->safe_chdir($dir);
5060 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
5062 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
5063 $ENV{CPAN_SHELL_LEVEL} += 1;
5064 my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
5065 unless (system($shell) == 0) {
5067 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
5070 $self->safe_chdir($pwd);
5073 # CPAN::Distribution::cvs_import ;
5077 my $dir = $self->dir;
5079 my $package = $self->called_for;
5080 my $module = $CPAN::META->instance('CPAN::Module', $package);
5081 my $version = $module->cpan_version;
5083 my $userid = $self->cpan_userid;
5085 my $cvs_dir = (split /\//, $dir)[-1];
5086 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
5088 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
5090 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
5091 if ($cvs_site_perl) {
5092 $cvs_dir = "$cvs_site_perl/$cvs_dir";
5094 my $cvs_log = qq{"imported $package $version sources"};
5095 $version =~ s/\./_/g;
5096 # XXX cvs: undocumented and unclear how it was meant to work
5097 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
5098 "$cvs_dir", $userid, "v$version");
5100 my $pwd = CPAN::anycwd();
5101 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
5103 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
5105 $CPAN::Frontend->myprint(qq{@cmd\n});
5106 system(@cmd) == 0 or
5108 $CPAN::Frontend->mydie("cvs import failed");
5109 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
5112 #-> sub CPAN::Distribution::readme ;
5115 my($dist) = $self->id;
5116 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
5117 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
5120 File::Spec->catfile(
5121 $CPAN::Config->{keep_source_where},
5124 split(/\//,"$sans.readme"),
5126 $self->debug("Doing localize") if $CPAN::DEBUG;
5127 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
5129 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
5131 if ($^O eq 'MacOS') {
5132 Mac::BuildTools::launch_file($local_file);
5136 my $fh_pager = FileHandle->new;
5137 local($SIG{PIPE}) = "IGNORE";
5138 my $pager = $CPAN::Config->{'pager'} || "cat";
5139 $fh_pager->open("|$pager")
5140 or die "Could not open pager $pager\: $!";
5141 my $fh_readme = FileHandle->new;
5142 $fh_readme->open($local_file)
5143 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
5144 $CPAN::Frontend->myprint(qq{
5149 $fh_pager->print(<$fh_readme>);
5153 #-> sub CPAN::Distribution::verifyCHECKSUM ;
5154 sub verifyCHECKSUM {
5158 $self->{CHECKSUM_STATUS} ||= "";
5159 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
5160 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5162 my($lc_want,$lc_file,@local,$basename);
5163 @local = split(/\//,$self->id);
5165 push @local, "CHECKSUMS";
5167 File::Spec->catfile($CPAN::Config->{keep_source_where},
5168 "authors", "id", @local);
5170 if (my $size = -s $lc_want) {
5171 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
5172 if ($self->CHECKSUM_check_file($lc_want,1)) {
5173 return $self->{CHECKSUM_STATUS} = "OK";
5176 $lc_file = CPAN::FTP->localize("authors/id/@local",
5179 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
5180 $local[-1] .= ".gz";
5181 $lc_file = CPAN::FTP->localize("authors/id/@local",
5184 $lc_file =~ s/\.gz(?!\n)\Z//;
5185 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
5190 if ($self->CHECKSUM_check_file($lc_file)) {
5191 return $self->{CHECKSUM_STATUS} = "OK";
5195 #-> sub CPAN::Distribution::SIG_check_file ;
5196 sub SIG_check_file {
5197 my($self,$chk_file) = @_;
5198 my $rv = eval { Module::Signature::_verify($chk_file) };
5200 if ($rv == Module::Signature::SIGNATURE_OK()) {
5201 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
5202 return $self->{SIG_STATUS} = "OK";
5204 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
5205 qq{distribution file. }.
5206 qq{Please investigate.\n\n}.
5208 $CPAN::META->instance(
5213 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
5214 is invalid. Maybe you have configured your 'urllist' with
5215 a bad URL. Please check this array with 'o conf urllist', and
5218 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
5222 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
5224 # sloppy is 1 when we have an old checksums file that maybe is good
5227 sub CHECKSUM_check_file {
5228 my($self,$chk_file,$sloppy) = @_;
5229 my($cksum,$file,$basename);
5232 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
5233 if ($CPAN::Config->{check_sigs}) {
5234 if ($CPAN::META->has_inst("Module::Signature") and Module::Signature->VERSION >= 0.26) {
5235 $self->debug("Module::Signature is installed, verifying");
5236 $self->SIG_check_file($chk_file);
5238 $self->debug("Module::Signature is NOT installed");
5242 $file = $self->{localfile};
5243 $basename = File::Basename::basename($file);
5244 my $fh = FileHandle->new;
5245 if (open $fh, $chk_file){
5248 $eval =~ s/\015?\012/\n/g;
5250 my($comp) = Safe->new();
5251 $cksum = $comp->reval($eval);
5253 rename $chk_file, "$chk_file.bad";
5254 Carp::confess($@) if $@;
5257 Carp::carp "Could not open $chk_file for reading";
5260 if (! ref $cksum or ref $cksum ne "HASH") {
5261 $CPAN::Frontend->mywarn(qq{
5262 Warning: checksum file '$chk_file' broken.
5264 When trying to read that file I expected to get a hash reference
5265 for further processing, but got garbage instead.
5267 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
5268 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
5269 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
5271 } elsif (exists $cksum->{$basename}{sha256}) {
5272 $self->debug("Found checksum for $basename:" .
5273 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
5277 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
5279 $fh = CPAN::Tarzip->TIEHANDLE($file);
5282 my $dg = Digest::SHA->new(256);
5285 while ($fh->READ($ref, 4096) > 0){
5288 my $hexdigest = $dg->hexdigest;
5289 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
5293 $CPAN::Frontend->myprint("Checksum for $file ok\n");
5294 return $self->{CHECKSUM_STATUS} = "OK";
5296 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
5297 qq{distribution file. }.
5298 qq{Please investigate.\n\n}.
5300 $CPAN::META->instance(
5305 my $wrap = qq{I\'d recommend removing $file. Its
5306 checksum is incorrect. Maybe you have configured your 'urllist' with
5307 a bad URL. Please check this array with 'o conf urllist', and
5310 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
5312 # former versions just returned here but this seems a
5313 # serious threat that deserves a die
5315 # $CPAN::Frontend->myprint("\n\n");
5319 # close $fh if fileno($fh);
5322 unless ($self->{CHECKSUM_STATUS}) {
5323 $CPAN::Frontend->mywarn(qq{
5324 Warning: No checksum for $basename in $chk_file.
5326 The cause for this may be that the file is very new and the checksum
5327 has not yet been calculated, but it may also be that something is
5328 going awry right now.
5330 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes");
5331 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
5333 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
5338 #-> sub CPAN::Distribution::eq_CHECKSUM ;
5340 my($self,$fh,$expect) = @_;
5341 if ($CPAN::META->has_inst("Digest::SHA")) {
5342 my $dg = Digest::SHA->new(256);
5344 while (read($fh, $data, 4096)){
5347 my $hexdigest = $dg->hexdigest;
5348 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
5349 return $hexdigest eq $expect;
5354 #-> sub CPAN::Distribution::force ;
5356 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
5357 # effect by autoinspection, not by inspecting a global variable. One
5358 # of the reason why this was chosen to work that way was the treatment
5359 # of dependencies. They should not automatically inherit the force
5360 # status. But this has the downside that ^C and die() will return to
5361 # the prompt but will not be able to reset the force_update
5362 # attributes. We try to correct for it currently in the read_metadata
5363 # routine, and immediately before we check for a Signal. I hope this
5364 # works out in one of v1.57_53ff
5366 # "Force get forgets previous error conditions"
5368 #-> sub CPAN::Distribution::force ;
5370 my($self, $method) = @_;
5372 CHECKSUM_STATUS archived build_dir localfile make install unwrapped
5373 writemakefile modulebuild make_test signature_verify
5375 delete $self->{$att};
5377 if ($method && $method =~ /make|test|install/) {
5378 $self->{"force_update"}++; # name should probably have been force_install
5383 my($self, $method) = @_;
5384 # warn "XDEBUG: set notest for $self $method";
5385 $self->{"notest"}++; # name should probably have been force_install
5390 # warn "XDEBUG: deleting notest";
5391 delete $self->{'notest'};
5394 #-> sub CPAN::Distribution::unforce ;
5397 delete $self->{'force_update'};
5400 #-> sub CPAN::Distribution::isa_perl ;
5403 my $file = File::Basename::basename($self->id);
5404 if ($file =~ m{ ^ perl
5417 } elsif ($self->cpan_comment
5419 $self->cpan_comment =~ /isa_perl\(.+?\)/){
5425 #-> sub CPAN::Distribution::perl ;
5430 carp __PACKAGE__ . "::perl was called without parameters.";
5432 return CPAN::HandleConfig->safe_quote($CPAN::Perl);
5436 #-> sub CPAN::Distribution::make ;
5439 my $make = $self->{modulebuild} ? "Build" : "make";
5440 # Emergency brake if they said install Pippi and get newest perl
5441 if ($self->isa_perl) {
5443 $self->called_for ne $self->id &&
5444 ! $self->{force_update}
5446 # if we die here, we break bundles
5449 qq{The most recent version "%s" of the module "%s"
5450 is part of the perl-%s distribution. To install that, you need to run
5451 force install %s --or--
5454 $CPAN::META->instance(
5463 $self->{make} = CPAN::Distrostatus->new("NO isa perl");
5464 $CPAN::Frontend->mysleep(1);
5468 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
5471 delete $self->{force_update};
5476 !$self->{archived} || $self->{archived} eq "NO" and push @e,
5477 "Is neither a tar nor a zip archive.";
5479 !$self->{unwrapped} || $self->{unwrapped} eq "NO" and push @e,
5480 "Had problems unarchiving. Please build manually";
5482 unless ($self->{force_update}) {
5483 exists $self->{signature_verify} and (
5484 $self->{signature_verify}->can("failed") ?
5485 $self->{signature_verify}->failed :
5486 $self->{signature_verify} =~ /^NO/
5488 and push @e, "Did not pass the signature test.";
5491 if (exists $self->{writemakefile} &&
5493 $self->{writemakefile}->can("failed") ?
5494 $self->{writemakefile}->failed :
5495 $self->{writemakefile} =~ /^NO/
5497 # XXX maybe a retry would be in order?
5498 my $err = $self->{writemakefile}->can("text") ?
5499 $self->{writemakefile}->text :
5500 $self->{writemakefile};
5502 $err ||= "Had some problem writing Makefile";
5503 $err .= ", won't make";
5507 defined $self->{make} and push @e,
5508 "Has already been processed within this session";
5510 if (exists $self->{later} and length($self->{later})) {
5511 if ($self->unsat_prereq) {
5512 push @e, $self->{later};
5513 # RT ticket 18438 raises doubts if the deletion of {later} is valid.
5514 # YAML-0.53 triggered the later hodge-podge here, but my margin notes
5515 # are not sufficient to be sure if we really must/may do the delete
5516 # here. SO I accept the suggested patch for now. If we trigger a bug
5517 # again, I must go into deep contemplation about the {later} flag.
5520 # delete $self->{later};
5524 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5527 delete $self->{force_update};
5530 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
5531 my $builddir = $self->dir or
5532 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
5533 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
5534 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
5536 if ($^O eq 'MacOS') {
5537 Mac::BuildTools::make($self);
5542 if ($self->{'configure'}) {
5543 $system = $self->{'configure'};
5544 } elsif ($self->{modulebuild}) {
5545 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5546 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
5548 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5550 # This needs a handler that can be turned on or off:
5551 # $switch = "-MExtUtils::MakeMaker ".
5552 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
5554 my $makepl_arg = $self->make_x_arg("pl");
5555 $system = sprintf("%s%s Makefile.PL%s",
5557 $switch ? " $switch" : "",
5558 $makepl_arg ? " $makepl_arg" : "",
5562 if (my $env = $self->prefs->{pl}{env}) {
5563 for my $e (keys %$env) {
5564 $ENV{$e} = $env->{$e};
5567 if (exists $self->{writemakefile}) {
5569 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
5573 if ($CPAN::Config->{inactivity_timeout}) {
5575 if ($Config::Config{d_alarm}
5577 $Config::Config{d_alarm} eq "define"
5581 $CPAN::Frontend->mywarn("Warning: you have configured the config ".
5582 "variable 'inactivity_timeout' to ".
5583 "'$CPAN::Config->{inactivity_timeout}'. But ".
5584 "on this machine the system call 'alarm' ".
5585 "isn't available. This means that we cannot ".
5586 "provide the feature of intercepting long ".
5587 "waiting code and will turn this feature off.\n"
5589 $CPAN::Config->{inactivity_timeout} = 0;
5592 if ($go_via_alarm) {
5594 alarm $CPAN::Config->{inactivity_timeout};
5595 local $SIG{CHLD}; # = sub { wait };
5596 if (defined($pid = fork)) {
5601 # note, this exec isn't necessary if
5602 # inactivity_timeout is 0. On the Mac I'd
5603 # suggest, we set it always to 0.
5607 $CPAN::Frontend->myprint("Cannot fork: $!");
5616 $CPAN::Frontend->myprint($err);
5617 $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
5622 if (my $expect = $self->prefs->{pl}{expect}) {
5623 $ret = $self->run_via_expect($system,$expect);
5625 $ret = system($system);
5628 $self->{writemakefile} = CPAN::Distrostatus
5629 ->new("NO '$system' returned status $ret");
5630 $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
5634 if (-f "Makefile" || -f "Build") {
5635 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
5636 delete $self->{make_clean}; # if cleaned before, enable next
5638 $self->{writemakefile} = CPAN::Distrostatus
5639 ->new(qq{NO -- Unknown reason.});
5643 delete $self->{force_update};
5646 if (my @prereq = $self->unsat_prereq){
5647 if ($prereq[0][0] eq "perl") {
5648 my $need = "requires perl '$prereq[0][1]'";
5649 my $id = $self->pretty_id;
5650 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
5651 $self->{make} = CPAN::Distrostatus->new("NO $need");
5654 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5658 delete $self->{force_update};
5661 if ($self->{modulebuild}) {
5662 unless (-f "Build") {
5664 $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'".
5665 " in cwd[$cwd]. Danger, Will Robinson!");
5666 $CPAN::Frontend->mysleep(5);
5668 $system = sprintf "%s %s", $self->_build_command(), $CPAN::Config->{mbuild_arg};
5670 $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
5672 my $make_arg = $self->make_x_arg("make");
5673 $system = sprintf("%s%s",
5675 $make_arg ? " $make_arg" : "",
5677 if (my $env = $self->prefs->{make}{env}) { # overriding the local
5678 # ENV of PL, not the
5680 # unlikely to be a risk
5681 for my $e (keys %$env) {
5682 $ENV{$e} = $env->{$e};
5685 if (system($system) == 0) {
5686 $CPAN::Frontend->myprint(" $system -- OK\n");
5687 $self->{make} = CPAN::Distrostatus->new("YES");
5689 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
5690 $self->{make} = CPAN::Distrostatus->new("NO");
5691 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
5695 # CPAN::Distribution::run_via_expect
5696 sub run_via_expect {
5697 my($self,$system,$expect) = @_;
5698 CPAN->debug("system[$system]expect[$expect]") if $CPAN::DEBUG;
5699 if ($CPAN::META->has_inst("Expect")) {
5700 my $expo = Expect->new;
5701 $expo->spawn($system);
5702 EXPECT: for (my $i = 0; $i < $#$expect; $i+=2) {
5703 my $regex = eval "qr{$expect->[$i]}";
5704 my $send = $expect->[$i+1];
5707 my $but = $expo->clear_accum;
5708 $CPAN::Frontend->mywarn("EOF (maybe harmless) system[$system]
5709 expected[$regex]\nbut[$but]\n\n");
5713 my $but = $expo->clear_accum;
5714 $CPAN::Frontend->mydie("TIMEOUT system[$system]
5715 expected[$regex]\nbut[$but]\n\n");
5721 return $expo->exitstatus();
5723 $CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n");
5724 return system($system);
5728 # CPAN::Distribution::_find_prefs
5730 my($self,$distro) = @_;
5731 my $distroid = $distro->pretty_id;
5732 CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
5733 my $prefs_dir = $CPAN::Config->{prefs_dir};
5734 eval { File::Path::mkpath($prefs_dir); };
5736 $CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
5738 my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
5739 if ($CPAN::META->has_inst($yaml_module)) {
5740 my $dh = DirHandle->new($prefs_dir)
5741 or die Carp::croak("Couldn't open '$prefs_dir': $!");
5742 DIRENT: for (sort $dh->read) {
5743 next if $_ eq "." || $_ eq "..";
5744 next unless /\.yml$/;
5745 my $abs = File::Spec->catfile($prefs_dir, $_);
5746 CPAN->debug("abs[$abs]") if $CPAN::DEBUG;
5748 my $yaml = CPAN->_yaml_loadfile($abs);
5750 my $match = $yaml->{match} or
5751 $CPAN::Frontend->mydie("Nonconforming YAML file '$abs': ".
5752 "missing attribut 'match'. Please ".
5753 "remove, cannot continue.");
5754 for my $sub_attribute (keys %$match) {
5755 my $qr = eval "qr{$yaml->{match}{$sub_attribute}}";
5756 if ($sub_attribute eq "module") {
5758 my @modules = $distro->containsmods;
5759 for my $module (@modules) {
5760 $okm ||= $module =~ /$qr/;
5764 } elsif ($sub_attribute eq "distribution") {
5765 my $okd = $distroid =~ /$qr/;
5768 $CPAN::Frontend->mydie("Nonconforming YAML file '$abs': ".
5769 "unknown sub_attribut '$sub_attribute'. ".
5771 "remove, cannot continue.");
5783 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot read prefs '$prefs_dir'\n");
5788 # CPAN::Distribution::prefs
5791 if (exists $self->{prefs}) {
5792 return $self->{prefs}; # XXX comment out during debugging
5794 if ($CPAN::Config->{prefs_dir}) {
5795 CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG;
5796 my $prefs = $self->_find_prefs($self);
5798 for my $x (qw(prefs prefs_file)) {
5799 $self->{$x} = $prefs->{$x};
5801 my $basename = File::Basename::basename($self->{prefs_file});
5802 my $filler1 = "_" x 22;
5803 my $filler2 = int(66 - length($basename))/2;
5804 $filler2 = 0 if $filler2 < 0;
5805 $filler2 = " " x $filler2;
5806 $CPAN::Frontend->myprint("
5807 $filler1 D i s t r o P r e f s $filler1
5808 $filler2 $basename $filler2
5810 $CPAN::Frontend->mysleep(1);
5811 return $self->{prefs};
5817 # CPAN::Distribution::make_x_arg
5819 my($self, $whixh) = @_;
5821 my $prefs = $self->prefs;
5824 && exists $prefs->{$whixh}
5825 && exists $prefs->{$whixh}{args}
5826 && $prefs->{$whixh}{args}
5828 $make_x_arg = join(" ",
5829 map {CPAN::HandleConfig
5830 ->safe_quote($_)} @{$prefs->{$whixh}{args}},
5833 my $what = sprintf "make%s_arg", $whixh eq "make" ? "" : $whixh;
5834 $make_x_arg ||= $CPAN::Config->{$what};
5838 # CPAN::Distribution::_make_command
5845 $self->prefs->{cpanconfig}{make}
5846 || $CPAN::Config->{make}
5847 || $Config::Config{make}
5851 # Old style call, without object. Deprecated
5852 Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
5855 $self->prefs->{cpanconfig}{make}
5856 || $CPAN::Config->{make}
5857 || $Config::Config{make}
5862 #-> sub CPAN::Distribution::follow_prereqs ;
5863 sub follow_prereqs {
5865 my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_;
5866 return unless @prereq_tuples;
5867 my @prereq = map { $_->[0] } @prereq_tuples;
5870 b => "build_requires",
5875 myprint("---- Unsatisfied dependencies detected during\n".
5877 join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @prereq_tuples),
5880 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
5882 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
5883 my $answer = CPAN::Shell::colorable_makemaker_prompt(
5884 "Shall I follow them and prepend them to the queue
5885 of modules we are processing right now?", "yes");
5886 $follow = $answer =~ /^\s*y/i;
5890 myprint(" Ignoring dependencies on modules @prereq\n");
5893 # color them as dirty
5894 for my $p (@prereq) {
5895 # warn "calling color_cmd_tmps(0,1)";
5896 CPAN::Shell->expandany($p)->color_cmd_tmps(0,1);
5898 # queue them and re-queue yourself
5899 CPAN::Queue->jumpqueue([$id,$self->{reqtype}],
5900 reverse @prereq_tuples);
5901 $self->{later} = "Delayed until after prerequisites";
5902 return 1; # signal success to the queuerunner
5906 #-> sub CPAN::Distribution::unsat_prereq ;
5907 # return ([Foo=>1],[Bar=>1.2]) for normal modules
5908 # return ([perl=>5.008]) if we need a newer perl than we are running under
5911 my $prereq_pm = $self->prereq_pm or return;
5913 my %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
5914 NEED: while (my($need_module, $need_version) = each %merged) {
5915 my($have_version,$inst_file);
5916 if ($need_module eq "perl") {
5920 my $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
5921 next if $nmo->uptodate;
5922 $inst_file = $nmo->inst_file;
5924 # if they have not specified a version, we accept any installed one
5925 if (not defined $need_version or
5926 $need_version eq "0" or
5927 $need_version eq "undef") {
5928 next if defined $inst_file;
5931 $have_version = $nmo->inst_version;
5934 # We only want to install prereqs if either they're not installed
5935 # or if the installed version is too old. We cannot omit this
5936 # check, because if 'force' is in effect, nobody else will check.
5937 if (defined $inst_file) {
5938 my(@all_requirements) = split /\s*,\s*/, $need_version;
5941 RQ: for my $rq (@all_requirements) {
5942 if ($rq =~ s|>=\s*||) {
5943 } elsif ($rq =~ s|>\s*||) {
5945 if (CPAN::Version->vgt($have_version,$rq)){
5949 } elsif ($rq =~ s|!=\s*||) {
5951 if (CPAN::Version->vcmp($have_version,$rq)){
5957 } elsif ($rq =~ m|<=?\s*|) {
5959 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])");
5963 if (! CPAN::Version->vgt($rq, $have_version)){
5966 CPAN->debug(sprintf("need_module[%s]inst_file[%s]".
5967 "inst_version[%s]rq[%s]ok[%d]",
5971 CPAN::Version->readable($rq),
5975 next NEED if $ok == @all_requirements;
5978 if ($need_module eq "perl") {
5979 return ["perl", $need_version];
5981 if ($self->{sponsored_mods}{$need_module}++){
5982 # We have already sponsored it and for some reason it's still
5983 # not available. So we do nothing. Or what should we do?
5984 # if we push it again, we have a potential infinite loop
5987 my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
5988 push @need, [$need_module,$needed_as];
5993 #-> sub CPAN::Distribution::read_yaml ;
5996 return $self->{yaml_content} if exists $self->{yaml_content};
5997 my $build_dir = $self->{build_dir};
5998 my $yaml = File::Spec->catfile($build_dir,"META.yml");
5999 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
6000 return unless -f $yaml;
6001 eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml); };
6003 return; # if we die, then we cannot read our own META.yml
6005 if (not exists $self->{yaml_content}{dynamic_config}
6006 or $self->{yaml_content}{dynamic_config}
6008 $self->{yaml_content} = undef;
6010 $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
6012 return $self->{yaml_content};
6015 #-> sub CPAN::Distribution::prereq_pm ;
6018 return $self->{prereq_pm} if
6019 exists $self->{prereq_pm_detected} && $self->{prereq_pm_detected};
6020 return unless $self->{writemakefile} # no need to have succeeded
6021 # but we must have run it
6022 || $self->{modulebuild};
6024 if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
6025 $req = $yaml->{requires} || {};
6026 $breq = $yaml->{build_requires} || {};
6027 undef $req unless ref $req eq "HASH" && %$req;
6029 if ($yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
6030 my $eummv = do { local $^W = 0; $1+0; };
6031 if ($eummv < 6.2501) {
6032 # thanks to Slaven for digging that out: MM before
6033 # that could be wrong because it could reflect a
6040 while (my($k,$v) = each %{$req||{}}) {
6043 } elsif ($k =~ /[A-Za-z]/ &&
6045 $CPAN::META->exists("Module",$v)
6047 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
6048 "requires hash: $k => $v; I'll take both ".
6049 "key and value as a module name\n");
6050 $CPAN::Frontend->mysleep(1);
6056 $req = $areq if $do_replace;
6059 unless ($req || $breq) {
6060 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
6061 my $makefile = File::Spec->catfile($build_dir,"Makefile");
6065 $fh = FileHandle->new("<$makefile\0")) {
6068 last if /MakeMaker post_initialize section/;
6070 \s+PREREQ_PM\s+=>\s+(.+)
6073 # warn "Found prereq expr[$p]";
6075 # Regexp modified by A.Speer to remember actual version of file
6076 # PREREQ_PM hash key wants, then add to
6077 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){
6078 # In case a prereq is mentioned twice, complain.
6079 if ( defined $req->{$1} ) {
6080 warn "Warning: PREREQ_PM mentions $1 more than once, ".
6081 "last mention wins";
6087 } elsif (-f "Build") {
6088 if ($CPAN::META->has_inst("Module::Build")) {
6090 $req = Module::Build->current->requires();
6091 $breq = Module::Build->current->build_requires();
6094 # HTML::Mason prompted for this with bleadperl@28900 or so
6097 sprintf("Warning: while trying to determine ".
6098 "prerequisites for %s with the help of ".
6099 "Module::Build the following error ".
6100 "occurred: '%s'\n\nCannot care for prerequisites\n",
6104 $self->{prereq_pm_detected}++;
6105 return $self->{prereq_pm} = {requires=>{},build_requires=>{}};
6111 && ! -f "Makefile.PL"
6112 && ! exists $req->{"Module::Build"}
6113 && ! $CPAN::META->has_inst("Module::Build")) {
6114 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
6115 "undeclared prerequisite.\n".
6116 " Adding it now as such.\n"
6118 $CPAN::Frontend->mysleep(5);
6119 $req->{"Module::Build"} = 0;
6120 delete $self->{writemakefile};
6122 $self->{prereq_pm_detected}++;
6123 return $self->{prereq_pm} = { requires => $req, build_requires => $breq };
6126 #-> sub CPAN::Distribution::test ;
6131 delete $self->{force_update};
6134 # warn "XDEBUG: checking for notest: $self->{notest} $self";
6135 if ($self->{notest}) {
6136 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
6140 my $make = $self->{modulebuild} ? "Build" : "make";
6141 $CPAN::Frontend->myprint("Running $make test\n");
6142 if (my @prereq = $self->unsat_prereq){
6143 unless ($prereq[0][0] eq "perl") {
6144 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
6149 unless (exists $self->{make} or exists $self->{later}) {
6151 "Make had some problems, won't test";
6154 exists $self->{make} and
6156 $self->{make}->can("failed") ?
6157 $self->{make}->failed :
6158 $self->{make} =~ /^NO/
6159 ) and push @e, "Can't test without successful make";
6161 $self->{badtestcnt} ||= 0;
6162 $self->{badtestcnt} > 0 and
6163 push @e, "Won't repeat unsuccessful test during this command";
6165 exists $self->{later} and length($self->{later}) and
6166 push @e, $self->{later};
6168 if (exists $self->{build_dir}) {
6169 if ($CPAN::META->{is_tested}{$self->{build_dir}}
6171 exists $self->{make_test}
6174 $self->{make_test}->can("failed") ?
6175 $self->{make_test}->failed :
6176 $self->{make_test} =~ /^NO/
6179 push @e, "Already tested successfully";
6182 push @e, "Has no own directory";
6185 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6187 chdir $self->{'build_dir'} or
6188 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
6189 $self->debug("Changed directory to $self->{'build_dir'}")
6192 if ($^O eq 'MacOS') {
6193 Mac::BuildTools::make_test($self);
6197 if ($self->{modulebuild}) {
6198 my $v = CPAN::Shell->expand("Module","Test::Harness")->inst_version;
6199 if (CPAN::Version->vlt($v,2.62)) {
6200 $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only
6201 '$v', you need at least '2.62'. Please upgrade your Test::Harness.\n});
6202 $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old");
6207 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
6209 : ($ENV{PERLLIB} || "");
6211 $CPAN::META->set_perl5lib;
6212 local $ENV{MAKEFLAGS}; # protect us from outer make calls
6215 if ($self->{modulebuild}) {
6216 $system = sprintf "%s test", $self->_build_command();
6218 $system = join " ", $self->_make_command(), "test";
6222 if (my $env = $self->prefs->{test}{env}) {
6223 for my $e (keys %$env) {
6224 $ENV{$e} = $env->{$e};
6227 my $expect = $self->prefs->{test}{expect};
6228 if ($expect && @$expect) {
6229 $tests_ok = $self->run_via_expect($system,$expect) == 0;
6230 } elsif ( $CPAN::Config->{test_report} &&
6231 $CPAN::META->has_inst("CPAN::Reporter") ) {
6232 $tests_ok = CPAN::Reporter::test($self, $system);
6234 $tests_ok = system($system) == 0;
6239 for my $m (keys %{$self->{sponsored_mods}}) {
6240 my $m_obj = CPAN::Shell->expand("Module",$m);
6241 my $d_obj = $m_obj->distribution;
6243 if (!$d_obj->{make_test}
6245 $d_obj->{make_test}->failed){
6253 my $which = join ",", @prereq;
6254 my $verb = $cnt == 1 ? "one dependency not OK ($which)" :
6255 "$cnt dependencies missing ($which)";
6256 $CPAN::Frontend->mywarn("Tests succeeded but $verb\n");
6257 $self->{make_test} = CPAN::Distrostatus->new("NO -- $verb");
6262 $CPAN::Frontend->myprint(" $system -- OK\n");
6263 $CPAN::META->is_tested($self->{'build_dir'});
6264 $self->{make_test} = CPAN::Distrostatus->new("YES");
6266 $self->{make_test} = CPAN::Distrostatus->new("NO");
6267 $self->{badtestcnt}++;
6268 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
6272 #-> sub CPAN::Distribution::clean ;
6275 my $make = $self->{modulebuild} ? "Build" : "make";
6276 $CPAN::Frontend->myprint("Running $make clean\n");
6277 unless (exists $self->{archived}) {
6278 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
6279 "/untarred, nothing done\n");
6282 unless (exists $self->{build_dir}) {
6283 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
6288 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
6289 push @e, "make clean already called once";
6290 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6292 chdir $self->{'build_dir'} or
6293 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
6294 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
6296 if ($^O eq 'MacOS') {
6297 Mac::BuildTools::make_clean($self);
6302 if ($self->{modulebuild}) {
6303 unless (-f "Build") {
6305 $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}".
6306 " in cwd[$cwd]. Danger, Will Robinson!");
6307 $CPAN::Frontend->mysleep(5);
6309 $system = sprintf "%s clean", $self->_build_command();
6311 $system = join " ", $self->_make_command(), "clean";
6313 if (system($system) == 0) {
6314 $CPAN::Frontend->myprint(" $system -- OK\n");
6318 # Jost Krieger pointed out that this "force" was wrong because
6319 # it has the effect that the next "install" on this distribution
6320 # will untar everything again. Instead we should bring the
6321 # object's state back to where it is after untarring.
6332 $self->{make_clean} = CPAN::Distrostatus->new("YES");
6335 # Hmmm, what to do if make clean failed?
6337 $self->{make_clean} = CPAN::Distrostatus->new("NO");
6338 $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n});
6340 # 2006-02-27: seems silly to me to force a make now
6341 # $self->force("make"); # so that this directory won't be used again
6346 #-> sub CPAN::Distribution::install ;
6351 delete $self->{force_update};
6354 my $make = $self->{modulebuild} ? "Build" : "make";
6355 $CPAN::Frontend->myprint("Running $make install\n");
6358 unless (exists $self->{make} or exists $self->{later}) {
6360 "Make had some problems, won't install";
6363 exists $self->{make} and
6365 $self->{make}->can("failed") ?
6366 $self->{make}->failed :
6367 $self->{make} =~ /^NO/
6369 push @e, "Make had returned bad status, install seems impossible";
6371 if (exists $self->{build_dir}) {
6373 push @e, "Has no own directory";
6376 if (exists $self->{make_test} and
6378 $self->{make_test}->can("failed") ?
6379 $self->{make_test}->failed :
6380 $self->{make_test} =~ /^NO/
6382 if ($self->{force_update}) {
6383 $self->{make_test}->text("FAILED but failure ignored because ".
6384 "'force' in effect");
6386 push @e, "make test had returned bad status, ".
6387 "won't install without force"
6390 if (exists $self->{'install'}) {
6391 if ($self->{'install'}->can("text") ?
6392 $self->{'install'}->text eq "YES" :
6393 $self->{'install'} =~ /^YES/
6395 push @e, "Already done";
6397 # comment in Todo on 2006-02-11; maybe retry?
6398 push @e, "Already tried without success";
6402 exists $self->{later} and length($self->{later}) and
6403 push @e, $self->{later};
6405 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6407 chdir $self->{'build_dir'} or
6408 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
6409 $self->debug("Changed directory to $self->{'build_dir'}")
6412 if ($^O eq 'MacOS') {
6413 Mac::BuildTools::make_install($self);
6418 if ($self->{modulebuild}) {
6419 my($mbuild_install_build_command) =
6420 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
6421 $CPAN::Config->{mbuild_install_build_command} ?
6422 $CPAN::Config->{mbuild_install_build_command} :
6423 $self->_build_command();
6424 $system = sprintf("%s install %s",
6425 $mbuild_install_build_command,
6426 $CPAN::Config->{mbuild_install_arg},
6429 my($make_install_make_command) =
6430 $self->prefs->{cpanconfig}{make_install_make_command}
6431 || $CPAN::Config->{make_install_make_command}
6432 || $self->_make_command();
6433 $system = sprintf("%s install %s",
6434 $make_install_make_command,
6435 $CPAN::Config->{make_install_arg},
6439 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
6440 my $brip = $self->prefs->{cpanconfig}{build_requires_install_policy};
6441 $brip ||= $CPAN::Config->{build_requires_install_policy};
6444 my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command
6445 my $want_install = "yes";
6446 if ($reqtype eq "b") {
6447 if ($brip eq "no") {
6448 $want_install = "no";
6449 } elsif ($brip =~ m|^ask/(.+)|) {
6451 $default = "yes" unless $default =~ /^(y|n)/i;
6453 CPAN::Shell::colorable_makemaker_prompt
6454 ("$id is just needed temporarily during building or testing. ".
6455 "Do you want to install it permanently? (Y/n)",
6459 unless ($want_install =~ /^y/i) {
6460 my $is_only = "is only 'build_requires'";
6461 $CPAN::Frontend->mywarn("Not installing because $is_only\n");
6462 $self->{install} = CPAN::Distrostatus->new("NO -- $is_only");
6463 delete $self->{force_update};
6466 my($pipe) = FileHandle->new("$system $stderr |");
6469 print $_; # intentionally NOT use Frontend->myprint because it
6470 # looks irritating when we markup in color what we
6471 # just pass through from an external program
6476 $CPAN::Frontend->myprint(" $system -- OK\n");
6477 $CPAN::META->is_installed($self->{build_dir});
6478 return $self->{install} = CPAN::Distrostatus->new("YES");
6480 $self->{install} = CPAN::Distrostatus->new("NO");
6481 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
6483 $self->prefs->{cpanconfig}{make_install_make_command} ||
6484 $CPAN::Config->{make_install_make_command};
6486 $makeout =~ /permission/s
6490 || $mimc eq ($self->prefs->{cpanconfig}{make}
6491 || $CPAN::Config->{make})
6494 $CPAN::Frontend->myprint(
6496 qq{ You may have to su }.
6497 qq{to root to install the package\n}.
6498 qq{ (Or you may want to run something like\n}.
6499 qq{ o conf make_install_make_command 'sudo make'\n}.
6500 qq{ to raise your permissions.}
6504 delete $self->{force_update};
6507 #-> sub CPAN::Distribution::dir ;
6509 shift->{'build_dir'};
6512 #-> sub CPAN::Distribution::perldoc ;
6516 my($dist) = $self->id;
6517 my $package = $self->called_for;
6519 $self->_display_url( $CPAN::Defaultdocs . $package );
6522 #-> sub CPAN::Distribution::_check_binary ;
6524 my ($dist,$shell,$binary) = @_;
6527 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
6531 $pid = open README, "which $binary|"
6532 or $CPAN::Frontend->mydie(qq{Could not fork 'which $binary': $!});
6536 close README or die "Could not run 'which $binary': $!";
6538 $CPAN::Frontend->myprint(qq{ + $out \n})
6539 if $CPAN::DEBUG && $out;
6544 #-> sub CPAN::Distribution::_display_url ;
6546 my($self,$url) = @_;
6547 my($res,$saved_file,$pid,$out);
6549 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
6552 # should we define it in the config instead?
6553 my $html_converter = "html2text";
6555 my $web_browser = $CPAN::Config->{'lynx'} || undef;
6556 my $web_browser_out = $web_browser
6557 ? CPAN::Distribution->_check_binary($self,$web_browser)
6560 if ($web_browser_out) {
6561 # web browser found, run the action
6562 my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
6563 $CPAN::Frontend->myprint(qq{system[$browser $url]})
6565 $CPAN::Frontend->myprint(qq{
6568 with browser $browser
6570 $CPAN::Frontend->mysleep(1);
6571 system("$browser $url");
6572 if ($saved_file) { 1 while unlink($saved_file) }
6574 # web browser not found, let's try text only
6575 my $html_converter_out =
6576 CPAN::Distribution->_check_binary($self,$html_converter);
6577 $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
6579 if ($html_converter_out ) {
6580 # html2text found, run it
6581 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
6582 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
6583 unless defined($saved_file);
6586 $pid = open README, "$html_converter $saved_file |"
6587 or $CPAN::Frontend->mydie(qq{
6588 Could not fork '$html_converter $saved_file': $!});
6590 if ($CPAN::META->has_inst("File::Temp")) {
6591 $fh = File::Temp->new(
6592 template => 'cpan_htmlconvert_XXXX',
6596 $filename = $fh->filename;
6598 $filename = "cpan_htmlconvert_$$.txt";
6599 $fh = FileHandle->new();
6600 open $fh, ">$filename" or die;
6606 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
6607 my $tmpin = $fh->filename;
6608 $CPAN::Frontend->myprint(sprintf(qq{
6610 saved output to %s\n},
6618 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
6619 my $fh_pager = FileHandle->new;
6620 local($SIG{PIPE}) = "IGNORE";
6621 my $pager = $CPAN::Config->{'pager'} || "cat";
6622 $fh_pager->open("|$pager")
6623 or $CPAN::Frontend->mydie(qq{
6624 Could not open pager '$pager': $!});
6625 $CPAN::Frontend->myprint(qq{
6630 $CPAN::Frontend->mysleep(1);
6631 $fh_pager->print(<FH>);
6634 # coldn't find the web browser or html converter
6635 $CPAN::Frontend->myprint(qq{
6636 You need to install lynx or $html_converter to use this feature.});
6641 #-> sub CPAN::Distribution::_getsave_url ;
6643 my($dist, $shell, $url) = @_;
6645 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
6649 if ($CPAN::META->has_inst("File::Temp")) {
6650 $fh = File::Temp->new(
6651 template => "cpan_getsave_url_XXXX",
6655 $filename = $fh->filename;
6657 $fh = FileHandle->new;
6658 $filename = "cpan_getsave_url_$$.html";
6660 my $tmpin = $filename;
6661 if ($CPAN::META->has_usable('LWP')) {
6662 $CPAN::Frontend->myprint("Fetching with LWP:
6666 CPAN::LWP::UserAgent->config;
6667 eval { $Ua = CPAN::LWP::UserAgent->new; };
6669 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
6673 $Ua->proxy('http', $var)
6674 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
6676 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
6679 my $req = HTTP::Request->new(GET => $url);
6680 $req->header('Accept' => 'text/html');
6681 my $res = $Ua->request($req);
6682 if ($res->is_success) {
6683 $CPAN::Frontend->myprint(" + request successful.\n")
6685 print $fh $res->content;
6687 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
6691 $CPAN::Frontend->myprint(sprintf(
6692 "LWP failed with code[%s], message[%s]\n",
6699 $CPAN::Frontend->mywarn(" LWP not available\n");
6704 # sub CPAN::Distribution::_build_command
6705 sub _build_command {
6707 if ($^O eq "MSWin32") { # special code needed at least up to
6708 # Module::Build 0.2611 and 0.2706; a fix
6709 # in M:B has been promised 2006-01-30
6710 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
6711 return "$perl ./Build";
6716 package CPAN::Bundle;
6721 $CPAN::Frontend->myprint($self->as_string);
6726 delete $self->{later};
6727 for my $c ( $self->contains ) {
6728 my $obj = CPAN::Shell->expandany($c) or next;
6733 # mark as dirty/clean
6734 #-> sub CPAN::Bundle::color_cmd_tmps ;
6735 sub color_cmd_tmps {
6737 my($depth) = shift || 0;
6738 my($color) = shift || 0;
6739 my($ancestors) = shift || [];
6740 # a module needs to recurse to its cpan_file, a distribution needs
6741 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
6743 return if exists $self->{incommandcolor}
6744 && $self->{incommandcolor}==$color;
6746 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
6748 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
6750 for my $c ( $self->contains ) {
6751 my $obj = CPAN::Shell->expandany($c) or next;
6752 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
6753 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
6756 delete $self->{badtestcnt};
6758 $self->{incommandcolor} = $color;
6761 #-> sub CPAN::Bundle::as_string ;
6765 # following line must be "=", not "||=" because we have a moving target
6766 $self->{INST_VERSION} = $self->inst_version;
6767 return $self->SUPER::as_string;
6770 #-> sub CPAN::Bundle::contains ;
6773 my($inst_file) = $self->inst_file || "";
6774 my($id) = $self->id;
6775 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
6776 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
6779 unless ($inst_file) {
6780 # Try to get at it in the cpan directory
6781 $self->debug("no inst_file") if $CPAN::DEBUG;
6783 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
6784 $cpan_file = $self->cpan_file;
6785 if ($cpan_file eq "N/A") {
6786 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
6787 Maybe stale symlink? Maybe removed during session? Giving up.\n");
6789 my $dist = $CPAN::META->instance('CPAN::Distribution',
6792 $self->debug("id[$dist->{ID}]") if $CPAN::DEBUG;
6793 my($todir) = $CPAN::Config->{'cpan_home'};
6794 my(@me,$from,$to,$me);
6795 @me = split /::/, $self->id;
6797 $me = File::Spec->catfile(@me);
6798 $from = $self->find_bundle_file($dist->{'build_dir'},join('/',@me));
6799 $to = File::Spec->catfile($todir,$me);
6800 File::Path::mkpath(File::Basename::dirname($to));
6801 File::Copy::copy($from, $to)
6802 or Carp::confess("Couldn't copy $from to $to: $!");
6806 my $fh = FileHandle->new;
6808 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
6810 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
6812 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
6813 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
6814 next unless $in_cont;
6819 push @result, (split " ", $_, 2)[0];
6822 delete $self->{STATUS};
6823 $self->{CONTAINS} = \@result;
6824 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
6826 $CPAN::Frontend->mywarn(qq{
6827 The bundle file "$inst_file" may be a broken
6828 bundlefile. It seems not to contain any bundle definition.
6829 Please check the file and if it is bogus, please delete it.
6830 Sorry for the inconvenience.
6836 #-> sub CPAN::Bundle::find_bundle_file
6837 # $where is in local format, $what is in unix format
6838 sub find_bundle_file {
6839 my($self,$where,$what) = @_;
6840 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
6841 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
6842 ### my $bu = File::Spec->catfile($where,$what);
6843 ### return $bu if -f $bu;
6844 my $manifest = File::Spec->catfile($where,"MANIFEST");
6845 unless (-f $manifest) {
6846 require ExtUtils::Manifest;
6847 my $cwd = CPAN::anycwd();
6848 $self->safe_chdir($where);
6849 ExtUtils::Manifest::mkmanifest();
6850 $self->safe_chdir($cwd);
6852 my $fh = FileHandle->new($manifest)
6853 or Carp::croak("Couldn't open $manifest: $!");
6855 my $bundle_filename = $what;
6856 $bundle_filename =~ s|Bundle.*/||;
6857 my $bundle_unixpath;
6860 my($file) = /(\S+)/;
6861 if ($file =~ m|\Q$what\E$|) {
6862 $bundle_unixpath = $file;
6863 # return File::Spec->catfile($where,$bundle_unixpath); # bad
6866 # retry if she managed to have no Bundle directory
6867 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
6869 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
6870 if $bundle_unixpath;
6871 Carp::croak("Couldn't find a Bundle file in $where");
6874 # needs to work quite differently from Module::inst_file because of
6875 # cpan_home/Bundle/ directory and the possibility that we have
6876 # shadowing effect. As it makes no sense to take the first in @INC for
6877 # Bundles, we parse them all for $VERSION and take the newest.
6879 #-> sub CPAN::Bundle::inst_file ;
6884 @me = split /::/, $self->id;
6887 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
6888 my $bfile = File::Spec->catfile($incdir, @me);
6889 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
6890 next unless -f $bfile;
6891 my $foundv = MM->parse_version($bfile);
6892 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
6893 $self->{INST_FILE} = $bfile;
6894 $self->{INST_VERSION} = $bestv = $foundv;
6900 #-> sub CPAN::Bundle::inst_version ;
6903 $self->inst_file; # finds INST_VERSION as side effect
6904 $self->{INST_VERSION};
6907 #-> sub CPAN::Bundle::rematein ;
6909 my($self,$meth) = @_;
6910 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
6911 my($id) = $self->id;
6912 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
6913 unless $self->inst_file || $self->cpan_file;
6915 for $s ($self->contains) {
6916 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
6917 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
6918 if ($type eq 'CPAN::Distribution') {
6919 $CPAN::Frontend->mywarn(qq{
6920 The Bundle }.$self->id.qq{ contains
6921 explicitly a file $s.
6923 $CPAN::Frontend->mysleep(3);
6925 # possibly noisy action:
6926 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
6927 my $obj = $CPAN::META->instance($type,$s);
6928 $obj->{reqtype} = $self->{reqtype};
6930 if ($obj->isa('CPAN::Bundle')
6932 exists $obj->{install_failed}
6934 ref($obj->{install_failed}) eq "HASH"
6936 for (keys %{$obj->{install_failed}}) {
6937 $self->{install_failed}{$_} = undef; # propagate faiure up
6940 $fail{$s} = 1; # the bundle itself may have succeeded but
6945 $success = $obj->can("uptodate") ? $obj->uptodate : 0;
6946 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
6948 delete $self->{install_failed}{$s};
6955 # recap with less noise
6956 if ( $meth eq "install" ) {
6959 my $raw = sprintf(qq{Bundle summary:
6960 The following items in bundle %s had installation problems:},
6963 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
6964 $CPAN::Frontend->myprint("\n");
6967 for $s ($self->contains) {
6969 $paragraph .= "$s ";
6970 $self->{install_failed}{$s} = undef;
6971 $reported{$s} = undef;
6974 my $report_propagated;
6975 for $s (sort keys %{$self->{install_failed}}) {
6976 next if exists $reported{$s};
6977 $paragraph .= "and the following items had problems
6978 during recursive bundle calls: " unless $report_propagated++;
6979 $paragraph .= "$s ";
6981 $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
6982 $CPAN::Frontend->myprint("\n");
6984 $self->{'install'} = 'YES';
6989 # If a bundle contains another that contains an xs_file we have here,
6990 # we just don't bother I suppose
6991 #-> sub CPAN::Bundle::xs_file
6996 #-> sub CPAN::Bundle::force ;
6997 sub force { shift->rematein('force',@_); }
6998 #-> sub CPAN::Bundle::notest ;
6999 sub notest { shift->rematein('notest',@_); }
7000 #-> sub CPAN::Bundle::get ;
7001 sub get { shift->rematein('get',@_); }
7002 #-> sub CPAN::Bundle::make ;
7003 sub make { shift->rematein('make',@_); }
7004 #-> sub CPAN::Bundle::test ;
7007 $self->{badtestcnt} ||= 0;
7008 $self->rematein('test',@_);
7010 #-> sub CPAN::Bundle::install ;
7013 $self->rematein('install',@_);
7015 #-> sub CPAN::Bundle::clean ;
7016 sub clean { shift->rematein('clean',@_); }
7018 #-> sub CPAN::Bundle::uptodate ;
7021 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
7023 foreach $c ($self->contains) {
7024 my $obj = CPAN::Shell->expandany($c);
7025 return 0 unless $obj->uptodate;
7030 #-> sub CPAN::Bundle::readme ;
7033 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
7034 No File found for bundle } . $self->id . qq{\n}), return;
7035 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
7036 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
7039 package CPAN::Module;
7043 # sub CPAN::Module::userid
7048 return $ro->{userid} || $ro->{CPAN_USERID};
7050 # sub CPAN::Module::description
7053 my $ro = $self->ro or return "";
7059 CPAN::Shell->expand("Distribution",$self->cpan_file);
7062 # sub CPAN::Module::undelay
7065 delete $self->{later};
7066 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
7071 # mark as dirty/clean
7072 #-> sub CPAN::Module::color_cmd_tmps ;
7073 sub color_cmd_tmps {
7075 my($depth) = shift || 0;
7076 my($color) = shift || 0;
7077 my($ancestors) = shift || [];
7078 # a module needs to recurse to its cpan_file
7080 return if exists $self->{incommandcolor}
7081 && $self->{incommandcolor}==$color;
7082 return if $depth>=1 && $self->uptodate;
7084 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
7086 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
7088 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
7089 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
7092 delete $self->{badtestcnt};
7094 $self->{incommandcolor} = $color;
7097 #-> sub CPAN::Module::as_glimpse ;
7101 my $class = ref($self);
7102 $class =~ s/^CPAN:://;
7106 $CPAN::Shell::COLOR_REGISTERED
7108 $CPAN::META->has_inst("Term::ANSIColor")
7112 $color_on = Term::ANSIColor::color("green");
7113 $color_off = Term::ANSIColor::color("reset");
7115 my $uptodateness = " ";
7116 if ($class eq "Bundle") {
7117 } elsif ($self->uptodate) {
7118 $uptodateness = "=";
7119 } elsif ($self->inst_version) {
7120 $uptodateness = "<";
7122 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
7128 ($self->distribution ?
7129 $self->distribution->pretty_id :
7136 #-> sub CPAN::Module::dslip_status
7140 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
7141 pre-alpha alpha beta released
7143 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
7144 developer comp.lang.perl.*
7146 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
7147 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
7149 object-oriented pragma
7151 @{$stat->{P}}{qw,p g l b a o d r n,} = qw,Standard-Perl
7155 distribution_allowed
7156 restricted_distribution
7158 for my $x (qw(d s l i p)) {
7159 $stat->{$x}{' '} = 'unknown';
7160 $stat->{$x}{'?'} = 'unknown';
7163 return +{} unless $ro && $ro->{statd};
7170 DV => $stat->{D}{$ro->{statd}},
7171 SV => $stat->{S}{$ro->{stats}},
7172 LV => $stat->{L}{$ro->{statl}},
7173 IV => $stat->{I}{$ro->{stati}},
7174 PV => $stat->{P}{$ro->{statp}},
7178 #-> sub CPAN::Module::as_string ;
7182 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
7183 my $class = ref($self);
7184 $class =~ s/^CPAN:://;
7186 push @m, $class, " id = $self->{ID}\n";
7187 my $sprintf = " %-12s %s\n";
7188 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
7189 if $self->description;
7190 my $sprintf2 = " %-12s %s (%s)\n";
7192 $userid = $self->userid;
7195 if ($author = CPAN::Shell->expand('Author',$userid)) {
7198 if ($m = $author->email) {
7205 $author->fullname . $email
7209 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
7210 if $self->cpan_version;
7211 if (my $cpan_file = $self->cpan_file){
7212 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
7213 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
7214 my $upload_date = $dist->upload_date;
7216 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
7220 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
7221 my $dslip = $self->dslip_status;
7225 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
7227 my $local_file = $self->inst_file;
7228 unless ($self->{MANPAGE}) {
7231 $manpage = $self->manpage_headline($local_file);
7233 # If we have already untarred it, we should look there
7234 my $dist = $CPAN::META->instance('CPAN::Distribution',
7236 # warn "dist[$dist]";
7237 # mff=manifest file; mfh=manifest handle
7242 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
7244 $mfh = FileHandle->new($mff)
7246 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
7247 my $lfre = $self->id; # local file RE
7250 my($lfl); # local file file
7252 my(@mflines) = <$mfh>;
7257 while (length($lfre)>5 and !$lfl) {
7258 ($lfl) = grep /$lfre/, @mflines;
7259 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
7262 $lfl =~ s/\s.*//; # remove comments
7263 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
7264 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
7265 # warn "lfl_abs[$lfl_abs]";
7267 $manpage = $self->manpage_headline($lfl_abs);
7271 $self->{MANPAGE} = $manpage if $manpage;
7274 for $item (qw/MANPAGE/) {
7275 push @m, sprintf($sprintf, $item, $self->{$item})
7276 if exists $self->{$item};
7278 for $item (qw/CONTAINS/) {
7279 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
7280 if exists $self->{$item} && @{$self->{$item}};
7282 push @m, sprintf($sprintf, 'INST_FILE',
7283 $local_file || "(not installed)");
7284 push @m, sprintf($sprintf, 'INST_VERSION',
7285 $self->inst_version) if $local_file;
7289 sub manpage_headline {
7290 my($self,$local_file) = @_;
7291 my(@local_file) = $local_file;
7292 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
7293 push @local_file, $local_file;
7295 for $locf (@local_file) {
7296 next unless -f $locf;
7297 my $fh = FileHandle->new($locf)
7298 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
7302 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
7303 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
7320 #-> sub CPAN::Module::cpan_file ;
7321 # Note: also inherited by CPAN::Bundle
7324 CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
7325 unless ($self->ro) {
7326 CPAN::Index->reload;
7329 if ($ro && defined $ro->{CPAN_FILE}){
7330 return $ro->{CPAN_FILE};
7332 my $userid = $self->userid;
7334 if ($CPAN::META->exists("CPAN::Author",$userid)) {
7335 my $author = $CPAN::META->instance("CPAN::Author",
7337 my $fullname = $author->fullname;
7338 my $email = $author->email;
7339 unless (defined $fullname && defined $email) {
7340 return sprintf("Contact Author %s",
7344 return "Contact Author $fullname <$email>";
7346 return "Contact Author $userid (Email address not available)";
7354 #-> sub CPAN::Module::cpan_version ;
7360 # Can happen with modules that are not on CPAN
7363 $ro->{CPAN_VERSION} = 'undef'
7364 unless defined $ro->{CPAN_VERSION};
7365 $ro->{CPAN_VERSION};
7368 #-> sub CPAN::Module::force ;
7371 $self->{'force_update'}++;
7376 # warn "XDEBUG: set notest for Module";
7377 $self->{'notest'}++;
7380 #-> sub CPAN::Module::rematein ;
7382 my($self,$meth) = @_;
7383 $CPAN::Frontend->myprint(sprintf("Running %s for module '%s'\n",
7386 my $cpan_file = $self->cpan_file;
7387 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
7388 $CPAN::Frontend->mywarn(sprintf qq{
7389 The module %s isn\'t available on CPAN.
7391 Either the module has not yet been uploaded to CPAN, or it is
7392 temporary unavailable. Please contact the author to find out
7393 more about the status. Try 'i %s'.
7400 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
7401 $pack->called_for($self->id);
7402 $pack->force($meth) if exists $self->{'force_update'};
7403 $pack->notest($meth) if exists $self->{'notest'};
7405 $pack->{reqtype} ||= "";
7406 CPAN->debug("dist-reqtype[$pack->{reqtype}]".
7407 "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG;
7408 if ($pack->{reqtype}) {
7409 if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) {
7410 $pack->{reqtype} = $self->{reqtype};
7412 exists $pack->{install}
7415 $pack->{install}->can("failed") ?
7416 $pack->{install}->failed :
7417 $pack->{install} =~ /^NO/
7420 delete $pack->{install};
7421 $CPAN::Frontend->mywarn
7422 ("Promoting $pack->{ID} from 'build_requires' to 'requires'");
7426 $pack->{reqtype} = $self->{reqtype};
7433 $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
7434 $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
7435 delete $self->{'force_update'};
7436 delete $self->{'notest'};
7442 #-> sub CPAN::Module::perldoc ;
7443 sub perldoc { shift->rematein('perldoc') }
7444 #-> sub CPAN::Module::readme ;
7445 sub readme { shift->rematein('readme') }
7446 #-> sub CPAN::Module::look ;
7447 sub look { shift->rematein('look') }
7448 #-> sub CPAN::Module::cvs_import ;
7449 sub cvs_import { shift->rematein('cvs_import') }
7450 #-> sub CPAN::Module::get ;
7451 sub get { shift->rematein('get',@_) }
7452 #-> sub CPAN::Module::make ;
7453 sub make { shift->rematein('make') }
7454 #-> sub CPAN::Module::test ;
7457 $self->{badtestcnt} ||= 0;
7458 $self->rematein('test',@_);
7460 #-> sub CPAN::Module::uptodate ;
7463 local($_); # protect against a bug in MakeMaker 6.17
7464 my($latest) = $self->cpan_version;
7466 my($inst_file) = $self->inst_file;
7468 if (defined $inst_file) {
7469 $have = $self->inst_version;
7474 ! CPAN::Version->vgt($latest, $have)
7476 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
7477 "latest[$latest] have[$have]") if $CPAN::DEBUG;
7482 #-> sub CPAN::Module::install ;
7488 not exists $self->{'force_update'}
7490 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
7492 $self->inst_version,
7498 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
7499 $CPAN::Frontend->mywarn(qq{
7500 \n\n\n ***WARNING***
7501 The module $self->{ID} has no active maintainer.\n\n\n
7503 $CPAN::Frontend->mysleep(5);
7505 $self->rematein('install') if $doit;
7507 #-> sub CPAN::Module::clean ;
7508 sub clean { shift->rematein('clean') }
7510 #-> sub CPAN::Module::inst_file ;
7514 @packpath = split /::/, $self->{ID};
7515 $packpath[-1] .= ".pm";
7516 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
7517 unshift @packpath, "Term", "ReadLine"; # historical reasons
7519 foreach $dir (@INC) {
7520 my $pmfile = File::Spec->catfile($dir,@packpath);
7528 #-> sub CPAN::Module::xs_file ;
7532 @packpath = split /::/, $self->{ID};
7533 push @packpath, $packpath[-1];
7534 $packpath[-1] .= "." . $Config::Config{'dlext'};
7535 foreach $dir (@INC) {
7536 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
7544 #-> sub CPAN::Module::inst_version ;
7547 my $parsefile = $self->inst_file or return;
7548 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
7551 $have = MM->parse_version($parsefile) || "undef";
7552 $have =~ s/^ //; # since the %vd hack these two lines here are needed
7553 $have =~ s/ $//; # trailing whitespace happens all the time
7555 # My thoughts about why %vd processing should happen here
7557 # Alt1 maintain it as string with leading v:
7558 # read index files do nothing
7559 # compare it use utility for compare
7560 # print it do nothing
7562 # Alt2 maintain it as what it is
7563 # read index files convert
7564 # compare it use utility because there's still a ">" vs "gt" issue
7565 # print it use CPAN::Version for print
7567 # Seems cleaner to hold it in memory as a string starting with a "v"
7569 # If the author of this module made a mistake and wrote a quoted
7570 # "v1.13" instead of v1.13, we simply leave it at that with the
7571 # effect that *we* will treat it like a v-tring while the rest of
7572 # perl won't. Seems sensible when we consider that any action we
7573 # could take now would just add complexity.
7575 $have = CPAN::Version->readable($have);
7577 $have =~ s/\s*//g; # stringify to float around floating point issues
7578 $have; # no stringify needed, \s* above matches always
7591 CPAN - query, download and build perl modules from CPAN sites
7597 perl -MCPAN -e shell;
7605 cpan> install Acme::Meta # in the shell
7607 CPAN::Shell->install("Acme::Meta"); # in perl
7611 cpan> install NWCLARK/Acme-Meta-0.02.tar.gz # in the shell
7614 install("NWCLARK/Acme-Meta-0.02.tar.gz"); # in perl
7618 $mo = CPAN::Shell->expandany($mod);
7619 $mo = CPAN::Shell->expand("Module",$mod); # same thing
7621 # distribution objects:
7623 $do = CPAN::Shell->expand("Module",$mod)->distribution;
7624 $do = CPAN::Shell->expandany($distro); # same thing
7625 $do = CPAN::Shell->expand("Distribution",
7626 $distro); # same thing
7630 This module and its competitor, the CPANPLUS module, are both much
7631 cooler than the other.
7633 =head1 COMPATIBILITY
7635 CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
7636 newer versions. It is getting more and more difficult to get the
7637 minimal prerequisites working on older perls. It is close to
7638 impossible to get the whole Bundle::CPAN working there. If you're in
7639 the position to have only these old versions, be advised that CPAN is
7640 designed to work fine without the Bundle::CPAN installed.
7642 To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
7643 compatible with ancient perls and that File::Temp is listed as a
7644 prerequisite but CPAN has reasonable workarounds if it is missing.
7648 The CPAN module is designed to automate the make and install of perl
7649 modules and extensions. It includes some primitive searching
7650 capabilities and knows how to use Net::FTP or LWP (or some external
7651 download clients) to fetch the raw data from the net.
7653 Modules are fetched from one or more of the mirrored CPAN
7654 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
7657 The CPAN module also supports the concept of named and versioned
7658 I<bundles> of modules. Bundles simplify the handling of sets of
7659 related modules. See Bundles below.
7661 The package contains a session manager and a cache manager. There is
7662 no status retained between sessions. The session manager keeps track
7663 of what has been fetched, built and installed in the current
7664 session. The cache manager keeps track of the disk space occupied by
7665 the make processes and deletes excess space according to a simple FIFO
7668 All methods provided are accessible in a programmer style and in an
7669 interactive shell style.
7671 =head2 CPAN::shell([$prompt, $command]) Starting Interactive Mode
7673 The interactive mode is entered by running
7675 perl -MCPAN -e shell
7677 which puts you into a readline interface. You will have the most fun if
7678 you install Term::ReadKey and Term::ReadLine to enjoy both history and
7681 Once you are on the command line, type 'h' and the rest should be
7684 The function call C<shell> takes two optional arguments, one is the
7685 prompt, the second is the default initial command line (the latter
7686 only works if a real ReadLine interface module is installed).
7688 The most common uses of the interactive modes are
7692 =item Searching for authors, bundles, distribution files and modules
7694 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
7695 for each of the four categories and another, C<i> for any of the
7696 mentioned four. Each of the four entities is implemented as a class
7697 with slightly differing methods for displaying an object.
7699 Arguments you pass to these commands are either strings exactly matching
7700 the identification string of an object or regular expressions that are
7701 then matched case-insensitively against various attributes of the
7702 objects. The parser recognizes a regular expression only if you
7703 enclose it between two slashes.
7705 The principle is that the number of found objects influences how an
7706 item is displayed. If the search finds one item, the result is
7707 displayed with the rather verbose method C<as_string>, but if we find
7708 more than one, we display each object with the terse method
7711 =item make, test, install, clean modules or distributions
7713 These commands take any number of arguments and investigate what is
7714 necessary to perform the action. If the argument is a distribution
7715 file name (recognized by embedded slashes), it is processed. If it is
7716 a module, CPAN determines the distribution file in which this module
7717 is included and processes that, following any dependencies named in
7718 the module's META.yml or Makefile.PL (this behavior is controlled by
7719 the configuration parameter C<prerequisites_policy>.)
7721 Any C<make> or C<test> are run unconditionally. An
7723 install <distribution_file>
7725 also is run unconditionally. But for
7729 CPAN checks if an install is actually needed for it and prints
7730 I<module up to date> in the case that the distribution file containing
7731 the module doesn't need to be updated.
7733 CPAN also keeps track of what it has done within the current session
7734 and doesn't try to build a package a second time regardless if it
7735 succeeded or not. The C<force> pragma may precede another command
7736 (currently: C<make>, C<test>, or C<install>) and executes the
7737 command from scratch and tries to continue in case of some errors.
7741 cpan> install OpenGL
7742 OpenGL is up to date.
7743 cpan> force install OpenGL
7746 OpenGL-0.4/COPYRIGHT
7749 The C<notest> pragma may be set to skip the test part in the build
7754 cpan> notest install Tk
7756 A C<clean> command results in a
7760 being executed within the distribution file's working directory.
7762 =item get, readme, perldoc, look module or distribution
7764 C<get> downloads a distribution file without further action. C<readme>
7765 displays the README file of the associated distribution. C<Look> gets
7766 and untars (if not yet done) the distribution file, changes to the
7767 appropriate directory and opens a subshell process in that directory.
7768 C<perldoc> displays the pod documentation of the module in html or
7773 =item ls globbing_expression
7775 The first form lists all distribution files in and below an author's
7776 CPAN directory as they are stored in the CHECKUMS files distributed on
7777 CPAN. The listing goes recursive into all subdirectories.
7779 The second form allows to limit or expand the output with shell
7780 globbing as in the following examples:
7786 The last example is very slow and outputs extra progress indicators
7787 that break the alignment of the result.
7789 Note that globbing only lists directories explicitly asked for, for
7790 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
7791 regarded as a bug and may be changed in future versions.
7795 The C<failed> command reports all distributions that failed on one of
7796 C<make>, C<test> or C<install> for some reason in the currently
7797 running shell session.
7801 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>
7802 (but the directory can be configured via the C<cpan_home> config
7803 variable). The shell is a bit picky if you try to start another CPAN
7804 session. It dies immediately if there is a lockfile and the lock seems
7805 to belong to a running process. In case you want to run a second shell
7806 session, it is probably safest to maintain another directory, say
7807 C<~/.cpan-for-X/> and a C<~/.cpan-for-X/CPAN/MyConfig.pm> that
7808 contains the configuration options. Then you can start the second
7811 perl -I ~/.cpan-for-X -MCPAN::MyConfig -MCPAN -e shell
7815 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
7816 in the cpan-shell it is intended that you can press C<^C> anytime and
7817 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
7818 to clean up and leave the shell loop. You can emulate the effect of a
7819 SIGTERM by sending two consecutive SIGINTs, which usually means by
7820 pressing C<^C> twice.
7822 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
7823 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
7824 Build.PL> subprocess.
7830 The commands that are available in the shell interface are methods in
7831 the package CPAN::Shell. If you enter the shell command, all your
7832 input is split by the Text::ParseWords::shellwords() routine which
7833 acts like most shells do. The first word is being interpreted as the
7834 method to be called and the rest of the words are treated as arguments
7835 to this method. Continuation lines are supported if a line ends with a
7840 C<autobundle> writes a bundle file into the
7841 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
7842 a list of all modules that are both available from CPAN and currently
7843 installed within @INC. The name of the bundle file is based on the
7844 current date and a counter.
7848 recompile() is a very special command in that it takes no argument and
7849 runs the make/test/install cycle with brute force over all installed
7850 dynamically loadable extensions (aka XS modules) with 'force' in
7851 effect. The primary purpose of this command is to finish a network
7852 installation. Imagine, you have a common source tree for two different
7853 architectures. You decide to do a completely independent fresh
7854 installation. You start on one architecture with the help of a Bundle
7855 file produced earlier. CPAN installs the whole Bundle for you, but
7856 when you try to repeat the job on the second architecture, CPAN
7857 responds with a C<"Foo up to date"> message for all modules. So you
7858 invoke CPAN's recompile on the second architecture and you're done.
7860 Another popular use for C<recompile> is to act as a rescue in case your
7861 perl breaks binary compatibility. If one of the modules that CPAN uses
7862 is in turn depending on binary compatibility (so you cannot run CPAN
7863 commands), then you should try the CPAN::Nox module for recovery.
7865 =head2 upgrade [Module|/Regex/]...
7867 The C<upgrade> command first runs an C<r> command with the given
7868 arguments and then installs the newest versions of all modules that
7869 were listed by that.
7873 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
7874 directory so that you can save your own preferences instead of the
7877 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
7879 Although it may be considered internal, the class hierarchy does matter
7880 for both users and programmer. CPAN.pm deals with above mentioned four
7881 classes, and all those classes share a set of methods. A classical
7882 single polymorphism is in effect. A metaclass object registers all
7883 objects of all kinds and indexes them with a string. The strings
7884 referencing objects have a separated namespace (well, not completely
7889 words containing a "/" (slash) Distribution
7890 words starting with Bundle:: Bundle
7891 everything else Module or Author
7893 Modules know their associated Distribution objects. They always refer
7894 to the most recent official release. Developers may mark their releases
7895 as unstable development versions (by inserting an underbar into the
7896 module version number which will also be reflected in the distribution
7897 name when you run 'make dist'), so the really hottest and newest
7898 distribution is not always the default. If a module Foo circulates
7899 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
7900 way to install version 1.23 by saying
7904 This would install the complete distribution file (say
7905 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
7906 like to install version 1.23_90, you need to know where the
7907 distribution file resides on CPAN relative to the authors/id/
7908 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
7909 so you would have to say
7911 install BAR/Foo-1.23_90.tar.gz
7913 The first example will be driven by an object of the class
7914 CPAN::Module, the second by an object of class CPAN::Distribution.
7916 =head1 PROGRAMMER'S INTERFACE
7918 If you do not enter the shell, the available shell commands are both
7919 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
7920 functions in the calling package (C<install(...)>).
7922 There's currently only one class that has a stable interface -
7923 CPAN::Shell. All commands that are available in the CPAN shell are
7924 methods of the class CPAN::Shell. Each of the commands that produce
7925 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
7926 the IDs of all modules within the list.
7930 =item expand($type,@things)
7932 The IDs of all objects available within a program are strings that can
7933 be expanded to the corresponding real objects with the
7934 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
7935 list of CPAN::Module objects according to the C<@things> arguments
7936 given. In scalar context it only returns the first element of the
7939 =item expandany(@things)
7941 Like expand, but returns objects of the appropriate type, i.e.
7942 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
7943 CPAN::Distribution objects for distributions. Note: it does not expand
7944 to CPAN::Author objects.
7946 =item Programming Examples
7948 This enables the programmer to do operations that combine
7949 functionalities that are available in the shell.
7951 # install everything that is outdated on my disk:
7952 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
7954 # install my favorite programs if necessary:
7955 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
7956 CPAN::Shell->install($mod);
7959 # list all modules on my disk that have no VERSION number
7960 for $mod (CPAN::Shell->expand("Module","/./")){
7961 next unless $mod->inst_file;
7962 # MakeMaker convention for undefined $VERSION:
7963 next unless $mod->inst_version eq "undef";
7964 print "No VERSION in ", $mod->id, "\n";
7967 # find out which distribution on CPAN contains a module:
7968 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
7970 Or if you want to write a cronjob to watch The CPAN, you could list
7971 all modules that need updating. First a quick and dirty way:
7973 perl -e 'use CPAN; CPAN::Shell->r;'
7975 If you don't want to get any output in the case that all modules are
7976 up to date, you can parse the output of above command for the regular
7977 expression //modules are up to date// and decide to mail the output
7978 only if it doesn't match. Ick?
7980 If you prefer to do it more in a programmer style in one single
7981 process, maybe something like this suits you better:
7983 # list all modules on my disk that have newer versions on CPAN
7984 for $mod (CPAN::Shell->expand("Module","/./")){
7985 next unless $mod->inst_file;
7986 next if $mod->uptodate;
7987 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
7988 $mod->id, $mod->inst_version, $mod->cpan_version;
7991 If that gives you too much output every day, you maybe only want to
7992 watch for three modules. You can write
7994 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
7996 as the first line instead. Or you can combine some of the above
7999 # watch only for a new mod_perl module
8000 $mod = CPAN::Shell->expand("Module","mod_perl");
8001 exit if $mod->uptodate;
8002 # new mod_perl arrived, let me know all update recommendations
8007 =head2 Methods in the other Classes
8009 The programming interface for the classes CPAN::Module,
8010 CPAN::Distribution, CPAN::Bundle, and CPAN::Author is still considered
8011 beta and partially even alpha. In the following paragraphs only those
8012 methods are documented that have proven useful over a longer time and
8013 thus are unlikely to change.
8017 =item CPAN::Author::as_glimpse()
8019 Returns a one-line description of the author
8021 =item CPAN::Author::as_string()
8023 Returns a multi-line description of the author
8025 =item CPAN::Author::email()
8027 Returns the author's email address
8029 =item CPAN::Author::fullname()
8031 Returns the author's name
8033 =item CPAN::Author::name()
8035 An alias for fullname
8037 =item CPAN::Bundle::as_glimpse()
8039 Returns a one-line description of the bundle
8041 =item CPAN::Bundle::as_string()
8043 Returns a multi-line description of the bundle
8045 =item CPAN::Bundle::clean()
8047 Recursively runs the C<clean> method on all items contained in the bundle.
8049 =item CPAN::Bundle::contains()
8051 Returns a list of objects' IDs contained in a bundle. The associated
8052 objects may be bundles, modules or distributions.
8054 =item CPAN::Bundle::force($method,@args)
8056 Forces CPAN to perform a task that normally would have failed. Force
8057 takes as arguments a method name to be called and any number of
8058 additional arguments that should be passed to the called method. The
8059 internals of the object get the needed changes so that CPAN.pm does
8060 not refuse to take the action. The C<force> is passed recursively to
8061 all contained objects.
8063 =item CPAN::Bundle::get()
8065 Recursively runs the C<get> method on all items contained in the bundle
8067 =item CPAN::Bundle::inst_file()
8069 Returns the highest installed version of the bundle in either @INC or
8070 C<$CPAN::Config->{cpan_home}>. Note that this is different from
8071 CPAN::Module::inst_file.
8073 =item CPAN::Bundle::inst_version()
8075 Like CPAN::Bundle::inst_file, but returns the $VERSION
8077 =item CPAN::Bundle::uptodate()
8079 Returns 1 if the bundle itself and all its members are uptodate.
8081 =item CPAN::Bundle::install()
8083 Recursively runs the C<install> method on all items contained in the bundle
8085 =item CPAN::Bundle::make()
8087 Recursively runs the C<make> method on all items contained in the bundle
8089 =item CPAN::Bundle::readme()
8091 Recursively runs the C<readme> method on all items contained in the bundle
8093 =item CPAN::Bundle::test()
8095 Recursively runs the C<test> method on all items contained in the bundle
8097 =item CPAN::Distribution::as_glimpse()
8099 Returns a one-line description of the distribution
8101 =item CPAN::Distribution::as_string()
8103 Returns a multi-line description of the distribution
8105 =item CPAN::Distribution::author
8107 Returns the CPAN::Author object of the maintainer who uploaded this
8110 =item CPAN::Distribution::clean()
8112 Changes to the directory where the distribution has been unpacked and
8113 runs C<make clean> there.
8115 =item CPAN::Distribution::containsmods()
8117 Returns a list of IDs of modules contained in a distribution file.
8118 Only works for distributions listed in the 02packages.details.txt.gz
8119 file. This typically means that only the most recent version of a
8120 distribution is covered.
8122 =item CPAN::Distribution::cvs_import()
8124 Changes to the directory where the distribution has been unpacked and
8127 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
8131 =item CPAN::Distribution::dir()
8133 Returns the directory into which this distribution has been unpacked.
8135 =item CPAN::Distribution::force($method,@args)
8137 Forces CPAN to perform a task that normally would have failed. Force
8138 takes as arguments a method name to be called and any number of
8139 additional arguments that should be passed to the called method. The
8140 internals of the object get the needed changes so that CPAN.pm does
8141 not refuse to take the action.
8143 =item CPAN::Distribution::get()
8145 Downloads the distribution from CPAN and unpacks it. Does nothing if
8146 the distribution has already been downloaded and unpacked within the
8149 =item CPAN::Distribution::install()
8151 Changes to the directory where the distribution has been unpacked and
8152 runs the external command C<make install> there. If C<make> has not
8153 yet been run, it will be run first. A C<make test> will be issued in
8154 any case and if this fails, the install will be canceled. The
8155 cancellation can be avoided by letting C<force> run the C<install> for
8158 This install method has only the power to install the distribution if
8159 there are no dependencies in the way. To install an object and all of
8160 its dependencies, use CPAN::Shell->install.
8162 Note that install() gives no meaningful return value. See uptodate().
8164 =item CPAN::Distribution::isa_perl()
8166 Returns 1 if this distribution file seems to be a perl distribution.
8167 Normally this is derived from the file name only, but the index from
8168 CPAN can contain a hint to achieve a return value of true for other
8171 =item CPAN::Distribution::look()
8173 Changes to the directory where the distribution has been unpacked and
8174 opens a subshell there. Exiting the subshell returns.
8176 =item CPAN::Distribution::make()
8178 First runs the C<get> method to make sure the distribution is
8179 downloaded and unpacked. Changes to the directory where the
8180 distribution has been unpacked and runs the external commands C<perl
8181 Makefile.PL> or C<perl Build.PL> and C<make> there.
8183 =item CPAN::Distribution::perldoc()
8185 Downloads the pod documentation of the file associated with a
8186 distribution (in html format) and runs it through the external
8187 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
8188 isn't available, it converts it to plain text with external
8189 command html2text and runs it through the pager specified
8190 in C<$CPAN::Config->{pager}>
8192 =item CPAN::Distribution::prefs()
8194 Returns the hash reference from the first matching YAML file that the
8195 user has deposited in the C<prefs_dir/> directory. The first
8196 succeeding match wins. The files in the C<prefs_dir/> are processed
8197 alphabetically and the canonical distroname (e.g.
8198 AUTHOR/Foo-Bar-3.14.tar.gz) is matched against the regular expressions
8199 stored in the $root->{match}{distribution} attribute value.
8200 Additionally all module names contained in a distribution are matched
8201 agains the regular expressions in the $root->{match}{module} attribute
8202 value. The two match values are ANDed together. Each of the two
8203 attributes are optional.
8205 =item CPAN::Distribution::prereq_pm()
8207 Returns the hash reference that has been announced by a distribution
8208 as the merge of the C<requires> element and the C<build_requires>
8209 element of the META.yml or the C<PREREQ_PM> hash in the
8210 C<Makefile.PL>. Note: works only after an attempt has been made to
8211 C<make> the distribution. Returns undef otherwise.
8213 =item CPAN::Distribution::readme()
8215 Downloads the README file associated with a distribution and runs it
8216 through the pager specified in C<$CPAN::Config->{pager}>.
8218 =item CPAN::Distribution::read_yaml()
8220 Returns the content of the META.yml of this distro as a hashref. Note:
8221 works only after an attempt has been made to C<make> the distribution.
8222 Returns undef otherwise.
8224 =item CPAN::Distribution::test()
8226 Changes to the directory where the distribution has been unpacked and
8227 runs C<make test> there.
8229 =item CPAN::Distribution::uptodate()
8231 Returns 1 if all the modules contained in the distribution are
8232 uptodate. Relies on containsmods.
8234 =item CPAN::Index::force_reload()
8236 Forces a reload of all indices.
8238 =item CPAN::Index::reload()
8240 Reloads all indices if they have not been read for more than
8241 C<$CPAN::Config->{index_expire}> days.
8243 =item CPAN::InfoObj::dump()
8245 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
8246 inherit this method. It prints the data structure associated with an
8247 object. Useful for debugging. Note: the data structure is considered
8248 internal and thus subject to change without notice.
8250 =item CPAN::Module::as_glimpse()
8252 Returns a one-line description of the module in four columns: The
8253 first column contains the word C<Module>, the second column consists
8254 of one character: an equals sign if this module is already installed
8255 and uptodate, a less-than sign if this module is installed but can be
8256 upgraded, and a space if the module is not installed. The third column
8257 is the name of the module and the fourth column gives maintainer or
8258 distribution information.
8260 =item CPAN::Module::as_string()
8262 Returns a multi-line description of the module
8264 =item CPAN::Module::clean()
8266 Runs a clean on the distribution associated with this module.
8268 =item CPAN::Module::cpan_file()
8270 Returns the filename on CPAN that is associated with the module.
8272 =item CPAN::Module::cpan_version()
8274 Returns the latest version of this module available on CPAN.
8276 =item CPAN::Module::cvs_import()
8278 Runs a cvs_import on the distribution associated with this module.
8280 =item CPAN::Module::description()
8282 Returns a 44 character description of this module. Only available for
8283 modules listed in The Module List (CPAN/modules/00modlist.long.html
8284 or 00modlist.long.txt.gz)
8286 =item CPAN::Module::distribution()
8288 Returns the CPAN::Distribution object that contains the current
8289 version of this module.
8291 =item CPAN::Module::dslip_status()
8293 Returns a hash reference. The keys of the hash are the letters C<D>,
8294 C<S>, C<L>, C<I>, and <P>, for development status, support level,
8295 language, interface and public licence respectively. The data for the
8296 DSLIP status are collected by pause.perl.org when authors register
8297 their namespaces. The values of the 5 hash elements are one-character
8298 words whose meaning is described in the table below. There are also 5
8299 hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
8300 verbose value of the 5 status variables.
8302 Where the 'DSLIP' characters have the following meanings:
8304 D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
8305 i - Idea, listed to gain consensus or as a placeholder
8306 c - under construction but pre-alpha (not yet released)
8307 a/b - Alpha/Beta testing
8309 M - Mature (no rigorous definition)
8310 S - Standard, supplied with Perl 5
8315 u - Usenet newsgroup comp.lang.perl.modules
8316 n - None known, try comp.lang.perl.modules
8317 a - abandoned; volunteers welcome to take over maintainance
8320 p - Perl-only, no compiler needed, should be platform independent
8321 c - C and perl, a C compiler will be needed
8322 h - Hybrid, written in perl with optional C code, no compiler needed
8323 + - C++ and perl, a C++ compiler will be needed
8324 o - perl and another language other than C or C++
8327 f - plain Functions, no references used
8328 h - hybrid, object and function interfaces available
8329 n - no interface at all (huh?)
8330 r - some use of unblessed References or ties
8331 O - Object oriented using blessed references and/or inheritance
8334 p - Standard-Perl: user may choose between GPL and Artistic
8335 g - GPL: GNU General Public License
8336 l - LGPL: "GNU Lesser General Public License" (previously known as
8337 "GNU Library General Public License")
8338 b - BSD: The BSD License
8339 a - Artistic license alone
8340 o - open source: appoved by www.opensource.org
8341 d - allows distribution without restrictions
8342 r - restricted distribtion
8343 n - no license at all
8345 =item CPAN::Module::force($method,@args)
8347 Forces CPAN to perform a task that normally would have failed. Force
8348 takes as arguments a method name to be called and any number of
8349 additional arguments that should be passed to the called method. The
8350 internals of the object get the needed changes so that CPAN.pm does
8351 not refuse to take the action.
8353 =item CPAN::Module::get()
8355 Runs a get on the distribution associated with this module.
8357 =item CPAN::Module::inst_file()
8359 Returns the filename of the module found in @INC. The first file found
8360 is reported just like perl itself stops searching @INC when it finds a
8363 =item CPAN::Module::inst_version()
8365 Returns the version number of the module in readable format.
8367 =item CPAN::Module::install()
8369 Runs an C<install> on the distribution associated with this module.
8371 =item CPAN::Module::look()
8373 Changes to the directory where the distribution associated with this
8374 module has been unpacked and opens a subshell there. Exiting the
8377 =item CPAN::Module::make()
8379 Runs a C<make> on the distribution associated with this module.
8381 =item CPAN::Module::manpage_headline()
8383 If module is installed, peeks into the module's manpage, reads the
8384 headline and returns it. Moreover, if the module has been downloaded
8385 within this session, does the equivalent on the downloaded module even
8386 if it is not installed.
8388 =item CPAN::Module::perldoc()
8390 Runs a C<perldoc> on this module.
8392 =item CPAN::Module::readme()
8394 Runs a C<readme> on the distribution associated with this module.
8396 =item CPAN::Module::test()
8398 Runs a C<test> on the distribution associated with this module.
8400 =item CPAN::Module::uptodate()
8402 Returns 1 if the module is installed and up-to-date.
8404 =item CPAN::Module::userid()
8406 Returns the author's ID of the module.
8410 =head2 Cache Manager
8412 Currently the cache manager only keeps track of the build directory
8413 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
8414 deletes complete directories below C<build_dir> as soon as the size of
8415 all directories there gets bigger than $CPAN::Config->{build_cache}
8416 (in MB). The contents of this cache may be used for later
8417 re-installations that you intend to do manually, but will never be
8418 trusted by CPAN itself. This is due to the fact that the user might
8419 use these directories for building modules on different architectures.
8421 There is another directory ($CPAN::Config->{keep_source_where}) where
8422 the original distribution files are kept. This directory is not
8423 covered by the cache manager and must be controlled by the user. If
8424 you choose to have the same directory as build_dir and as
8425 keep_source_where directory, then your sources will be deleted with
8426 the same fifo mechanism.
8430 A bundle is just a perl module in the namespace Bundle:: that does not
8431 define any functions or methods. It usually only contains documentation.
8433 It starts like a perl module with a package declaration and a $VERSION
8434 variable. After that the pod section looks like any other pod with the
8435 only difference being that I<one special pod section> exists starting with
8440 In this pod section each line obeys the format
8442 Module_Name [Version_String] [- optional text]
8444 The only required part is the first field, the name of a module
8445 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
8446 of the line is optional. The comment part is delimited by a dash just
8447 as in the man page header.
8449 The distribution of a bundle should follow the same convention as
8450 other distributions.
8452 Bundles are treated specially in the CPAN package. If you say 'install
8453 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
8454 the modules in the CONTENTS section of the pod. You can install your
8455 own Bundles locally by placing a conformant Bundle file somewhere into
8456 your @INC path. The autobundle() command which is available in the
8457 shell interface does that for you by including all currently installed
8458 modules in a snapshot bundle file.
8460 =head1 PREREQUISITES
8462 If you have a local mirror of CPAN and can access all files with
8463 "file:" URLs, then you only need a perl better than perl5.003 to run
8464 this module. Otherwise Net::FTP is strongly recommended. LWP may be
8465 required for non-UNIX systems or if your nearest CPAN site is
8466 associated with a URL that is not C<ftp:>.
8468 If you have neither Net::FTP nor LWP, there is a fallback mechanism
8469 implemented for an external ftp command or for an external lynx
8474 =head2 Finding packages and VERSION
8476 This module presumes that all packages on CPAN
8482 declare their $VERSION variable in an easy to parse manner. This
8483 prerequisite can hardly be relaxed because it consumes far too much
8484 memory to load all packages into the running program just to determine
8485 the $VERSION variable. Currently all programs that are dealing with
8486 version use something like this
8488 perl -MExtUtils::MakeMaker -le \
8489 'print MM->parse_version(shift)' filename
8491 If you are author of a package and wonder if your $VERSION can be
8492 parsed, please try the above method.
8496 come as compressed or gzipped tarfiles or as zip files and contain a
8497 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
8498 without much enthusiasm).
8504 The debugging of this module is a bit complex, because we have
8505 interferences of the software producing the indices on CPAN, of the
8506 mirroring process on CPAN, of packaging, of configuration, of
8507 synchronicity, and of bugs within CPAN.pm.
8509 For debugging the code of CPAN.pm itself in interactive mode some more
8510 or less useful debugging aid can be turned on for most packages within
8515 =item o debug package...
8517 sets debug mode for packages.
8519 =item o debug -package...
8521 unsets debug mode for packages.
8525 turns debugging on for all packages.
8527 =item o debug number
8531 which sets the debugging packages directly. Note that C<o debug 0>
8532 turns debugging off.
8534 What seems quite a successful strategy is the combination of C<reload
8535 cpan> and the debugging switches. Add a new debug statement while
8536 running in the shell and then issue a C<reload cpan> and see the new
8537 debugging messages immediately without losing the current context.
8539 C<o debug> without an argument lists the valid package names and the
8540 current set of packages in debugging mode. C<o debug> has built-in
8543 For debugging of CPAN data there is the C<dump> command which takes
8544 the same arguments as make/test/install and outputs each object's
8545 Data::Dumper dump. If an argument looks like a perl variable and
8546 contains one of C<$>, C<@> or C<%>, it is eval()ed and fed to
8547 Data::Dumper directly.
8549 =head2 Floppy, Zip, Offline Mode
8551 CPAN.pm works nicely without network too. If you maintain machines
8552 that are not networked at all, you should consider working with file:
8553 URLs. Of course, you have to collect your modules somewhere first. So
8554 you might use CPAN.pm to put together all you need on a networked
8555 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
8556 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
8557 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
8558 with this floppy. See also below the paragraph about CD-ROM support.
8560 =head2 Basic Utilities for Programmers
8564 =item has_inst($module)
8566 Returns true if the module is installed. See the source for details.
8568 =item has_usable($module)
8570 Returns true if the module is installed and several and is in a usable
8571 state. Only useful for a handful of modules that are used internally.
8572 See the source for details.
8574 =item instance($module)
8576 The constructor for all the singletons used to represent modules,
8577 distributions, authors and bundles. If the object already exists, this
8578 method returns the object, otherwise it calls the constructor.
8582 =head1 CONFIGURATION
8584 When the CPAN module is used for the first time, a configuration
8585 dialog tries to determine a couple of site specific options. The
8586 result of the dialog is stored in a hash reference C< $CPAN::Config >
8587 in a file CPAN/Config.pm.
8589 The default values defined in the CPAN/Config.pm file can be
8590 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
8591 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
8592 added to the search path of the CPAN module before the use() or
8593 require() statements.
8595 The configuration dialog can be started any time later again by
8596 issuing the command C< o conf init > in the CPAN shell. A subset of
8597 the configuration dialog can be run by issuing C<o conf init WORD>
8598 where WORD is any valid config variable or a regular expression.
8600 Currently the following keys in the hash reference $CPAN::Config are
8603 build_cache size of cache for directories to build modules
8604 build_dir locally accessible directory to build modules
8605 build_requires_install_policy
8606 to install or not to install: when a module is
8607 only needed for building. yes|no|ask/yes|ask/no
8608 bzip2 path to external prg
8609 cache_metadata use serializer to cache metadata
8610 commands_quote prefered character to use for quoting external
8611 commands when running them. Defaults to double
8612 quote on Windows, single tick everywhere else;
8613 can be set to space to disable quoting
8614 check_sigs if signatures should be verified
8615 colorize_output boolean if Term::ANSIColor should colorize output
8616 colorize_print Term::ANSIColor attributes for normal output
8617 colorize_warn Term::ANSIColor attributes for warnings
8618 commandnumber_in_prompt
8619 boolean if you want to see current command number
8620 cpan_home local directory reserved for this package
8621 curl path to external prg
8622 dontload_hash DEPRECATED
8623 dontload_list arrayref: modules in the list will not be
8624 loaded by the CPAN::has_inst() routine
8625 ftp path to external prg
8626 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
8627 ftp_proxy proxy host for ftp requests
8629 gpg path to external prg
8630 gzip location of external program gzip
8631 histfile file to maintain history between sessions
8632 histsize maximum number of lines to keep in histfile
8633 http_proxy proxy host for http requests
8634 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
8635 after this many seconds inactivity. Set to 0 to
8637 index_expire after this many days refetch index files
8638 inhibit_startup_message
8639 if true, does not print the startup message
8640 keep_source_where directory in which to keep the source (if we do)
8641 lynx path to external prg
8642 make location of external make program
8643 make_arg arguments that should always be passed to 'make'
8644 make_install_make_command
8645 the make command for running 'make install', for
8647 make_install_arg same as make_arg for 'make install'
8648 makepl_arg arguments passed to 'perl Makefile.PL'
8649 mbuild_arg arguments passed to './Build'
8650 mbuild_install_arg arguments passed to './Build install'
8651 mbuild_install_build_command
8652 command to use instead of './Build' when we are
8653 in the install stage, for example 'sudo ./Build'
8654 mbuildpl_arg arguments passed to 'perl Build.PL'
8655 ncftp path to external prg
8656 ncftpget path to external prg
8657 no_proxy don't proxy to these hosts/domains (comma separated list)
8658 pager location of external program more (or any pager)
8659 password your password if you CPAN server wants one
8660 prefer_installer legal values are MB and EUMM: if a module comes
8661 with both a Makefile.PL and a Build.PL, use the
8662 former (EUMM) or the latter (MB); if the module
8663 comes with only one of the two, that one will be
8665 prerequisites_policy
8666 what to do if you are missing module prerequisites
8667 ('follow' automatically, 'ask' me, or 'ignore')
8668 prefs_dir local directory to store per-distro build options
8669 proxy_user username for accessing an authenticating proxy
8670 proxy_pass password for accessing an authenticating proxy
8671 scan_cache controls scanning of cache ('atstart' or 'never')
8672 shell your favorite shell
8673 show_upload_date boolean if commands should try to determine upload date
8674 tar location of external program tar
8675 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
8676 (and nonsense for characters outside latin range)
8677 term_ornaments boolean to turn ReadLine ornamenting on/off
8678 test_report email test reports (if CPAN::Reporter is installed)
8679 unzip location of external program unzip
8680 urllist arrayref to nearby CPAN sites (or equivalent locations)
8681 username your username if you CPAN server wants one
8682 wait_list arrayref to a wait server to try (See CPAN::WAIT)
8683 wget path to external prg
8684 yaml_module which module to use to read/write YAML files
8686 You can set and query each of these options interactively in the cpan
8687 shell with the command set defined within the C<o conf> command:
8691 =item C<o conf E<lt>scalar optionE<gt>>
8693 prints the current value of the I<scalar option>
8695 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
8697 Sets the value of the I<scalar option> to I<value>
8699 =item C<o conf E<lt>list optionE<gt>>
8701 prints the current value of the I<list option> in MakeMaker's
8704 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
8706 shifts or pops the array in the I<list option> variable
8708 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
8710 works like the corresponding perl commands.
8714 =head2 CPAN::anycwd($path): Note on config variable getcwd
8716 CPAN.pm changes the current working directory often and needs to
8717 determine its own current working directory. Per default it uses
8718 Cwd::cwd but if this doesn't work on your system for some reason,
8719 alternatives can be configured according to the following table:
8737 Calls the external command cwd.
8741 =head2 Note on urllist parameter's format
8743 urllist parameters are URLs according to RFC 1738. We do a little
8744 guessing if your URL is not compliant, but if you have problems with
8745 file URLs, please try the correct format. Either:
8747 file://localhost/whatever/ftp/pub/CPAN/
8751 file:///home/ftp/pub/CPAN/
8753 =head2 urllist parameter has CD-ROM support
8755 The C<urllist> parameter of the configuration table contains a list of
8756 URLs that are to be used for downloading. If the list contains any
8757 C<file> URLs, CPAN always tries to get files from there first. This
8758 feature is disabled for index files. So the recommendation for the
8759 owner of a CD-ROM with CPAN contents is: include your local, possibly
8760 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
8762 o conf urllist push file://localhost/CDROM/CPAN
8764 CPAN.pm will then fetch the index files from one of the CPAN sites
8765 that come at the beginning of urllist. It will later check for each
8766 module if there is a local copy of the most recent version.
8768 Another peculiarity of urllist is that the site that we could
8769 successfully fetch the last file from automatically gets a preference
8770 token and is tried as the first site for the next request. So if you
8771 add a new site at runtime it may happen that the previously preferred
8772 site will be tried another time. This means that if you want to disallow
8773 a site for the next transfer, it must be explicitly removed from
8776 =head2 prefs_dir for avoiding interactive questions (ALPHA)
8778 (B<Note:> This feature has been introduced in CPAN.pm 1.8854 and is
8779 still considered experimental and may still be changed)
8781 The files in the directory specified in C<prefs_dir> are YAML files
8782 that specify how CPAN.pm shall treat distributions that deviate from
8783 the normal non-interactive model of building and installing CPAN
8786 Some modules try to get some data from the user interactively thus
8787 disturbing the installation of large bundles like Phalanx100 or
8788 modules like Plagger.
8790 CPAN.pm can use YAML files to either pass additional arguments to one
8791 of the four commands, set environment variables or instantiate an
8792 Expect object that reads from the console, waits for some regular
8793 expression and enters some answer. Needless to say that for the latter
8794 option Expect.pm needs to be installed.
8796 CPAN.pm comes with a couple of such YAML files. The structure is
8797 currently not documented. Please see the distroprefs directory of the
8798 CPAN distribution for examples and follow the README in there.
8800 Please note that setting the environment variable PERL_MM_USE_DEFAULT
8801 to a true value can also get you a long way if you want to always pick
8802 the default answers. But this only works if the author of apackage
8803 used the prompt function provided by ExtUtils::MakeMaker and if the
8804 defaults are OK for you.
8808 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
8809 install foreign, unmasked, unsigned code on your machine. We compare
8810 to a checksum that comes from the net just as the distribution file
8811 itself. But we try to make it easy to add security on demand:
8813 =head2 Cryptographically signed modules
8815 Since release 1.77 CPAN.pm has been able to verify cryptographically
8816 signed module distributions using Module::Signature. The CPAN modules
8817 can be signed by their authors, thus giving more security. The simple
8818 unsigned MD5 checksums that were used before by CPAN protect mainly
8819 against accidental file corruption.
8821 You will need to have Module::Signature installed, which in turn
8822 requires that you have at least one of Crypt::OpenPGP module or the
8823 command-line F<gpg> tool installed.
8825 You will also need to be able to connect over the Internet to the public
8826 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
8828 The configuration parameter check_sigs is there to turn signature
8833 Most functions in package CPAN are exported per default. The reason
8834 for this is that the primary use is intended for the cpan shell or for
8839 When the CPAN shell enters a subshell via the look command, it sets
8840 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
8843 When the config variable ftp_passive is set, all downloads will be run
8844 with the environment variable FTP_PASSIVE set to this value. This is
8845 in general a good idea as it influences both Net::FTP and LWP based
8846 connections. The same effect can be achieved by starting the cpan
8847 shell with this environment variable set. For Net::FTP alone, one can
8848 also always set passive mode by running libnetcfg.
8850 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
8852 Populating a freshly installed perl with my favorite modules is pretty
8853 easy if you maintain a private bundle definition file. To get a useful
8854 blueprint of a bundle definition file, the command autobundle can be used
8855 on the CPAN shell command line. This command writes a bundle definition
8856 file for all modules that are installed for the currently running perl
8857 interpreter. It's recommended to run this command only once and from then
8858 on maintain the file manually under a private name, say
8859 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
8861 cpan> install Bundle::my_bundle
8863 then answer a few questions and then go out for a coffee.
8865 Maintaining a bundle definition file means keeping track of two
8866 things: dependencies and interactivity. CPAN.pm sometimes fails on
8867 calculating dependencies because not all modules define all MakeMaker
8868 attributes correctly, so a bundle definition file should specify
8869 prerequisites as early as possible. On the other hand, it's a bit
8870 annoying that many distributions need some interactive configuring. So
8871 what I try to accomplish in my private bundle file is to have the
8872 packages that need to be configured early in the file and the gentle
8873 ones later, so I can go out after a few minutes and leave CPAN.pm
8876 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
8878 Thanks to Graham Barr for contributing the following paragraphs about
8879 the interaction between perl, and various firewall configurations. For
8880 further information on firewalls, it is recommended to consult the
8881 documentation that comes with the ncftp program. If you are unable to
8882 go through the firewall with a simple Perl setup, it is very likely
8883 that you can configure ncftp so that it works for your firewall.
8885 =head2 Three basic types of firewalls
8887 Firewalls can be categorized into three basic types.
8893 This is where the firewall machine runs a web server and to access the
8894 outside world you must do it via the web server. If you set environment
8895 variables like http_proxy or ftp_proxy to a values beginning with http://
8896 or in your web browser you have to set proxy information then you know
8897 you are running an http firewall.
8899 To access servers outside these types of firewalls with perl (even for
8900 ftp) you will need to use LWP.
8904 This where the firewall machine runs an ftp server. This kind of
8905 firewall will only let you access ftp servers outside the firewall.
8906 This is usually done by connecting to the firewall with ftp, then
8907 entering a username like "user@outside.host.com"
8909 To access servers outside these type of firewalls with perl you
8910 will need to use Net::FTP.
8912 =item One way visibility
8914 I say one way visibility as these firewalls try to make themselves look
8915 invisible to the users inside the firewall. An FTP data connection is
8916 normally created by sending the remote server your IP address and then
8917 listening for the connection. But the remote server will not be able to
8918 connect to you because of the firewall. So for these types of firewall
8919 FTP connections need to be done in a passive mode.
8921 There are two that I can think off.
8927 If you are using a SOCKS firewall you will need to compile perl and link
8928 it with the SOCKS library, this is what is normally called a 'socksified'
8929 perl. With this executable you will be able to connect to servers outside
8930 the firewall as if it is not there.
8934 This is the firewall implemented in the Linux kernel, it allows you to
8935 hide a complete network behind one IP address. With this firewall no
8936 special compiling is needed as you can access hosts directly.
8938 For accessing ftp servers behind such firewalls you usually need to
8939 set the environment variable C<FTP_PASSIVE> or the config variable
8940 ftp_passive to a true value.
8946 =head2 Configuring lynx or ncftp for going through a firewall
8948 If you can go through your firewall with e.g. lynx, presumably with a
8951 /usr/local/bin/lynx -pscott:tiger
8953 then you would configure CPAN.pm with the command
8955 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
8957 That's all. Similarly for ncftp or ftp, you would configure something
8960 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
8962 Your mileage may vary...
8970 I installed a new version of module X but CPAN keeps saying,
8971 I have the old version installed
8973 Most probably you B<do> have the old version installed. This can
8974 happen if a module installs itself into a different directory in the
8975 @INC path than it was previously installed. This is not really a
8976 CPAN.pm problem, you would have the same problem when installing the
8977 module manually. The easiest way to prevent this behaviour is to add
8978 the argument C<UNINST=1> to the C<make install> call, and that is why
8979 many people add this argument permanently by configuring
8981 o conf make_install_arg UNINST=1
8985 So why is UNINST=1 not the default?
8987 Because there are people who have their precise expectations about who
8988 may install where in the @INC path and who uses which @INC array. In
8989 fine tuned environments C<UNINST=1> can cause damage.
8993 I want to clean up my mess, and install a new perl along with
8994 all modules I have. How do I go about it?
8996 Run the autobundle command for your old perl and optionally rename the
8997 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
8998 with the Configure option prefix, e.g.
9000 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
9002 Install the bundle file you produced in the first step with something like
9004 cpan> install Bundle::mybundle
9010 When I install bundles or multiple modules with one command
9011 there is too much output to keep track of.
9013 You may want to configure something like
9015 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
9016 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
9018 so that STDOUT is captured in a file for later inspection.
9023 I am not root, how can I install a module in a personal directory?
9025 First of all, you will want to use your own configuration, not the one
9026 that your root user installed. If you do not have permission to write
9027 in the cpan directory that root has configured, you will be asked if
9028 you want to create your own config. Answering "yes" will bring you into
9029 CPAN's configuration stage, using the system config for all defaults except
9030 things that have to do with CPAN's work directory, saving your choices to
9031 your MyConfig.pm file.
9033 You can also manually initiate this process with the following command:
9035 % perl -MCPAN -e 'mkmyconfig'
9041 from the CPAN shell.
9043 You will most probably also want to configure something like this:
9045 o conf makepl_arg "LIB=~/myperl/lib \
9046 INSTALLMAN1DIR=~/myperl/man/man1 \
9047 INSTALLMAN3DIR=~/myperl/man/man3"
9049 You can make this setting permanent like all C<o conf> settings with
9052 You will have to add ~/myperl/man to the MANPATH environment variable
9053 and also tell your perl programs to look into ~/myperl/lib, e.g. by
9056 use lib "$ENV{HOME}/myperl/lib";
9058 or setting the PERL5LIB environment variable.
9060 While we're speaking about $ENV{HOME}, it might be worth mentioning,
9061 that for Windows we use the File::HomeDir module that provides an
9062 equivalent to the concept of the home directory on Unix.
9064 Another thing you should bear in mind is that the UNINST parameter can
9065 be dnagerous when you are installing into a private area because you
9066 might accidentally remove modules that other people depend on that are
9067 not using the private area.
9071 How to get a package, unwrap it, and make a change before building it?
9073 Have a look at the C<look> (!) command.
9077 I installed a Bundle and had a couple of fails. When I
9078 retried, everything resolved nicely. Can this be fixed to work
9081 The reason for this is that CPAN does not know the dependencies of all
9082 modules when it starts out. To decide about the additional items to
9083 install, it just uses data found in the META.yml file or the generated
9084 Makefile. An undetected missing piece breaks the process. But it may
9085 well be that your Bundle installs some prerequisite later than some
9086 depending item and thus your second try is able to resolve everything.
9087 Please note, CPAN.pm does not know the dependency tree in advance and
9088 cannot sort the queue of things to install in a topologically correct
9089 order. It resolves perfectly well IF all modules declare the
9090 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
9091 the C<requires> stanza of Module::Build. For bundles which fail and
9092 you need to install often, it is recommended to sort the Bundle
9093 definition file manually.
9097 In our intranet we have many modules for internal use. How
9098 can I integrate these modules with CPAN.pm but without uploading
9099 the modules to CPAN?
9101 Have a look at the CPAN::Site module.
9105 When I run CPAN's shell, I get an error message about things in my
9106 /etc/inputrc (or ~/.inputrc) file.
9108 These are readline issues and can only be fixed by studying readline
9109 configuration on your architecture and adjusting the referenced file
9110 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
9111 and edit them. Quite often harmless changes like uppercasing or
9112 lowercasing some arguments solves the problem.
9116 Some authors have strange characters in their names.
9118 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
9119 expecting ISO-8859-1 charset, a converter can be activated by setting
9120 term_is_latin to a true value in your config file. One way of doing so
9123 cpan> o conf term_is_latin 1
9125 If other charset support is needed, please file a bugreport against
9126 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
9127 the support or maybe UTF-8 terminals become widely available.
9131 When an install fails for some reason and then I correct the error
9132 condition and retry, CPAN.pm refuses to install the module, saying
9133 C<Already tried without success>.
9135 Use the force pragma like so
9137 force install Foo::Bar
9139 This does a bit more than really needed because it untars the
9140 distribution again and runs make and test and only then install.
9142 Or, if you find this is too fast and you would prefer to do smaller
9147 first and then continue as always. C<Force get> I<forgets> previous
9154 and then 'make install' directly in the subshell.
9156 Or you leave the CPAN shell and start it again.
9158 For the really curious, by accessing internals directly, you I<could>
9160 !delete CPAN::Shell->expandany("Foo::Bar")->distribution->{install}
9162 but this is neither guaranteed to work in the future nor is it a
9167 How do I install a "DEVELOPER RELEASE" of a module?
9169 By default, CPAN will install the latest non-developer release of a
9170 module. If you want to install a dev release, you have to specify the
9171 partial path starting with the author id to the tarball you wish to
9174 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
9176 Note that you can use the C<ls> command to get this path listed.
9180 How do I install a module and all its dependencies from the commandline,
9181 without being prompted for anything, despite my CPAN configuration
9184 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
9185 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
9186 asked any questions at all (assuming the modules you are installing are
9187 nice about obeying that variable as well):
9189 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
9193 How do I create a Module::Build based Build.PL derived from an
9194 ExtUtils::MakeMaker focused Makefile.PL?
9196 http://search.cpan.org/search?query=Module::Build::Convert
9198 http://accognoscere.org/papers/perl-module-build-convert/module-build-convert.html
9205 Please report bugs via http://rt.cpan.org/
9207 Before submitting a bug, please make sure that the traditional method
9208 of building a Perl module package from a shell by following the
9209 installation instructions of that package still works in your
9212 =head1 SECURITY ADVICE
9214 This software enables you to upgrade software on your computer and so
9215 is inherently dangerous because the newly installed software may
9216 contain bugs and may alter the way your computer works or even make it
9217 unusable. Please consider backing up your data before every upgrade.
9221 Andreas Koenig C<< <andk@cpan.org> >>
9225 This program is free software; you can redistribute it and/or
9226 modify it under the same terms as Perl itself.
9228 See L<http://www.perl.com/perl/misc/Artistic.html>
9232 Kawai,Takanori provides a Japanese translation of this manpage at
9233 http://member.nifty.ne.jp/hippo2000/perltips/CPAN.htm
9237 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)