1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 $CPAN::VERSION = '1.88_77';
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 ();
28 use Sys::Hostname qw(hostname);
29 use Text::ParseWords ();
32 # we need to run chdir all over and we would get at wrong libraries
35 if (File::Spec->can("rel2abs")) {
37 $inc = File::Spec->rel2abs($inc);
43 require Mac::BuildTools if $^O eq 'MacOS';
44 $ENV{PERL5_CPAN_IS_RUNNING}=1;
46 END { $CPAN::End++; &cleanup; }
49 $CPAN::Frontend ||= "CPAN::Shell";
50 unless (@CPAN::Defaultsites){
51 @CPAN::Defaultsites = map {
52 CPAN::URL->new(TEXT => $_, FROM => "DEF")
54 "http://www.perl.org/CPAN/",
55 "ftp://ftp.perl.org/pub/CPAN/";
57 # $CPAN::iCwd (i for initial) is going to be initialized during find_perl
58 $CPAN::Perl ||= CPAN::find_perl();
59 $CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
60 $CPAN::Defaultrecent ||= "http://search.cpan.org/recent";
62 # our globals are getting a mess
88 @CPAN::ISA = qw(CPAN::Debug Exporter);
90 # note that these functions live in CPAN::Shell and get executed via
91 # AUTOLOAD when called directly
117 sub soft_chdir_with_alternatives ($);
120 $autoload_recursion ||= 0;
122 #-> sub CPAN::AUTOLOAD ;
124 $autoload_recursion++;
128 warn "Refusing to autoload '$l' while signal pending";
129 $autoload_recursion--;
132 if ($autoload_recursion > 1) {
133 my $fullcommand = join " ", map { "'$_'" } $l, @_;
134 warn "Refusing to autoload $fullcommand in recursion\n";
135 $autoload_recursion--;
139 @export{@EXPORT} = '';
140 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
141 if (exists $export{$l}){
144 die(qq{Unknown CPAN command "$AUTOLOAD". }.
145 qq{Type ? for help.\n});
147 $autoload_recursion--;
151 #-> sub CPAN::shell ;
154 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
155 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
157 my $oprompt = shift || CPAN::Prompt->new;
158 my $prompt = $oprompt;
159 my $commandline = shift || "";
160 $CPAN::CurrentCommandId ||= 1;
163 unless ($Suppress_readline) {
164 require Term::ReadLine;
167 $term->ReadLine eq "Term::ReadLine::Stub"
169 $term = Term::ReadLine->new('CPAN Monitor');
171 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
172 my $attribs = $term->Attribs;
173 $attribs->{attempted_completion_function} = sub {
174 &CPAN::Complete::gnu_cpl;
177 $readline::rl_completion_function =
178 $readline::rl_completion_function = 'CPAN::Complete::cpl';
180 if (my $histfile = $CPAN::Config->{'histfile'}) {{
181 unless ($term->can("AddHistory")) {
182 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
185 $META->readhist($term,$histfile);
187 for ($CPAN::Config->{term_ornaments}) { # alias
188 local $Term::ReadLine::termcap_nowarn = 1;
189 $term->ornaments($_) if defined;
191 # $term->OUT is autoflushed anyway
192 my $odef = select STDERR;
200 my @cwd = grep { defined $_ and length $_ }
202 File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
203 File::Spec->rootdir();
204 my $try_detect_readline;
205 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
206 my $rl_avail = $Suppress_readline ? "suppressed" :
207 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
208 "available (try 'install Bundle::CPAN')";
210 unless ($CPAN::Config->{'inhibit_startup_message'}){
211 $CPAN::Frontend->myprint(
213 cpan shell -- CPAN exploration and modules installation (v%s)
221 my($continuation) = "";
222 my $last_term_ornaments;
223 SHELLCOMMAND: while () {
224 if ($Suppress_readline) {
226 last SHELLCOMMAND unless defined ($_ = <> );
229 last SHELLCOMMAND unless
230 defined ($_ = $term->readline($prompt, $commandline));
232 $_ = "$continuation$_" if $continuation;
234 next SHELLCOMMAND if /^$/;
235 $_ = 'h' if /^\s*\?/;
236 if (/^(?:q(?:uit)?|bye|exit)$/i) {
247 use vars qw($import_done);
248 CPAN->import(':DEFAULT') unless $import_done++;
249 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
256 eval { @line = Text::ParseWords::shellwords($_) };
257 warn($@), next SHELLCOMMAND if $@;
258 warn("Text::Parsewords could not parse the line [$_]"),
259 next SHELLCOMMAND unless @line;
260 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
261 my $command = shift @line;
262 eval { CPAN::Shell->$command(@line) };
263 if ($@ && "$@" =~ /\S/){
265 Carp::cluck("Catching error: '$@'");
267 if ($command =~ /^(make|test|install|ff?orce|notest|clean|report|upgrade)$/) {
268 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
270 soft_chdir_with_alternatives(\@cwd);
271 $CPAN::Frontend->myprint("\n");
273 $CPAN::CurrentCommandId++;
277 $commandline = ""; # I do want to be able to pass a default to
278 # shell, but on the second command I see no
281 CPAN::Queue->nullify_queue;
282 if ($try_detect_readline) {
283 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
285 $CPAN::META->has_inst("Term::ReadLine::Perl")
287 delete $INC{"Term/ReadLine.pm"};
289 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
290 require Term::ReadLine;
291 $CPAN::Frontend->myprint("\n$redef subroutines in ".
292 "Term::ReadLine redefined\n");
296 if ($term and $term->can("ornaments")) {
297 for ($CPAN::Config->{term_ornaments}) { # alias
299 if (not defined $last_term_ornaments
300 or $_ != $last_term_ornaments
302 local $Term::ReadLine::termcap_nowarn = 1;
303 $term->ornaments($_);
304 $last_term_ornaments = $_;
307 undef $last_term_ornaments;
311 for my $class (qw(Module Distribution)) {
312 # again unsafe meta access?
313 for my $dm (keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) {
314 next unless $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
315 CPAN->debug("BUG: $class '$dm' was in command state, resetting");
316 delete $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
320 $GOTOSHELL = 0; # not too often
321 $META->savehist if $CPAN::term && $CPAN::term->can("GetHistory");
326 soft_chdir_with_alternatives(\@cwd);
329 sub soft_chdir_with_alternatives ($) {
332 my $root = File::Spec->rootdir();
333 $CPAN::Frontend->mywarn(qq{Warning: no good directory to chdir to!
334 Trying '$root' as temporary haven.
339 if (chdir $cwd->[0]) {
343 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
344 Trying to chdir to "$cwd->[1]" instead.
348 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
354 sub _yaml_module () {
355 my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
357 $yaml_module ne "YAML"
359 !$CPAN::META->has_inst($yaml_module)
361 # $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back to 'YAML'\n");
362 $yaml_module = "YAML";
367 # CPAN::_yaml_loadfile
369 my($self,$local_file) = @_;
370 return +[] unless -s $local_file;
371 my $yaml_module = _yaml_module;
372 if ($CPAN::META->has_inst($yaml_module)) {
374 if ($code = UNIVERSAL::can($yaml_module, "LoadFile")) {
376 eval { @yaml = $code->($local_file); };
378 # this shall not be done by the frontend
379 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
382 } elsif ($code = UNIVERSAL::can($yaml_module, "Load")) {
384 open FH, $local_file or die "Could not open '$local_file': $!";
388 eval { @yaml = $code->($ystream); };
390 # this shall not be done by the frontend
391 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
396 # this shall not be done by the frontend
397 die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "parse");
402 # CPAN::_yaml_dumpfile
404 my($self,$local_file,@what) = @_;
405 my $yaml_module = _yaml_module;
406 if ($CPAN::META->has_inst($yaml_module)) {
408 if (UNIVERSAL::isa($local_file, "FileHandle")) {
409 $code = UNIVERSAL::can($yaml_module, "Dump");
410 eval { print $local_file $code->(@what) };
411 } elsif ($code = UNIVERSAL::can($yaml_module, "DumpFile")) {
412 eval { $code->($local_file,@what); };
413 } elsif ($code = UNIVERSAL::can($yaml_module, "Dump")) {
415 open FH, ">$local_file" or die "Could not open '$local_file': $!";
416 print FH $code->(@what);
419 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"dump",$@);
422 if (UNIVERSAL::isa($local_file, "FileHandle")) {
423 # I think this case does not justify a warning at all
425 die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "dump");
430 sub _init_sqlite () {
431 unless ($CPAN::META->has_inst("CPAN::SQLite")) {
432 $CPAN::Frontend->mywarn(qq{CPAN::SQLite not installed, trying to work without\n})
433 unless $Have_warned->{"CPAN::SQLite"}++;
436 require CPAN::SQLite::META; # not needed since CVS version of 2006-12-17
437 $CPAN::SQLite ||= CPAN::SQLite::META->new($CPAN::META);
441 my $negative_cache = {};
442 sub _sqlite_running {
443 if ($negative_cache->{time} && time < $negative_cache->{time} + 60) {
444 # need to cache the result, otherwise too slow
445 return $negative_cache->{fact};
447 $negative_cache = {}; # reset
449 my $ret = $CPAN::Config->{use_sqlite} && ($CPAN::SQLite || _init_sqlite());
450 return $ret if $ret; # fast anyway
451 $negative_cache->{time} = time;
452 return $negative_cache->{fact} = $ret;
456 package CPAN::CacheMgr;
458 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
463 use Fcntl qw(:flock);
464 use vars qw($Ua $Thesite $ThesiteURL $Themethod);
465 @CPAN::FTP::ISA = qw(CPAN::Debug);
467 package CPAN::LWP::UserAgent;
469 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
470 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
472 package CPAN::Complete;
474 @CPAN::Complete::ISA = qw(CPAN::Debug);
475 # Q: where is the "How do I add a new command" HOWTO?
476 # A: svn diff -r 1048:1049 where andk added the report command
477 @CPAN::Complete::COMMANDS = sort qw(
478 ! a b d h i m o q r u
508 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED);
509 @CPAN::Index::ISA = qw(CPAN::Debug);
512 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
515 package CPAN::InfoObj;
517 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
519 package CPAN::Author;
521 @CPAN::Author::ISA = qw(CPAN::InfoObj);
523 package CPAN::Distribution;
525 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
527 package CPAN::Bundle;
529 @CPAN::Bundle::ISA = qw(CPAN::Module);
531 package CPAN::Module;
533 @CPAN::Module::ISA = qw(CPAN::InfoObj);
535 package CPAN::Exception::RecursiveDependency;
537 use overload '""' => "as_string";
539 # a module sees its distribution (no version)
540 # a distribution sees its prereqs (which are module names) (usually with versions)
541 # a bundle sees its module names and/or its distributions (no version)
548 for my $dep (@$deps) {
550 last if $seen{$dep}++;
552 bless { deps => \@deps }, $class;
557 "\nRecursive dependency detected:\n " .
558 join("\n => ", @{$self->{deps}}) .
559 ".\nCannot continue.\n";
562 package CPAN::Exception::yaml_not_installed;
564 use overload '""' => "as_string";
567 my($class,$module,$file,$during) = @_;
568 bless { module => $module, file => $file, during => $during }, $class;
573 "'$self->{module}' not installed, cannot $self->{during} '$self->{file}'\n";
576 package CPAN::Exception::yaml_process_error;
578 use overload '""' => "as_string";
581 my($class,$module,$file,$during,$error) = shift;
582 bless { module => $module,
585 error => $error }, $class;
590 "Alert: While trying to $self->{during} YAML file\n".
592 "with '$self->{module}' the following error was encountered:\n".
596 package CPAN::Prompt; use overload '""' => "as_string";
597 use vars qw($prompt);
599 $CPAN::CurrentCommandId ||= 0;
605 unless ($CPAN::META->{LOCK}) {
606 $word = "nolock_cpan";
608 if ($CPAN::Config->{commandnumber_in_prompt}) {
609 sprintf "$word\[%d]> ", $CPAN::CurrentCommandId;
615 package CPAN::URL; use overload '""' => "as_string", fallback => 1;
616 # accessors: TEXT(the url string), FROM(DEF=>defaultlist,USER=>urllist),
617 # planned are things like age or quality
619 my($class,%args) = @_;
631 $self->{TEXT} = $set;
636 package CPAN::Distrostatus;
637 use overload '""' => "as_string",
640 my($class,$arg) = @_;
643 FAILED => substr($arg,0,2) eq "NO",
644 COMMANDID => $CPAN::CurrentCommandId,
648 sub commandid { shift->{COMMANDID} }
649 sub failed { shift->{FAILED} }
653 $self->{TEXT} = $set;
672 @CPAN::Shell::ISA = qw(CPAN::Debug);
673 $COLOR_REGISTERED ||= 0;
676 $autoload_recursion ||= 0;
678 #-> sub CPAN::Shell::AUTOLOAD ;
680 $autoload_recursion++;
682 my $class = shift(@_);
683 # warn "autoload[$l] class[$class]";
686 warn "Refusing to autoload '$l' while signal pending";
687 $autoload_recursion--;
690 if ($autoload_recursion > 1) {
691 my $fullcommand = join " ", map { "'$_'" } $l, @_;
692 warn "Refusing to autoload $fullcommand in recursion\n";
693 $autoload_recursion--;
697 # XXX needs to be reconsidered
698 if ($CPAN::META->has_inst('CPAN::WAIT')) {
701 $CPAN::Frontend->mywarn(qq{
702 Commands starting with "w" require CPAN::WAIT to be installed.
703 Please consider installing CPAN::WAIT to use the fulltext index.
704 For this you just need to type
709 $CPAN::Frontend->mywarn(qq{Unknown shell command '$l'. }.
713 $autoload_recursion--;
720 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
722 # from here on only subs.
723 ################################################################################
725 sub _perl_fingerprint {
726 my($self,$other_fingerprint) = @_;
727 my $dll = eval {OS2::DLLname()};
730 $mtime_dll = (-f $dll ? (stat(_))[9] : '-1');
732 my $mtime_perl = (-f $^X ? (stat(_))[9] : '-1');
733 my $this_fingerprint = {
735 sitearchexp => $Config::Config{sitearchexp},
736 'mtime_$^X' => $mtime_perl,
737 'mtime_dll' => $mtime_dll,
739 if ($other_fingerprint) {
740 if (exists $other_fingerprint->{'stat($^X)'}) { # repair fp from rev. 1.88_57
741 $other_fingerprint->{'mtime_$^X'} = $other_fingerprint->{'stat($^X)'}[9];
743 # mandatory keys since 1.88_57
744 for my $key (qw($^X sitearchexp mtime_dll mtime_$^X)) {
745 return unless $other_fingerprint->{$key} eq $this_fingerprint->{$key};
749 return $this_fingerprint;
753 sub suggest_myconfig () {
754 SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
755 $CPAN::Frontend->myprint("You don't seem to have a user ".
756 "configuration (MyConfig.pm) yet.\n");
757 my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ".
758 "user configuration now? (Y/n)",
761 CPAN::Shell->mkmyconfig();
764 $CPAN::Frontend->mydie("OK, giving up.");
769 #-> sub CPAN::all_objects ;
771 my($mgr,$class) = @_;
772 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
773 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
775 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
778 # Called by shell, not in batch mode. In batch mode I see no risk in
779 # having many processes updating something as installations are
780 # continually checked at runtime. In shell mode I suspect it is
781 # unintentional to open more than one shell at a time
783 #-> sub CPAN::checklock ;
786 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
787 if (-f $lockfile && -M _ > 0) {
788 my $fh = FileHandle->new($lockfile) or
789 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
790 my $otherpid = <$fh>;
791 my $otherhost = <$fh>;
793 if (defined $otherpid && $otherpid) {
796 if (defined $otherhost && $otherhost) {
799 my $thishost = hostname();
800 if (defined $otherhost && defined $thishost &&
801 $otherhost ne '' && $thishost ne '' &&
802 $otherhost ne $thishost) {
803 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
804 "reports other host $otherhost and other ".
805 "process $otherpid.\n".
806 "Cannot proceed.\n"));
807 } elsif ($RUN_DEGRADED) {
808 $CPAN::Frontend->mywarn("Running in degraded mode (experimental)\n");
809 } elsif (defined $otherpid && $otherpid) {
810 return if $$ == $otherpid; # should never happen
811 $CPAN::Frontend->mywarn(
813 There seems to be running another CPAN process (pid $otherpid). Contacting...
815 if (kill 0, $otherpid) {
816 $CPAN::Frontend->mywarn(qq{Other job is running.\n});
818 CPAN::Shell::colorable_makemaker_prompt
819 (qq{Shall I try to run in degraded }.
820 qq{mode? (Y/n)},"y");
822 $CPAN::Frontend->mywarn("Running in degraded mode (experimental).
823 Please report if something unexpected happens\n");
825 for ($CPAN::Config) {
827 # $_->{build_dir_reuse} = 0; # 2006-11-17 akoenig Why was that?
828 $_->{commandnumber_in_prompt} = 0; # visibility
829 $_->{histfile} = ""; # who should win otherwise?
830 $_->{cache_metadata} = 0; # better would be a lock?
831 $_->{use_sqlite} = 0; # better would be a write lock!
834 $CPAN::Frontend->mydie("
835 You may want to kill the other job and delete the lockfile. On UNIX try:
840 } elsif (-w $lockfile) {
842 CPAN::Shell::colorable_makemaker_prompt
843 (qq{Other job not responding. Shall I overwrite }.
844 qq{the lockfile '$lockfile'? (Y/n)},"y");
845 $CPAN::Frontend->myexit("Ok, bye\n")
846 unless $ans =~ /^y/i;
849 qq{Lockfile '$lockfile' not writeable by you. }.
850 qq{Cannot proceed.\n}.
852 qq{ rm '$lockfile'\n}.
853 qq{ and then rerun us.\n}
857 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Found invalid lockfile ".
858 "'$lockfile', please remove. Cannot proceed.\n"));
861 my $dotcpan = $CPAN::Config->{cpan_home};
862 eval { File::Path::mkpath($dotcpan);};
864 # A special case at least for Jarkko.
869 $symlinkcpan = readlink $dotcpan;
870 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
871 eval { File::Path::mkpath($symlinkcpan); };
875 $CPAN::Frontend->mywarn(qq{
876 Working directory $symlinkcpan created.
880 unless (-d $dotcpan) {
882 Your configuration suggests "$dotcpan" as your
883 CPAN.pm working directory. I could not create this directory due
884 to this error: $firsterror\n};
886 As "$dotcpan" is a symlink to "$symlinkcpan",
887 I tried to create that, but I failed with this error: $seconderror
890 Please make sure the directory exists and is writable.
892 $CPAN::Frontend->myprint($mess);
893 return suggest_myconfig;
895 } # $@ after eval mkpath $dotcpan
896 if (0) { # to test what happens when a race condition occurs
897 for (reverse 1..10) {
903 if (!$RUN_DEGRADED && !$self->{LOCKFH}) {
905 unless ($fh = FileHandle->new("+>>$lockfile")) {
906 if ($! =~ /Permission/) {
907 $CPAN::Frontend->myprint(qq{
909 Your configuration suggests that CPAN.pm should use a working
911 $CPAN::Config->{cpan_home}
912 Unfortunately we could not create the lock file
914 due to permission problems.
916 Please make sure that the configuration variable
917 \$CPAN::Config->{cpan_home}
918 points to a directory where you can write a .lock file. You can set
919 this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
922 return suggest_myconfig;
926 while (!flock $fh, LOCK_EX|LOCK_NB) {
928 $CPAN::Frontend->mydie("Giving up\n");
930 $CPAN::Frontend->mysleep($sleep++);
931 $CPAN::Frontend->mywarn("Could not lock lockfile with flock: $!; retrying\n");
936 $fh->print($$, "\n");
937 $fh->print(hostname(), "\n");
938 $self->{LOCK} = $lockfile;
939 $self->{LOCKFH} = $fh;
944 $CPAN::Frontend->mydie("Got SIG$sig, leaving");
950 die "Got yet another signal" if $Signal > 1;
951 $CPAN::Frontend->mydie("Got another SIG$sig") if $Signal;
952 $CPAN::Frontend->mywarn("Caught SIG$sig, trying to continue\n");
956 # From: Larry Wall <larry@wall.org>
957 # Subject: Re: deprecating SIGDIE
958 # To: perl5-porters@perl.org
959 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
961 # The original intent of __DIE__ was only to allow you to substitute one
962 # kind of death for another on an application-wide basis without respect
963 # to whether you were in an eval or not. As a global backstop, it should
964 # not be used any more lightly (or any more heavily :-) than class
965 # UNIVERSAL. Any attempt to build a general exception model on it should
966 # be politely squashed. Any bug that causes every eval {} to have to be
967 # modified should be not so politely squashed.
969 # Those are my current opinions. It is also my optinion that polite
970 # arguments degenerate to personal arguments far too frequently, and that
971 # when they do, it's because both people wanted it to, or at least didn't
972 # sufficiently want it not to.
976 # global backstop to cleanup if we should really die
977 $SIG{__DIE__} = \&cleanup;
978 $self->debug("Signal handler set.") if $CPAN::DEBUG;
981 #-> sub CPAN::DESTROY ;
983 &cleanup; # need an eval?
986 #-> sub CPAN::anycwd ;
989 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
994 sub cwd {Cwd::cwd();}
996 #-> sub CPAN::getcwd ;
997 sub getcwd {Cwd::getcwd();}
999 #-> sub CPAN::fastcwd ;
1000 sub fastcwd {Cwd::fastcwd();}
1002 #-> sub CPAN::backtickcwd ;
1003 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
1005 #-> sub CPAN::find_perl ;
1007 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
1008 my $pwd = $CPAN::iCwd = CPAN::anycwd();
1009 my $candidate = File::Spec->catfile($pwd,$^X);
1010 $perl ||= $candidate if MM->maybe_command($candidate);
1013 my ($component,$perl_name);
1014 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
1015 PATH_COMPONENT: foreach $component (File::Spec->path(),
1016 $Config::Config{'binexp'}) {
1017 next unless defined($component) && $component;
1018 my($abs) = File::Spec->catfile($component,$perl_name);
1019 if (MM->maybe_command($abs)) {
1031 #-> sub CPAN::exists ;
1033 my($mgr,$class,$id) = @_;
1034 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
1035 CPAN::Index->reload;
1036 ### Carp::croak "exists called without class argument" unless $class;
1038 $id =~ s/:+/::/g if $class eq "CPAN::Module";
1040 if (CPAN::_sqlite_running) {
1041 $exists = (exists $META->{readonly}{$class}{$id} or
1042 $CPAN::SQLite->set($class, $id));
1044 $exists = exists $META->{readonly}{$class}{$id};
1046 $exists ||= exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
1049 #-> sub CPAN::delete ;
1051 my($mgr,$class,$id) = @_;
1052 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
1053 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
1056 #-> sub CPAN::has_usable
1057 # has_inst is sometimes too optimistic, we should replace it with this
1058 # has_usable whenever a case is given
1060 my($self,$mod,$message) = @_;
1061 return 1 if $HAS_USABLE->{$mod};
1062 my $has_inst = $self->has_inst($mod,$message);
1063 return unless $has_inst;
1066 LWP => [ # we frequently had "Can't locate object
1067 # method "new" via package "LWP::UserAgent" at
1068 # (eval 69) line 2006
1070 sub {require LWP::UserAgent},
1071 sub {require HTTP::Request},
1072 sub {require URI::URL},
1075 sub {require Net::FTP},
1076 sub {require Net::Config},
1078 'File::HomeDir' => [
1079 sub {require File::HomeDir;
1080 unless (File::HomeDir::->VERSION >= 0.52){
1081 for ("Will not use File::HomeDir, need 0.52\n") {
1082 $CPAN::Frontend->mywarn($_);
1089 sub {require Archive::Tar;
1090 unless (Archive::Tar::->VERSION >= 1.00) {
1091 for ("Will not use Archive::Tar, need 1.00\n") {
1092 $CPAN::Frontend->mywarn($_);
1099 if ($usable->{$mod}) {
1100 for my $c (0..$#{$usable->{$mod}}) {
1101 my $code = $usable->{$mod}[$c];
1102 my $ret = eval { &$code() };
1103 $ret = "" unless defined $ret;
1105 # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
1110 return $HAS_USABLE->{$mod} = 1;
1113 #-> sub CPAN::has_inst
1115 my($self,$mod,$message) = @_;
1116 Carp::croak("CPAN->has_inst() called without an argument")
1117 unless defined $mod;
1118 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
1119 keys %{$CPAN::Config->{dontload_hash}||{}},
1120 @{$CPAN::Config->{dontload_list}||[]};
1121 if (defined $message && $message eq "no" # afair only used by Nox
1125 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
1133 # checking %INC is wrong, because $INC{LWP} may be true
1134 # although $INC{"URI/URL.pm"} may have failed. But as
1135 # I really want to say "bla loaded OK", I have to somehow
1137 ### warn "$file in %INC"; #debug
1139 } elsif (eval { require $file }) {
1140 # eval is good: if we haven't yet read the database it's
1141 # perfect and if we have installed the module in the meantime,
1142 # it tries again. The second require is only a NOOP returning
1143 # 1 if we had success, otherwise it's retrying
1145 my $v = eval "\$$mod\::VERSION";
1146 $v = $v ? " (v$v)" : "";
1147 $CPAN::Frontend->myprint("CPAN: $mod loaded ok$v\n");
1148 if ($mod eq "CPAN::WAIT") {
1149 push @CPAN::Shell::ISA, 'CPAN::WAIT';
1152 } elsif ($mod eq "Net::FTP") {
1153 $CPAN::Frontend->mywarn(qq{
1154 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
1156 install Bundle::libnet
1158 }) unless $Have_warned->{"Net::FTP"}++;
1159 $CPAN::Frontend->mysleep(3);
1160 } elsif ($mod eq "Digest::SHA"){
1161 if ($Have_warned->{"Digest::SHA"}++) {
1162 $CPAN::Frontend->myprint(qq{CPAN: checksum security checks disabled }.
1163 qq{because Digest::SHA not installed.\n});
1165 $CPAN::Frontend->mywarn(qq{
1166 CPAN: checksum security checks disabled because Digest::SHA not installed.
1167 Please consider installing the Digest::SHA module.
1170 $CPAN::Frontend->mysleep(2);
1172 } elsif ($mod eq "Module::Signature"){
1173 # NOT prefs_lookup, we are not a distro
1174 my $check_sigs = $CPAN::Config->{check_sigs};
1175 if (not $check_sigs) {
1176 # they do not want us:-(
1177 } elsif (not $Have_warned->{"Module::Signature"}++) {
1178 # No point in complaining unless the user can
1179 # reasonably install and use it.
1180 if (eval { require Crypt::OpenPGP; 1 } ||
1182 defined $CPAN::Config->{'gpg'}
1184 $CPAN::Config->{'gpg'} =~ /\S/
1187 $CPAN::Frontend->mywarn(qq{
1188 CPAN: Module::Signature security checks disabled because Module::Signature
1189 not installed. Please consider installing the Module::Signature module.
1190 You may also need to be able to connect over the Internet to the public
1191 keyservers like pgp.mit.edu (port 11371).
1194 $CPAN::Frontend->mysleep(2);
1198 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
1203 #-> sub CPAN::instance ;
1205 my($mgr,$class,$id) = @_;
1206 CPAN::Index->reload;
1208 # unsafe meta access, ok?
1209 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
1210 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
1218 #-> sub CPAN::cleanup ;
1220 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
1221 local $SIG{__DIE__} = '';
1226 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
1227 $ineval = 1, last if
1228 $subroutine eq '(eval)';
1230 return if $ineval && !$CPAN::End;
1231 return unless defined $META->{LOCK};
1232 return unless -f $META->{LOCK};
1234 close $META->{LOCKFH};
1235 unlink $META->{LOCK};
1237 # Carp::cluck("DEBUGGING");
1238 if ( $CPAN::CONFIG_DIRTY ) {
1239 $CPAN::Frontend->mywarn("Warning: Configuration not saved.\n");
1241 $CPAN::Frontend->myprint("Lockfile removed.\n");
1244 #-> sub CPAN::readhist
1246 my($self,$term,$histfile) = @_;
1247 my($fh) = FileHandle->new;
1248 open $fh, "<$histfile" or last;
1252 $term->AddHistory($_);
1257 #-> sub CPAN::savehist
1260 my($histfile,$histsize);
1261 unless ($histfile = $CPAN::Config->{'histfile'}){
1262 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
1265 $histsize = $CPAN::Config->{'histsize'} || 100;
1267 unless ($CPAN::term->can("GetHistory")) {
1268 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
1274 my @h = $CPAN::term->GetHistory;
1275 splice @h, 0, @h-$histsize if @h>$histsize;
1276 my($fh) = FileHandle->new;
1277 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
1278 local $\ = local $, = "\n";
1283 #-> sub CPAN::is_tested
1285 my($self,$what,$when) = @_;
1287 Carp::cluck("DEBUG: empty what");
1290 $self->{is_tested}{$what} = $when;
1293 #-> sub CPAN::is_installed
1294 # unsets the is_tested flag: as soon as the thing is installed, it is
1295 # not needed in set_perl5lib anymore
1297 my($self,$what) = @_;
1298 delete $self->{is_tested}{$what};
1301 sub _list_sorted_descending_is_tested {
1304 { ($self->{is_tested}{$b}||0) <=> ($self->{is_tested}{$a}||0) }
1305 keys %{$self->{is_tested}}
1308 #-> sub CPAN::set_perl5lib
1310 my($self,$for) = @_;
1312 (undef,undef,undef,$for) = caller(1);
1315 $self->{is_tested} ||= {};
1316 return unless %{$self->{is_tested}};
1317 my $env = $ENV{PERL5LIB};
1318 $env = $ENV{PERLLIB} unless defined $env;
1320 push @env, $env if defined $env and length $env;
1321 #my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1322 #$CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1324 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} $self->_list_sorted_descending_is_tested;
1326 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB for '$for'\n");
1327 } elsif (@dirs < 24) {
1328 my @d = map {my $cp = $_;
1329 $cp =~ s/^\Q$CPAN::Config->{build_dir}\E/%BUILDDIR%/;
1332 $CPAN::Frontend->myprint("Prepending @d to PERL5LIB; ".
1333 "%BUILDDIR%=$CPAN::Config->{build_dir} ".
1337 my $cnt = keys %{$self->{is_tested}};
1338 $CPAN::Frontend->myprint("Prepending blib/arch and blib/lib of ".
1339 "$cnt build dirs to PERL5LIB; ".
1344 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1347 package CPAN::CacheMgr;
1350 #-> sub CPAN::CacheMgr::as_string ;
1352 eval { require Data::Dumper };
1354 return shift->SUPER::as_string;
1356 return Data::Dumper::Dumper(shift);
1360 #-> sub CPAN::CacheMgr::cachesize ;
1365 #-> sub CPAN::CacheMgr::tidyup ;
1368 return unless $CPAN::META->{LOCK};
1369 return unless -d $self->{ID};
1370 while ($self->{DU} > $self->{'MAX'} ) {
1371 my($toremove) = shift @{$self->{FIFO}};
1372 unless ($toremove =~ /\.yml$/) {
1373 $CPAN::Frontend->myprint(sprintf(
1374 "DEL(%.1f>%.1fMB): %s \n",
1381 return if $CPAN::Signal;
1382 $self->_clean_cache($toremove);
1383 return if $CPAN::Signal;
1387 #-> sub CPAN::CacheMgr::dir ;
1392 #-> sub CPAN::CacheMgr::entries ;
1394 my($self,$dir) = @_;
1395 return unless defined $dir;
1396 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1397 $dir ||= $self->{ID};
1398 my($cwd) = CPAN::anycwd();
1399 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1400 my $dh = DirHandle->new(File::Spec->curdir)
1401 or Carp::croak("Couldn't opendir $dir: $!");
1404 next if $_ eq "." || $_ eq "..";
1406 push @entries, File::Spec->catfile($dir,$_);
1408 push @entries, File::Spec->catdir($dir,$_);
1410 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1413 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1414 sort { -M $b <=> -M $a} @entries;
1417 #-> sub CPAN::CacheMgr::disk_usage ;
1419 my($self,$dir) = @_;
1420 return if exists $self->{SIZE}{$dir};
1421 return if $CPAN::Signal;
1425 unless (chmod 0755, $dir) {
1426 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1427 "permission to change the permission; cannot ".
1428 "estimate disk usage of '$dir'\n");
1429 $CPAN::Frontend->mysleep(5);
1434 $CPAN::Frontend->mywarn("Directory '$dir' has gone. Cannot continue.\n");
1439 $File::Find::prune++ if $CPAN::Signal;
1441 if ($^O eq 'MacOS') {
1443 my $cat = Mac::Files::FSpGetCatInfo($_);
1444 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1448 unless (chmod 0755, $_) {
1449 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1450 "the permission to change the permission; ".
1451 "can only partially estimate disk usage ".
1453 $CPAN::Frontend->mysleep(5);
1464 return if $CPAN::Signal;
1465 $self->{SIZE}{$dir} = $Du/1024/1024;
1466 push @{$self->{FIFO}}, $dir;
1467 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1468 $self->{DU} += $Du/1024/1024;
1472 #-> sub CPAN::CacheMgr::_clean_cache ;
1474 my($self,$dir) = @_;
1475 return unless -e $dir;
1476 unless (File::Spec->canonpath(File::Basename::dirname($dir))
1477 eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
1478 $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
1479 "will not remove\n");
1480 $CPAN::Frontend->mysleep(5);
1483 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1485 File::Path::rmtree($dir);
1487 if ($dir !~ /\.yml$/ && -f "$dir.yml") {
1488 my $yaml_module = CPAN::_yaml_module;
1489 if ($CPAN::META->has_inst($yaml_module)) {
1490 my($peek_yaml) = CPAN->_yaml_loadfile("$dir.yml");
1491 if (my $id = $peek_yaml->[0]{distribution}{ID}) {
1492 $CPAN::META->delete("CPAN::Distribution", $id);
1493 # $CPAN::Frontend->mywarn (" +++\n");
1497 unlink "$dir.yml"; # may fail
1498 unless ($id_deleted) {
1499 CPAN->debug("no distro found associated with '$dir'");
1502 $self->{DU} -= $self->{SIZE}{$dir};
1503 delete $self->{SIZE}{$dir};
1506 #-> sub CPAN::CacheMgr::new ;
1513 ID => $CPAN::Config->{build_dir},
1514 MAX => $CPAN::Config->{'build_cache'},
1515 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1518 File::Path::mkpath($self->{ID});
1519 my $dh = DirHandle->new($self->{ID});
1520 bless $self, $class;
1523 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1525 CPAN->debug($debug) if $CPAN::DEBUG;
1529 #-> sub CPAN::CacheMgr::scan_cache ;
1532 return if $self->{SCAN} eq 'never';
1533 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1534 unless $self->{SCAN} eq 'atstart';
1535 return unless $CPAN::META->{LOCK};
1536 $CPAN::Frontend->myprint(
1537 sprintf("Scanning cache %s for sizes\n",
1540 my @entries = grep { !/^\.\.?$/ } $self->entries($self->{ID});
1544 # next if $e eq ".." || $e eq ".";
1545 $self->disk_usage($e);
1547 while (($painted/76) < ($i/@entries)) {
1548 $CPAN::Frontend->myprint(".");
1551 return if $CPAN::Signal;
1553 $CPAN::Frontend->myprint("DONE\n");
1557 package CPAN::Shell;
1560 #-> sub CPAN::Shell::h ;
1562 my($class,$about) = @_;
1563 if (defined $about) {
1564 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1566 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1567 $CPAN::Frontend->myprint(qq{
1568 Display Information $filler (ver $CPAN::VERSION)
1569 command argument description
1570 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1571 i WORD or /REGEXP/ about any of the above
1572 ls AUTHOR or GLOB about files in the author's directory
1573 (with WORD being a module, bundle or author name or a distribution
1574 name of the form AUTHOR/DISTRIBUTION)
1576 Download, Test, Make, Install...
1577 get download clean make clean
1578 make make (implies get) look open subshell in dist directory
1579 test make test (implies make) readme display these README files
1580 install make install (implies test) perldoc display POD documentation
1583 r WORDs or /REGEXP/ or NONE report updates for some/matching/all modules
1584 upgrade WORDs or /REGEXP/ or NONE upgrade some/matching/all modules
1587 force CMD try hard to do command fforce CMD try harder
1588 notest CMD skip testing
1591 h,? display this menu ! perl-code eval a perl command
1592 o conf [opt] set and query options q quit the cpan shell
1593 reload cpan load CPAN.pm again reload index load newer indices
1594 autobundle Snapshot recent latest CPAN uploads});
1600 #-> sub CPAN::Shell::a ;
1602 my($self,@arg) = @_;
1603 # authors are always UPPERCASE
1605 $_ = uc $_ unless /=/;
1607 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1610 #-> sub CPAN::Shell::globls ;
1612 my($self,$s,$pragmas) = @_;
1613 # ls is really very different, but we had it once as an ordinary
1614 # command in the Shell (upto rev. 321) and we could not handle
1616 my(@accept,@preexpand);
1617 if ($s =~ /[\*\?\/]/) {
1618 if ($CPAN::META->has_inst("Text::Glob")) {
1619 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1620 my $rau = Text::Glob::glob_to_regex(uc $au);
1621 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1623 push @preexpand, map { $_->id . "/" . $pathglob }
1624 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1626 my $rau = Text::Glob::glob_to_regex(uc $s);
1627 push @preexpand, map { $_->id }
1628 CPAN::Shell->expand_by_method('CPAN::Author',
1633 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1636 push @preexpand, uc $s;
1639 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1640 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1645 my $silent = @accept>1;
1646 my $last_alpha = "";
1648 for my $a (@accept){
1649 my($author,$pathglob);
1650 if ($a =~ m|(.*?)/(.*)|) {
1653 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1656 or $CPAN::Frontend->mydie("No author found for $a2\n");
1658 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1661 or $CPAN::Frontend->mydie("No author found for $a\n");
1664 my $alpha = substr $author->id, 0, 1;
1666 if ($alpha eq $last_alpha) {
1670 $last_alpha = $alpha;
1672 $CPAN::Frontend->myprint($ad);
1674 for my $pragma (@$pragmas) {
1675 if ($author->can($pragma)) {
1679 push @results, $author->ls($pathglob,$silent); # silent if
1682 for my $pragma (@$pragmas) {
1683 my $unpragma = "un$pragma";
1684 if ($author->can($unpragma)) {
1685 $author->$unpragma();
1692 #-> sub CPAN::Shell::local_bundles ;
1694 my($self,@which) = @_;
1695 my($incdir,$bdir,$dh);
1696 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1697 my @bbase = "Bundle";
1698 while (my $bbase = shift @bbase) {
1699 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1700 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1701 if ($dh = DirHandle->new($bdir)) { # may fail
1703 for $entry ($dh->read) {
1704 next if $entry =~ /^\./;
1705 next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
1706 if (-d File::Spec->catdir($bdir,$entry)){
1707 push @bbase, "$bbase\::$entry";
1709 next unless $entry =~ s/\.pm(?!\n)\Z//;
1710 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1718 #-> sub CPAN::Shell::b ;
1720 my($self,@which) = @_;
1721 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1722 $self->local_bundles;
1723 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1726 #-> sub CPAN::Shell::d ;
1727 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1729 #-> sub CPAN::Shell::m ;
1730 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1732 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1735 #-> sub CPAN::Shell::i ;
1739 @args = '/./' unless @args;
1741 for my $type (qw/Bundle Distribution Module/) {
1742 push @result, $self->expand($type,@args);
1744 # Authors are always uppercase.
1745 push @result, $self->expand("Author", map { uc $_ } @args);
1747 my $result = @result == 1 ?
1748 $result[0]->as_string :
1750 "No objects found of any type for argument @args\n" :
1752 (map {$_->as_glimpse} @result),
1753 scalar @result, " items found\n",
1755 $CPAN::Frontend->myprint($result);
1758 #-> sub CPAN::Shell::o ;
1760 # CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o
1761 # conf' calls through to CPAN::HandleConfig::edit. 'o conf' should
1762 # probably have been called 'set' and 'o debug' maybe 'set debug' or
1763 # 'debug'; 'o conf ARGS' calls ->edit in CPAN/HandleConfig.pm
1765 my($self,$o_type,@o_what) = @_;
1767 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1768 if ($o_type eq 'conf') {
1769 if (!@o_what) { # print all things, "o conf"
1771 $CPAN::Frontend->myprint("\$CPAN::Config options from ");
1773 if (exists $INC{'CPAN/Config.pm'}) {
1774 push @from, $INC{'CPAN/Config.pm'};
1776 if (exists $INC{'CPAN/MyConfig.pm'}) {
1777 push @from, $INC{'CPAN/MyConfig.pm'};
1779 $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
1780 $CPAN::Frontend->myprint(":\n");
1781 for $k (sort keys %CPAN::HandleConfig::can) {
1782 $v = $CPAN::HandleConfig::can{$k};
1783 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
1785 $CPAN::Frontend->myprint("\n");
1786 for $k (sort keys %$CPAN::Config) {
1787 CPAN::HandleConfig->prettyprint($k);
1789 $CPAN::Frontend->myprint("\n");
1791 if (CPAN::HandleConfig->edit(@o_what)) {
1793 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
1797 } elsif ($o_type eq 'debug') {
1799 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1802 my($what) = shift @o_what;
1803 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1804 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1807 if ( exists $CPAN::DEBUG{$what} ) {
1808 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1809 } elsif ($what =~ /^\d/) {
1810 $CPAN::DEBUG = $what;
1811 } elsif (lc $what eq 'all') {
1813 for (values %CPAN::DEBUG) {
1816 $CPAN::DEBUG = $max;
1819 for (keys %CPAN::DEBUG) {
1820 next unless lc($_) eq lc($what);
1821 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1824 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1829 my $raw = "Valid options for debug are ".
1830 join(", ",sort(keys %CPAN::DEBUG), 'all').
1831 qq{ or a number. Completion works on the options. }.
1832 qq{Case is ignored.};
1834 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1835 $CPAN::Frontend->myprint("\n\n");
1838 $CPAN::Frontend->myprint("Options set for debugging ($CPAN::DEBUG):\n");
1840 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1841 $v = $CPAN::DEBUG{$k};
1842 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1843 if $v & $CPAN::DEBUG;
1846 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1849 $CPAN::Frontend->myprint(qq{
1851 conf set or get configuration variables
1852 debug set or get debugging options
1857 # CPAN::Shell::paintdots_onreload
1858 sub paintdots_onreload {
1861 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
1865 # $CPAN::Frontend->myprint(".($subr)");
1866 $CPAN::Frontend->myprint(".");
1867 if ($subr =~ /\bshell\b/i) {
1868 # warn "debug[$_[0]]";
1870 # It would be nice if we could detect that a
1871 # subroutine has actually changed, but for now we
1872 # practically always set the GOTOSHELL global
1882 #-> sub CPAN::Shell::hosts ;
1885 my $fullstats = CPAN::FTP->_ftp_statistics();
1886 my $history = $fullstats->{history} || [];
1888 while (my $last = pop @$history) {
1889 my $attempts = $last->{attempts} or next;
1892 $start = $attempts->[-1]{start};
1893 if ($#$attempts > 0) {
1894 for my $i (0..$#$attempts-1) {
1895 my $url = $attempts->[$i]{url} or next;
1900 $start = $last->{start};
1902 next unless $last->{thesiteurl}; # C-C? bad filenames?
1904 $S{end} ||= $last->{end};
1905 my $dltime = $last->{end} - $start;
1906 my $dlsize = $last->{filesize} || 0;
1907 my $url = ref $last->{thesiteurl} ? $last->{thesiteurl}->text : $last->{thesiteurl};
1908 my $s = $S{ok}{$url} ||= {};
1911 $s->{dlsize} += $dlsize/1024;
1913 $s->{dltime} += $dltime;
1916 for my $url (keys %{$S{ok}}) {
1917 next if $S{ok}{$url}{dltime} == 0; # div by zero
1918 push @{$res->{ok}}, [@{$S{ok}{$url}}{qw(n dlsize dltime)},
1919 $S{ok}{$url}{dlsize}/$S{ok}{$url}{dltime},
1923 for my $url (keys %{$S{no}}) {
1924 push @{$res->{no}}, [$S{no}{$url},
1928 my $R = ""; # report
1929 if ($S{start} && $S{end}) {
1930 $R .= sprintf "Log starts: %s\n", $S{start} ? scalar(localtime $S{start}) : "unknown";
1931 $R .= sprintf "Log ends : %s\n", $S{end} ? scalar(localtime $S{end}) : "unknown";
1933 if ($res->{ok} && @{$res->{ok}}) {
1934 $R .= sprintf "\nSuccessful downloads:
1935 N kB secs kB/s url\n";
1937 for (sort { $b->[3] <=> $a->[3] } @{$res->{ok}}) {
1938 $R .= sprintf "%4d %8d %5d %9.1f %s\n", @$_;
1942 if ($res->{no} && @{$res->{no}}) {
1943 $R .= sprintf "\nUnsuccessful downloads:\n";
1945 for (sort { $b->[0] <=> $a->[0] } @{$res->{no}}) {
1946 $R .= sprintf "%4d %s\n", @$_;
1950 $CPAN::Frontend->myprint($R);
1953 #-> sub CPAN::Shell::reload ;
1955 my($self,$command,@arg) = @_;
1957 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1958 if ($command =~ /^cpan$/i) {
1960 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
1965 "CPAN/FirstTime.pm",
1966 "CPAN/HandleConfig.pm",
1974 MFILE: for my $f (@relo) {
1975 next unless exists $INC{$f};
1979 $CPAN::Frontend->myprint("($p");
1980 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
1981 $self->_reload_this($f) or $failed++;
1982 my $v = eval "$p\::->VERSION";
1983 $CPAN::Frontend->myprint("v$v)");
1985 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1987 my $errors = $failed == 1 ? "error" : "errors";
1988 $CPAN::Frontend->mywarn("\n$failed $errors during reload. You better quit ".
1991 } elsif ($command =~ /^index$/i) {
1992 CPAN::Index->force_reload;
1994 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN modules
1995 index re-reads the index files\n});
1999 # reload means only load again what we have loaded before
2000 #-> sub CPAN::Shell::_reload_this ;
2002 my($self,$f,$args) = @_;
2003 CPAN->debug("f[$f]") if $CPAN::DEBUG;
2004 return 1 unless $INC{$f}; # we never loaded this, so we do not
2006 my $pwd = CPAN::anycwd();
2007 CPAN->debug("pwd[$pwd]") if $CPAN::DEBUG;
2009 for my $inc (@INC) {
2010 $file = File::Spec->catfile($inc,split /\//, $f);
2014 CPAN->debug("file[$file]") if $CPAN::DEBUG;
2016 unless ($file && -f $file) {
2017 # this thingie is not in the INC path, maybe CPAN/MyConfig.pm?
2019 unless (CPAN->has_inst("File::Basename")) {
2020 @inc = File::Basename::dirname($file);
2022 # do we ever need this?
2023 @inc = substr($file,0,-length($f)-1); # bring in back to me!
2026 CPAN->debug("file[$file]inc[@inc]") if $CPAN::DEBUG;
2028 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
2031 my $mtime = (stat $file)[9];
2032 $reload->{$f} ||= $^T;
2033 my $must_reload = $mtime > $reload->{$f};
2035 $must_reload ||= $args->{reloforce};
2037 my $fh = FileHandle->new($file) or
2038 $CPAN::Frontend->mydie("Could not open $file: $!");
2041 my $content = <$fh>;
2042 CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128)))
2046 eval "require '$f'";
2051 $reload->{$f} = time;
2053 $CPAN::Frontend->myprint("__unchanged__");
2058 #-> sub CPAN::Shell::mkmyconfig ;
2060 my($self, $cpanpm, %args) = @_;
2061 require CPAN::FirstTime;
2062 my $home = CPAN::HandleConfig::home;
2063 $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
2064 File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
2065 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
2066 CPAN::HandleConfig::require_myconfig_or_config;
2067 $CPAN::Config ||= {};
2072 keep_source_where => undef,
2075 CPAN::FirstTime::init($cpanpm, %args);
2078 #-> sub CPAN::Shell::_binary_extensions ;
2079 sub _binary_extensions {
2080 my($self) = shift @_;
2081 my(@result,$module,%seen,%need,$headerdone);
2082 for $module ($self->expand('Module','/./')) {
2083 my $file = $module->cpan_file;
2084 next if $file eq "N/A";
2085 next if $file =~ /^Contact Author/;
2086 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
2087 next if $dist->isa_perl;
2088 next unless $module->xs_file;
2090 $CPAN::Frontend->myprint(".");
2091 push @result, $module;
2093 # print join " | ", @result;
2094 $CPAN::Frontend->myprint("\n");
2098 #-> sub CPAN::Shell::recompile ;
2100 my($self) = shift @_;
2101 my($module,@module,$cpan_file,%dist);
2102 @module = $self->_binary_extensions();
2103 for $module (@module){ # we force now and compile later, so we
2105 $cpan_file = $module->cpan_file;
2106 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
2108 $dist{$cpan_file}++;
2110 for $cpan_file (sort keys %dist) {
2111 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
2112 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
2114 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
2115 # stop a package from recompiling,
2116 # e.g. IO-1.12 when we have perl5.003_10
2120 #-> sub CPAN::Shell::scripts ;
2122 my($self, $arg) = @_;
2123 $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n");
2125 for my $req (qw( HTML::LinkExtor Sort::Versions List::Util )) {
2126 unless ($CPAN::META->has_inst($req)) {
2127 $CPAN::Frontend->mywarn(" $req not available\n");
2130 my $p = HTML::LinkExtor->new();
2131 my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html";
2132 unless (-f $indexfile) {
2133 $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n");
2135 $p->parse_file($indexfile);
2138 if ($arg =~ s|^/(.+)/$|$1|) {
2139 $qrarg = eval 'qr/$arg/'; # hide construct from 5.004
2141 for my $l ($p->links) {
2142 my $tag = shift @$l;
2143 next unless $tag eq "a";
2145 my $href = $att{href};
2146 next unless $href =~ s|^\.\./authors/id/./../||;
2149 if ($href =~ $qrarg) {
2153 if ($href =~ /\Q$arg\E/) {
2161 # now filter for the latest version if there is more than one of a name
2167 $stems{$stem} ||= [];
2168 push @{$stems{$stem}}, $href;
2170 for (sort keys %stems) {
2172 if (@{$stems{$_}} > 1) {
2173 $highest = List::Util::reduce {
2174 Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b
2177 $highest = $stems{$_}[0];
2179 $CPAN::Frontend->myprint("$highest\n");
2183 #-> sub CPAN::Shell::report ;
2185 my($self,@args) = @_;
2186 unless ($CPAN::META->has_inst("CPAN::Reporter")) {
2187 $CPAN::Frontend->mydie("CPAN::Reporter not installed; cannot continue");
2189 local $CPAN::Config->{test_report} = 1;
2190 $self->force("test",@args); # force is there so that the test be
2191 # re-run (as documented)
2194 # compare with is_tested
2195 #-> sub CPAN::Shell::install_tested
2196 sub install_tested {
2197 my($self,@some) = @_;
2198 $CPAN::Frontend->mywarn("install_tested() must not be called with arguments.\n"),
2200 CPAN::Index->reload;
2202 for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) {
2203 my $yaml = "$b.yml";
2205 $CPAN::Frontend->mywarn("No YAML file for $b available, skipping\n");
2208 my $yaml_content = CPAN->_yaml_loadfile($yaml);
2209 my $id = $yaml_content->[0]{distribution}{ID};
2211 $CPAN::Frontend->mywarn("No ID found in '$yaml', skipping\n");
2214 my $do = CPAN::Shell->expandany($id);
2216 $CPAN::Frontend->mywarn("Could not expand ID '$id', skipping\n");
2219 unless ($do->{build_dir}) {
2220 $CPAN::Frontend->mywarn("Distro '$id' has no build_dir, skipping\n");
2223 unless ($do->{build_dir} eq $b) {
2224 $CPAN::Frontend->mywarn("Distro '$id' has build_dir '$do->{build_dir}' but expected '$b', skipping\n");
2230 $CPAN::Frontend->mywarn("No tested distributions found.\n"),
2231 return unless @some;
2233 @some = grep { $_->{make_test} && ! $_->{make_test}->failed } @some;
2234 $CPAN::Frontend->mywarn("No distributions tested with this build of perl found.\n"),
2235 return unless @some;
2237 # @some = grep { not $_->uptodate } @some;
2238 # $CPAN::Frontend->mywarn("No non-uptodate distributions tested with this build of perl found.\n"),
2239 # return unless @some;
2241 CPAN->debug("some[@some]");
2243 my $id = $d->can("pretty_id") ? $d->pretty_id : $d->id;
2244 $CPAN::Frontend->myprint("install_tested: Running for $id\n");
2245 $CPAN::Frontend->mysleep(1);
2250 #-> sub CPAN::Shell::upgrade ;
2252 my($self,@args) = @_;
2253 $self->install($self->r(@args));
2256 #-> sub CPAN::Shell::_u_r_common ;
2258 my($self) = shift @_;
2259 my($what) = shift @_;
2260 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
2261 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
2262 $what && $what =~ /^[aru]$/;
2264 @args = '/./' unless @args;
2265 my(@result,$module,%seen,%need,$headerdone,
2266 $version_undefs,$version_zeroes);
2267 $version_undefs = $version_zeroes = 0;
2268 my $sprintf = "%s%-25s%s %9s %9s %s\n";
2269 my @expand = $self->expand('Module',@args);
2270 my $expand = scalar @expand;
2271 if (0) { # Looks like noise to me, was very useful for debugging
2272 # for metadata cache
2273 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
2275 MODULE: for $module (@expand) {
2276 my $file = $module->cpan_file;
2277 next MODULE unless defined $file; # ??
2278 $file =~ s|^./../||;
2279 my($latest) = $module->cpan_version;
2280 my($inst_file) = $module->inst_file;
2282 return if $CPAN::Signal;
2285 $have = $module->inst_version;
2286 } elsif ($what eq "r") {
2287 $have = $module->inst_version;
2289 if ($have eq "undef"){
2291 } elsif ($have == 0){
2294 next MODULE unless CPAN::Version->vgt($latest, $have);
2295 # to be pedantic we should probably say:
2296 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
2297 # to catch the case where CPAN has a version 0 and we have a version undef
2298 } elsif ($what eq "u") {
2304 } elsif ($what eq "r") {
2306 } elsif ($what eq "u") {
2310 return if $CPAN::Signal; # this is sometimes lengthy
2313 push @result, sprintf "%s %s\n", $module->id, $have;
2314 } elsif ($what eq "r") {
2315 push @result, $module->id;
2316 next MODULE if $seen{$file}++;
2317 } elsif ($what eq "u") {
2318 push @result, $module->id;
2319 next MODULE if $seen{$file}++;
2320 next MODULE if $file =~ /^Contact/;
2322 unless ($headerdone++){
2323 $CPAN::Frontend->myprint("\n");
2324 $CPAN::Frontend->myprint(sprintf(
2327 "Package namespace",
2339 $CPAN::META->has_inst("Term::ANSIColor")
2341 $module->description
2343 $color_on = Term::ANSIColor::color("green");
2344 $color_off = Term::ANSIColor::color("reset");
2346 $CPAN::Frontend->myprint(sprintf $sprintf,
2353 $need{$module->id}++;
2357 $CPAN::Frontend->myprint("No modules found for @args\n");
2358 } elsif ($what eq "r") {
2359 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
2363 if ($version_zeroes) {
2364 my $s_has = $version_zeroes > 1 ? "s have" : " has";
2365 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
2366 qq{a version number of 0\n});
2368 if ($version_undefs) {
2369 my $s_has = $version_undefs > 1 ? "s have" : " has";
2370 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
2371 qq{parseable version number\n});
2377 #-> sub CPAN::Shell::r ;
2379 shift->_u_r_common("r",@_);
2382 #-> sub CPAN::Shell::u ;
2384 shift->_u_r_common("u",@_);
2387 #-> sub CPAN::Shell::failed ;
2389 my($self,$only_id,$silent) = @_;
2391 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
2393 NAY: for my $nosayer ( # order matters!
2402 next unless exists $d->{$nosayer};
2403 next unless defined $d->{$nosayer};
2405 UNIVERSAL::can($d->{$nosayer},"failed") ?
2406 $d->{$nosayer}->failed :
2407 $d->{$nosayer} =~ /^NO/
2409 next NAY if $only_id && $only_id != (
2410 UNIVERSAL::can($d->{$nosayer},"commandid")
2412 $d->{$nosayer}->commandid
2414 $CPAN::CurrentCommandId
2419 next DIST unless $failed;
2423 # " %-45s: %s %s\n",
2426 UNIVERSAL::can($d->{$failed},"failed") ?
2428 $d->{$failed}->commandid,
2431 $d->{$failed}->text,
2432 $d->{$failed}{TIME}||0,
2445 $scope = "this command";
2446 } elsif ($CPAN::Index::HAVE_REANIMATED) {
2447 $scope = "this or a previous session";
2448 # it might be nice to have a section for previous session and
2451 $scope = "this session";
2458 map { sprintf "%5d %-45s: %s %s\n", @$_ }
2459 sort { $a->[0] <=> $b->[0] } @failed;
2462 map { sprintf " %-45s: %s %s\n", @$_[1..3] }
2469 $CPAN::Frontend->myprint("Failed during $scope:\n$print");
2470 } elsif (!$only_id || !$silent) {
2471 $CPAN::Frontend->myprint("Nothing failed in $scope\n");
2475 # XXX intentionally undocumented because completely bogus, unportable,
2478 #-> sub CPAN::Shell::status ;
2481 require Devel::Size;
2482 my $ps = FileHandle->new;
2483 open $ps, "/proc/$$/status";
2486 next unless /VmSize:\s+(\d+)/;
2490 $CPAN::Frontend->mywarn(sprintf(
2491 "%-27s %6d\n%-27s %6d\n",
2495 Devel::Size::total_size($CPAN::META)/1024,
2497 for my $k (sort keys %$CPAN::META) {
2498 next unless substr($k,0,4) eq "read";
2499 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
2500 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
2501 warn sprintf " %-25s %6d (keys: %6d)\n",
2503 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
2504 scalar keys %{$CPAN::META->{$k}{$k2}};
2509 # compare with install_tested
2510 #-> sub CPAN::Shell::is_tested
2513 CPAN::Index->reload;
2514 for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) {
2516 if ($CPAN::META->{is_tested}{$b}) {
2517 $time = scalar(localtime $CPAN::META->{is_tested}{$b});
2519 $time = scalar localtime;
2522 $CPAN::Frontend->myprint(sprintf "%s %s\n", $time, $b);
2526 #-> sub CPAN::Shell::autobundle ;
2529 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
2530 my(@bundle) = $self->_u_r_common("a",@_);
2531 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2532 File::Path::mkpath($todir);
2533 unless (-d $todir) {
2534 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
2537 my($y,$m,$d) = (localtime)[5,4,3];
2541 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
2542 my($to) = File::Spec->catfile($todir,"$me.pm");
2544 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
2545 $to = File::Spec->catfile($todir,"$me.pm");
2547 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
2549 "package Bundle::$me;\n\n",
2550 "\$VERSION = '0.01';\n\n",
2554 "Bundle::$me - Snapshot of installation on ",
2555 $Config::Config{'myhostname'},
2558 "\n\n=head1 SYNOPSIS\n\n",
2559 "perl -MCPAN -e 'install Bundle::$me'\n\n",
2560 "=head1 CONTENTS\n\n",
2561 join("\n", @bundle),
2562 "\n\n=head1 CONFIGURATION\n\n",
2564 "\n\n=head1 AUTHOR\n\n",
2565 "This Bundle has been generated automatically ",
2566 "by the autobundle routine in CPAN.pm.\n",
2569 $CPAN::Frontend->myprint("\nWrote bundle file
2573 #-> sub CPAN::Shell::expandany ;
2576 CPAN->debug("s[$s]") if $CPAN::DEBUG;
2577 if ($s =~ m|/| or substr($s,-1,1) eq ".") { # looks like a file or a directory
2578 $s = CPAN::Distribution->normalize($s);
2579 return $CPAN::META->instance('CPAN::Distribution',$s);
2580 # Distributions spring into existence, not expand
2581 } elsif ($s =~ m|^Bundle::|) {
2582 $self->local_bundles; # scanning so late for bundles seems
2583 # both attractive and crumpy: always
2584 # current state but easy to forget
2586 return $self->expand('Bundle',$s);
2588 return $self->expand('Module',$s)
2589 if $CPAN::META->exists('CPAN::Module',$s);
2594 #-> sub CPAN::Shell::expand ;
2597 my($type,@args) = @_;
2598 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
2599 my $class = "CPAN::$type";
2600 my $methods = ['id'];
2601 for my $meth (qw(name)) {
2602 next unless $class->can($meth);
2603 push @$methods, $meth;
2605 $self->expand_by_method($class,$methods,@args);
2608 #-> sub CPAN::Shell::expand_by_method ;
2609 sub expand_by_method {
2611 my($class,$methods,@args) = @_;
2614 my($regex,$command);
2615 if ($arg =~ m|^/(.*)/$|) {
2617 } elsif ($arg =~ m/=/) {
2621 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
2623 defined $regex ? $regex : "UNDEFINED",
2624 defined $command ? $command : "UNDEFINED",
2626 if (defined $regex) {
2627 if (CPAN::_sqlite_running) {
2628 $CPAN::SQLite->search($class, $regex);
2631 $CPAN::META->all_objects($class)
2633 unless ($obj && UNIVERSAL::can($obj,"id") && $obj->id){
2634 # BUG, we got an empty object somewhere
2635 require Data::Dumper;
2636 CPAN->debug(sprintf(
2637 "Bug in CPAN: Empty id on obj[%s][%s]",
2639 Data::Dumper::Dumper($obj)
2643 for my $method (@$methods) {
2644 my $match = eval {$obj->$method() =~ /$regex/i};
2646 my($err) = $@ =~ /^(.+) at .+? line \d+\.$/;
2647 $err ||= $@; # if we were too restrictive above
2648 $CPAN::Frontend->mydie("$err\n");
2655 } elsif ($command) {
2656 die "equal sign in command disabled (immature interface), ".
2658 ! \$CPAN::Shell::ADVANCED_QUERY=1
2659 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
2660 that may go away anytime.\n"
2661 unless $ADVANCED_QUERY;
2662 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
2663 my($matchcrit) = $criterion =~ m/^~(.+)/;
2667 $CPAN::META->all_objects($class)
2669 my $lhs = $self->$method() or next; # () for 5.00503
2671 push @m, $self if $lhs =~ m/$matchcrit/;
2673 push @m, $self if $lhs eq $criterion;
2678 if ( $class eq 'CPAN::Bundle' ) {
2679 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
2680 } elsif ($class eq "CPAN::Distribution") {
2681 $xarg = CPAN::Distribution->normalize($arg);
2685 if ($CPAN::META->exists($class,$xarg)) {
2686 $obj = $CPAN::META->instance($class,$xarg);
2687 } elsif ($CPAN::META->exists($class,$arg)) {
2688 $obj = $CPAN::META->instance($class,$arg);
2695 @m = sort {$a->id cmp $b->id} @m;
2696 if ( $CPAN::DEBUG ) {
2697 my $wantarray = wantarray;
2698 my $join_m = join ",", map {$_->id} @m;
2699 $self->debug("wantarray[$wantarray]join_m[$join_m]");
2701 return wantarray ? @m : $m[0];
2704 #-> sub CPAN::Shell::format_result ;
2707 my($type,@args) = @_;
2708 @args = '/./' unless @args;
2709 my(@result) = $self->expand($type,@args);
2710 my $result = @result == 1 ?
2711 $result[0]->as_string :
2713 "No objects of type $type found for argument @args\n" :
2715 (map {$_->as_glimpse} @result),
2716 scalar @result, " items found\n",
2721 #-> sub CPAN::Shell::report_fh ;
2723 my $installation_report_fh;
2724 my $previously_noticed = 0;
2727 return $installation_report_fh if $installation_report_fh;
2728 if ($CPAN::META->has_inst("File::Temp")) {
2729 $installation_report_fh
2731 template => 'cpan_install_XXXX',
2736 unless ( $installation_report_fh ) {
2737 warn("Couldn't open installation report file; " .
2738 "no report file will be generated."
2739 ) unless $previously_noticed++;
2745 # The only reason for this method is currently to have a reliable
2746 # debugging utility that reveals which output is going through which
2747 # channel. No, I don't like the colors ;-)
2749 # to turn colordebugging on, write
2750 # cpan> o conf colorize_output 1
2752 #-> sub CPAN::Shell::print_ornamented ;
2754 my $print_ornamented_have_warned = 0;
2755 sub colorize_output {
2756 my $colorize_output = $CPAN::Config->{colorize_output};
2757 if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) {
2758 unless ($print_ornamented_have_warned++) {
2759 # no myprint/mywarn within myprint/mywarn!
2760 warn "Colorize_output is set to true but Term::ANSIColor is not
2761 installed. To activate colorized output, please install Term::ANSIColor.\n\n";
2763 $colorize_output = 0;
2765 return $colorize_output;
2770 #-> sub CPAN::Shell::print_ornamented ;
2771 sub print_ornamented {
2772 my($self,$what,$ornament) = @_;
2773 return unless defined $what;
2775 local $| = 1; # Flush immediately
2776 if ( $CPAN::Be_Silent ) {
2777 print {report_fh()} $what;
2780 my $swhat = "$what"; # stringify if it is an object
2781 if ($CPAN::Config->{term_is_latin}){
2784 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
2786 if ($self->colorize_output) {
2787 if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) {
2788 # if you want to have this configurable, please file a bugreport
2789 $ornament = $CPAN::Config->{colorize_debug} || "black on_cyan";
2791 my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
2793 print "Term::ANSIColor rejects color[$ornament]: $@\n
2794 Please choose a different color (Hint: try 'o conf init /color/')\n";
2798 Term::ANSIColor::color("reset");
2804 #-> sub CPAN::Shell::myprint ;
2806 # where is myprint/mywarn/Frontend/etc. documented? We need guidelines
2807 # where to use what! I think, we send everything to STDOUT and use
2808 # print for normal/good news and warn for news that need more
2809 # attention. Yes, this is our working contract for now.
2811 my($self,$what) = @_;
2813 $self->print_ornamented($what, $CPAN::Config->{colorize_print}||'bold blue on_white');
2816 #-> sub CPAN::Shell::myexit ;
2818 my($self,$what) = @_;
2819 $self->myprint($what);
2823 #-> sub CPAN::Shell::mywarn ;
2825 my($self,$what) = @_;
2826 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2829 # only to be used for shell commands
2830 #-> sub CPAN::Shell::mydie ;
2832 my($self,$what) = @_;
2833 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2835 # If it is the shell, we want that the following die to be silent,
2836 # but if it is not the shell, we would need a 'die $what'. We need
2837 # to take care that only shell commands use mydie. Is this
2843 # sub CPAN::Shell::colorable_makemaker_prompt ;
2844 sub colorable_makemaker_prompt {
2846 if (CPAN::Shell->colorize_output) {
2847 my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white';
2848 my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
2851 my $ans = ExtUtils::MakeMaker::prompt($foo,$bar);
2852 if (CPAN::Shell->colorize_output) {
2853 print Term::ANSIColor::color('reset');
2858 # use this only for unrecoverable errors!
2859 #-> sub CPAN::Shell::unrecoverable_error ;
2860 sub unrecoverable_error {
2861 my($self,$what) = @_;
2862 my @lines = split /\n/, $what;
2864 for my $l (@lines) {
2865 $longest = length $l if length $l > $longest;
2867 $longest = 62 if $longest > 62;
2868 for my $l (@lines) {
2874 if (length $l < 66) {
2875 $l = pack "A66 A*", $l, "<==";
2879 unshift @lines, "\n";
2880 $self->mydie(join "", @lines);
2883 #-> sub CPAN::Shell::mysleep ;
2885 my($self, $sleep) = @_;
2886 use Time::HiRes qw(sleep);
2890 #-> sub CPAN::Shell::setup_output ;
2892 return if -t STDOUT;
2893 my $odef = select STDERR;
2900 #-> sub CPAN::Shell::rematein ;
2901 # RE-adme||MA-ke||TE-st||IN-stall : nearly everything runs through here
2904 my($meth,@some) = @_;
2906 while($meth =~ /^(ff?orce|notest)$/) {
2907 push @pragma, $meth;
2908 $meth = shift @some or
2909 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
2913 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
2915 # Here is the place to set "test_count" on all involved parties to
2916 # 0. We then can pass this counter on to the involved
2917 # distributions and those can refuse to test if test_count > X. In
2918 # the first stab at it we could use a 1 for "X".
2920 # But when do I reset the distributions to start with 0 again?
2921 # Jost suggested to have a random or cycling interaction ID that
2922 # we pass through. But the ID is something that is just left lying
2923 # around in addition to the counter, so I'd prefer to set the
2924 # counter to 0 now, and repeat at the end of the loop. But what
2925 # about dependencies? They appear later and are not reset, they
2926 # enter the queue but not its copy. How do they get a sensible
2929 my $needs_recursion_protection = "make|test|install";
2931 # construct the queue
2933 STHING: foreach $s (@some) {
2936 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
2938 } elsif ($s =~ m|[\$\@\%]|) { # looks like a perl variable
2939 } elsif ($s =~ m|^/|) { # looks like a regexp
2940 if (substr($s,-1,1) eq ".") {
2941 $obj = CPAN::Shell->expandany($s);
2943 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
2944 "not supported.\nRejecting argument '$s'\n");
2945 $CPAN::Frontend->mysleep(2);
2948 } elsif ($meth eq "ls") {
2949 $self->globls($s,\@pragma);
2952 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
2953 $obj = CPAN::Shell->expandany($s);
2956 } elsif (ref $obj) {
2957 if ($meth =~ /^($needs_recursion_protection)$/) {
2958 # silly for look or dump
2959 $obj->color_cmd_tmps(0,1);
2961 CPAN::Queue->new(qmod => $obj->id, reqtype => "c");
2963 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
2964 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
2965 if ($meth =~ /^(dump|ls)$/) {
2968 $CPAN::Frontend->mywarn(
2970 "Don't be silly, you can't $meth ",
2974 $CPAN::Frontend->mysleep(2);
2976 } elsif ($s =~ m|[\$\@\%]| && $meth eq "dump") {
2977 CPAN::InfoObj->dump($s);
2980 ->mywarn(qq{Warning: Cannot $meth $s, }.
2981 qq{don't know what it is.
2986 to find objects with matching identifiers.
2988 $CPAN::Frontend->mysleep(2);
2992 # queuerunner (please be warned: when I started to change the
2993 # queue to hold objects instead of names, I made one or two
2994 # mistakes and never found which. I reverted back instead)
2995 while (my $q = CPAN::Queue->first) {
2997 my $s = $q->as_string;
2998 my $reqtype = $q->reqtype || "";
2999 $obj = CPAN::Shell->expandany($s);
3001 # don't know how this can happen, maybe we should panic,
3002 # but maybe we get a solution from the first user who hits
3003 # this unfortunate exception?
3004 $CPAN::Frontend->mywarn("Warning: Could not expand string '$s' ".
3005 "to an object. Skipping.");
3006 $CPAN::Frontend->mysleep(5);
3009 $obj->{reqtype} ||= "";
3011 # force debugging because CPAN::SQLite somehow delivers us
3014 # local $CPAN::DEBUG = 1024; # Shell; probably fixed now
3016 CPAN->debug("s[$s]obj-reqtype[$obj->{reqtype}]".
3017 "q-reqtype[$reqtype]") if $CPAN::DEBUG;
3019 if ($obj->{reqtype}) {
3020 if ($obj->{reqtype} eq "b" && $reqtype =~ /^[rc]$/) {
3021 $obj->{reqtype} = $reqtype;
3023 exists $obj->{install}
3026 UNIVERSAL::can($obj->{install},"failed") ?
3027 $obj->{install}->failed :
3028 $obj->{install} =~ /^NO/
3031 delete $obj->{install};
3032 $CPAN::Frontend->mywarn
3033 ("Promoting $obj->{ID} from 'build_requires' to 'requires'");
3037 $obj->{reqtype} = $reqtype;
3040 for my $pragma (@pragma) {
3043 $obj->can($pragma)){
3044 $obj->$pragma($meth);
3047 if (UNIVERSAL::can($obj, 'called_for')) {
3048 $obj->called_for($s);
3050 CPAN->debug(qq{pragma[@pragma]meth[$meth]}.
3051 qq{ID[$obj->{ID}]}) if $CPAN::DEBUG;
3054 if (! UNIVERSAL::can($obj,$meth)) {
3056 my $serialized = "";
3058 } elsif ($CPAN::META->has_inst("YAML::Syck")) {
3059 $serialized = YAML::Syck::Dump($obj);
3060 } elsif ($CPAN::META->has_inst("YAML")) {
3061 $serialized = YAML::Dump($obj);
3062 } elsif ($CPAN::META->has_inst("Data::Dumper")) {
3063 $serialized = Data::Dumper::Dumper($obj);
3066 $serialized = overload::StrVal($obj);
3068 $CPAN::Frontend->mydie("Panic: obj[$serialized] cannot meth[$meth]");
3069 } elsif ($obj->$meth()){
3070 CPAN::Queue->delete($s);
3072 CPAN->debug("failed");
3076 for my $pragma (@pragma) {
3077 my $unpragma = "un$pragma";
3078 if ($obj->can($unpragma)) {
3082 CPAN::Queue->delete_first($s);
3084 if ($meth =~ /^($needs_recursion_protection)$/) {
3085 for my $obj (@qcopy) {
3086 $obj->color_cmd_tmps(0,0);
3091 #-> sub CPAN::Shell::recent ;
3095 CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
3100 # set up the dispatching methods
3102 for my $command (qw(
3118 *$command = sub { shift->rematein($command, @_); };
3122 package CPAN::LWP::UserAgent;
3126 return if $SETUPDONE;
3127 if ($CPAN::META->has_usable('LWP::UserAgent')) {
3128 require LWP::UserAgent;
3129 @ISA = qw(Exporter LWP::UserAgent);
3132 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
3136 sub get_basic_credentials {
3137 my($self, $realm, $uri, $proxy) = @_;
3138 if ($USER && $PASSWD) {
3139 return ($USER, $PASSWD);
3142 ($USER,$PASSWD) = $self->get_proxy_credentials();
3144 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
3146 return($USER,$PASSWD);
3149 sub get_proxy_credentials {
3151 my ($user, $password);
3152 if ( defined $CPAN::Config->{proxy_user} &&
3153 defined $CPAN::Config->{proxy_pass}) {
3154 $user = $CPAN::Config->{proxy_user};
3155 $password = $CPAN::Config->{proxy_pass};
3156 return ($user, $password);
3158 my $username_prompt = "\nProxy authentication needed!
3159 (Note: to permanently configure username and password run
3160 o conf proxy_user your_username
3161 o conf proxy_pass your_password
3163 ($user, $password) =
3164 _get_username_and_password_from_user($username_prompt);
3165 return ($user,$password);
3168 sub get_non_proxy_credentials {
3170 my ($user,$password);
3171 if ( defined $CPAN::Config->{username} &&
3172 defined $CPAN::Config->{password}) {
3173 $user = $CPAN::Config->{username};
3174 $password = $CPAN::Config->{password};
3175 return ($user, $password);
3177 my $username_prompt = "\nAuthentication needed!
3178 (Note: to permanently configure username and password run
3179 o conf username your_username
3180 o conf password your_password
3183 ($user, $password) =
3184 _get_username_and_password_from_user($username_prompt);
3185 return ($user,$password);
3188 sub _get_username_and_password_from_user {
3189 my $username_message = shift;
3190 my ($username,$password);
3192 ExtUtils::MakeMaker->import(qw(prompt));
3193 $username = prompt($username_message);
3194 if ($CPAN::META->has_inst("Term::ReadKey")) {
3195 Term::ReadKey::ReadMode("noecho");
3198 $CPAN::Frontend->mywarn(
3199 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
3202 $password = prompt("Password:");
3204 if ($CPAN::META->has_inst("Term::ReadKey")) {
3205 Term::ReadKey::ReadMode("restore");
3207 $CPAN::Frontend->myprint("\n\n");
3208 return ($username,$password);
3211 # mirror(): Its purpose is to deal with proxy authentication. When we
3212 # call SUPER::mirror, we relly call the mirror method in
3213 # LWP::UserAgent. LWP::UserAgent will then call
3214 # $self->get_basic_credentials or some equivalent and this will be
3215 # $self->dispatched to our own get_basic_credentials method.
3217 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
3219 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
3220 # although we have gone through our get_basic_credentials, the proxy
3221 # server refuses to connect. This could be a case where the username or
3222 # password has changed in the meantime, so I'm trying once again without
3223 # $USER and $PASSWD to give the get_basic_credentials routine another
3224 # chance to set $USER and $PASSWD.
3226 # mirror(): Its purpose is to deal with proxy authentication. When we
3227 # call SUPER::mirror, we relly call the mirror method in
3228 # LWP::UserAgent. LWP::UserAgent will then call
3229 # $self->get_basic_credentials or some equivalent and this will be
3230 # $self->dispatched to our own get_basic_credentials method.
3232 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
3234 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
3235 # although we have gone through our get_basic_credentials, the proxy
3236 # server refuses to connect. This could be a case where the username or
3237 # password has changed in the meantime, so I'm trying once again without
3238 # $USER and $PASSWD to give the get_basic_credentials routine another
3239 # chance to set $USER and $PASSWD.
3242 my($self,$url,$aslocal) = @_;
3243 my $result = $self->SUPER::mirror($url,$aslocal);
3244 if ($result->code == 407) {
3247 $result = $self->SUPER::mirror($url,$aslocal);
3255 #-> sub CPAN::FTP::ftp_statistics
3256 # if they want to rewrite, they need to pass in a filehandle
3257 sub _ftp_statistics {
3259 my $locktype = $fh ? LOCK_EX : LOCK_SH;
3260 $fh ||= FileHandle->new;
3261 my $file = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
3262 open $fh, "+>>$file" or $CPAN::Frontend->mydie("Could not open '$file': $!");
3265 while (!flock $fh, $locktype|LOCK_NB) {
3266 $waitstart ||= localtime();
3268 $CPAN::Frontend->mywarn("Waiting for a read lock on '$file' (since $waitstart)\n");
3270 $CPAN::Frontend->mysleep($sleep);
3273 } elsif ($sleep <=6) {
3277 my $stats = eval { CPAN->_yaml_loadfile($file); };
3280 if (ref $@ eq "CPAN::Exception::yaml_not_installed") {
3281 $CPAN::Frontend->myprint("Warning (usually harmless): $@");
3283 } elsif (ref $@ eq "CPAN::Exception::yaml_process_error") {
3284 $CPAN::Frontend->mydie($@);
3287 $CPAN::Frontend->mydie($@);
3293 #-> sub CPAN::FTP::_mytime
3295 if (CPAN->has_inst("Time::HiRes")) {
3296 return Time::HiRes::time();
3302 #-> sub CPAN::FTP::_new_stats
3304 my($self,$file) = @_;
3313 #-> sub CPAN::FTP::_add_to_statistics
3314 sub _add_to_statistics {
3315 my($self,$stats) = @_;
3316 my $yaml_module = CPAN::_yaml_module;
3317 $self->debug("yaml_module[$yaml_module]") if $CPAN::DEBUG;
3318 if ($CPAN::META->has_inst($yaml_module)) {
3319 $stats->{thesiteurl} = $ThesiteURL;
3320 if (CPAN->has_inst("Time::HiRes")) {
3321 $stats->{end} = Time::HiRes::time();
3323 $stats->{end} = time;
3325 my $fh = FileHandle->new;
3329 @debug = $time if $sdebug;
3330 my $fullstats = $self->_ftp_statistics($fh);
3332 $fullstats->{history} ||= [];
3333 push @debug, scalar @{$fullstats->{history}} if $sdebug;
3334 push @debug, time if $sdebug;
3335 push @{$fullstats->{history}}, $stats;
3336 # arbitrary hardcoded constants until somebody demands to have
3337 # them settable; YAML.pm 0.62 is unacceptably slow with 999;
3338 # YAML::Syck 0.82 has no noticable performance problem with 999;
3340 @{$fullstats->{history}} > 99
3341 || $time - $fullstats->{history}[0]{start} > 14*86400
3343 shift @{$fullstats->{history}}
3345 push @debug, scalar @{$fullstats->{history}} if $sdebug;
3346 push @debug, time if $sdebug;
3347 push @debug, scalar localtime($fullstats->{history}[0]{start}) if $sdebug;
3348 # need no eval because if this fails, it is serious
3349 my $sfile = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
3350 CPAN->_yaml_dumpfile("$sfile.$$",$fullstats);
3351 if ( $sdebug||$CPAN::DEBUG ) {
3352 local $CPAN::DEBUG = 512; # FTP
3354 CPAN->debug(sprintf("DEBUG history: before_read[%d]before[%d]at[%d]".
3355 "after[%d]at[%d]oldest[%s]dumped backat[%d]",
3359 # Win32 cannot rename a file to an existing filename
3360 unlink($sfile) if ($^O eq 'MSWin32');
3361 rename "$sfile.$$", $sfile
3362 or $CPAN::Frontend->mydie("Could not rename '$sfile.$$' to '$sfile': $!\n");
3366 # if file is CHECKSUMS, suggest the place where we got the file to be
3367 # checked from, maybe only for young files?
3368 #-> sub CPAN::FTP::_recommend_url_for
3369 sub _recommend_url_for {
3370 my($self, $file) = @_;
3371 my $urllist = $self->_get_urllist;
3372 if ($file =~ s|/CHECKSUMS(.gz)?$||) {
3373 my $fullstats = $self->_ftp_statistics();
3374 my $history = $fullstats->{history} || [];
3375 while (my $last = pop @$history) {
3376 last if $last->{end} - time > 3600; # only young results are interesting
3377 next unless $last->{file}; # dirname of nothing dies!
3378 next unless $file eq File::Basename::dirname($last->{file});
3379 return $last->{thesiteurl};
3382 if ($CPAN::Config->{randomize_urllist}
3384 rand(1) < $CPAN::Config->{randomize_urllist}
3386 $urllist->[int rand scalar @$urllist];
3392 #-> sub CPAN::FTP::_get_urllist
3395 $CPAN::Config->{urllist} ||= [];
3396 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
3397 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
3398 $CPAN::Config->{urllist} = [];
3400 my @urllist = grep { defined $_ and length $_ } @{$CPAN::Config->{urllist}};
3401 for my $u (@urllist) {
3402 CPAN->debug("u[$u]") if $CPAN::DEBUG;
3403 if (UNIVERSAL::can($u,"text")) {
3404 $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
3406 $u .= "/" unless substr($u,-1) eq "/";
3407 $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
3413 #-> sub CPAN::FTP::ftp_get ;
3415 my($class,$host,$dir,$file,$target) = @_;
3417 qq[Going to fetch file [$file] from dir [$dir]
3418 on host [$host] as local [$target]\n]
3420 my $ftp = Net::FTP->new($host);
3422 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
3425 return 0 unless defined $ftp;
3426 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
3427 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
3428 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
3429 my $msg = $ftp->message;
3430 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
3433 unless ( $ftp->cwd($dir) ){
3434 my $msg = $ftp->message;
3435 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
3439 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
3440 unless ( $ftp->get($file,$target) ){
3441 my $msg = $ftp->message;
3442 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
3445 $ftp->quit; # it's ok if this fails
3449 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
3451 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
3452 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
3454 # > *** 1562,1567 ****
3455 # > --- 1562,1580 ----
3456 # > return 1 if substr($url,0,4) eq "file";
3457 # > return 1 unless $url =~ m|://([^/]+)|;
3459 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
3461 # > + $proxy =~ m|://([^/:]+)|;
3463 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
3464 # > + if ($noproxy) {
3465 # > + if ($host !~ /$noproxy$/) {
3466 # > + $host = $proxy;
3469 # > + $host = $proxy;
3472 # > require Net::Ping;
3473 # > return 1 unless $Net::Ping::VERSION >= 2;
3477 #-> sub CPAN::FTP::localize ;
3479 my($self,$file,$aslocal,$force) = @_;
3481 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
3482 unless defined $aslocal;
3483 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
3486 if ($^O eq 'MacOS') {
3487 # Comment by AK on 2000-09-03: Uniq short filenames would be
3488 # available in CHECKSUMS file
3489 my($name, $path) = File::Basename::fileparse($aslocal, '');
3490 if (length($name) > 31) {
3501 my $size = 31 - length($suf);
3502 while (length($name) > $size) {
3506 $aslocal = File::Spec->catfile($path, $name);
3510 if (-f $aslocal && -r _ && !($force & 1)){
3512 if ($size = -s $aslocal) {
3513 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
3516 # empty file from a previous unsuccessful attempt to download it
3518 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
3519 "could not remove.");
3522 my($maybe_restore) = 0;
3524 rename $aslocal, "$aslocal.bak$$";
3528 my($aslocal_dir) = File::Basename::dirname($aslocal);
3529 File::Path::mkpath($aslocal_dir);
3530 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
3531 qq{directory "$aslocal_dir".
3532 I\'ll continue, but if you encounter problems, they may be due
3533 to insufficient permissions.\n}) unless -w $aslocal_dir;
3535 # Inheritance is not easier to manage than a few if/else branches
3536 if ($CPAN::META->has_usable('LWP::UserAgent')) {
3538 CPAN::LWP::UserAgent->config;
3539 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
3541 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
3545 $Ua->proxy('ftp', $var)
3546 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
3547 $Ua->proxy('http', $var)
3548 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
3551 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
3553 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
3554 # > use ones that require basic autorization.
3556 # > Example of when I use it manually in my own stuff:
3558 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
3559 # > $req->proxy_authorization_basic("username","password");
3560 # > $res = $ua->request($req);
3564 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
3568 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
3569 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
3572 # Try the list of urls for each single object. We keep a record
3573 # where we did get a file from
3574 my(@reordered,$last);
3575 my $ccurllist = $self->_get_urllist;
3576 $last = $#$ccurllist;
3577 if ($force & 2) { # local cpans probably out of date, don't reorder
3578 @reordered = (0..$last);
3582 (substr($ccurllist->[$b],0,4) eq "file")
3584 (substr($ccurllist->[$a],0,4) eq "file")
3586 defined($ThesiteURL)
3588 ($ccurllist->[$b] eq $ThesiteURL)
3590 ($ccurllist->[$a] eq $ThesiteURL)
3595 $self->debug("Themethod[$Themethod]reordered[@reordered]") if $CPAN::DEBUG;
3597 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
3599 @levels = qw/easy hard hardest/;
3601 @levels = qw/easy/ if $^O eq 'MacOS';
3603 local $ENV{FTP_PASSIVE} =
3604 exists $CPAN::Config->{ftp_passive} ?
3605 $CPAN::Config->{ftp_passive} : 1;
3607 my $stats = $self->_new_stats($file);
3608 LEVEL: for $levelno (0..$#levels) {
3609 my $level = $levels[$levelno];
3610 my $method = "host$level";
3611 my @host_seq = $level eq "easy" ?
3612 @reordered : 0..$last; # reordered has CDROM up front
3613 my @urllist = map { $ccurllist->[$_] } @host_seq;
3614 for my $u (@CPAN::Defaultsites) {
3615 push @urllist, $u unless grep { $_ eq $u } @urllist;
3617 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
3618 my $aslocal_tempfile = $aslocal . ".tmp" . $$;
3619 if (my $recommend = $self->_recommend_url_for($file)) {
3620 @urllist = grep { $_ ne $recommend } @urllist;
3621 unshift @urllist, $recommend;
3623 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
3624 $ret = $self->$method(\@urllist,$file,$aslocal_tempfile,$stats);
3626 CPAN->debug("ret[$ret]aslocal[$aslocal]") if $CPAN::DEBUG;
3627 if ($ret eq $aslocal_tempfile) {
3628 # if we got it exactly as we asked for, only then we
3630 rename $aslocal_tempfile, $aslocal
3631 or $CPAN::Frontend->mydie("Error while trying to rename ".
3632 "'$ret' to '$aslocal': $!");
3635 $Themethod = $level;
3637 # utime $now, $now, $aslocal; # too bad, if we do that, we
3638 # might alter a local mirror
3639 $self->debug("level[$level]") if $CPAN::DEBUG;
3642 unlink $aslocal_tempfile;
3643 last if $CPAN::Signal; # need to cleanup
3647 $stats->{filesize} = -s $ret;
3649 $self->debug("before _add_to_statistics") if $CPAN::DEBUG;
3650 $self->_add_to_statistics($stats);
3651 $self->debug("after _add_to_statistics") if $CPAN::DEBUG;
3653 unlink "$aslocal.bak$$";
3656 unless ($CPAN::Signal) {
3659 if (@{$CPAN::Config->{urllist}}) {
3661 qq{Please check, if the URLs I found in your configuration file \(}.
3662 join(", ", @{$CPAN::Config->{urllist}}).
3665 push @mess, qq{Your urllist is empty!};
3667 push @mess, qq{The urllist can be edited.},
3668 qq{E.g. with 'o conf urllist push ftp://myurl/'};
3669 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
3670 $CPAN::Frontend->mywarn("Could not fetch $file\n");
3671 $CPAN::Frontend->mysleep(2);
3673 if ($maybe_restore) {
3674 rename "$aslocal.bak$$", $aslocal;
3675 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
3676 $self->ls($aslocal));
3683 my($self,$stats,$method,$url) = @_;
3684 push @{$stats->{attempts}}, {
3691 # package CPAN::FTP;
3693 my($self,$host_seq,$file,$aslocal,$stats) = @_;
3695 HOSTEASY: for $ro_url (@$host_seq) {
3696 $self->_set_attempt($stats,"easy",$ro_url);
3697 my $url .= "$ro_url$file";
3698 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
3699 if ($url =~ /^file:/) {
3701 if ($CPAN::META->has_inst('URI::URL')) {
3702 my $u = URI::URL->new($url);
3704 } else { # works only on Unix, is poorly constructed, but
3705 # hopefully better than nothing.
3706 # RFC 1738 says fileurl BNF is
3707 # fileurl = "file://" [ host | "localhost" ] "/" fpath
3708 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
3710 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
3711 $l =~ s|^file:||; # assume they
3715 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
3717 $self->debug("local file[$l]") if $CPAN::DEBUG;
3718 if ( -f $l && -r _) {
3719 $ThesiteURL = $ro_url;
3722 if ($l =~ /(.+)\.gz$/) {
3724 if ( -f $ungz && -r _) {
3725 $ThesiteURL = $ro_url;
3729 # Maybe mirror has compressed it?
3731 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
3732 eval { CPAN::Tarzip->new("$l.gz")->gunzip($aslocal) };
3734 $ThesiteURL = $ro_url;
3739 $self->debug("it was not a file URL") if $CPAN::DEBUG;
3740 if ($CPAN::META->has_usable('LWP')) {
3741 $CPAN::Frontend->myprint("Fetching with LWP:
3745 CPAN::LWP::UserAgent->config;
3746 eval { $Ua = CPAN::LWP::UserAgent->new; };
3748 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
3751 my $res = $Ua->mirror($url, $aslocal);
3752 if ($res->is_success) {
3753 $ThesiteURL = $ro_url;
3755 utime $now, $now, $aslocal; # download time is more
3756 # important than upload
3759 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3760 my $gzurl = "$url.gz";
3761 $CPAN::Frontend->myprint("Fetching with LWP:
3764 $res = $Ua->mirror($gzurl, "$aslocal.gz");
3765 if ($res->is_success) {
3766 if (eval {CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)}) {
3767 $ThesiteURL = $ro_url;
3772 $CPAN::Frontend->myprint(sprintf(
3773 "LWP failed with code[%s] message[%s]\n",
3777 # Alan Burlison informed me that in firewall environments
3778 # Net::FTP can still succeed where LWP fails. So we do not
3779 # skip Net::FTP anymore when LWP is available.
3782 $CPAN::Frontend->mywarn(" LWP not available\n");
3784 return if $CPAN::Signal;
3785 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3786 # that's the nice and easy way thanks to Graham
3787 $self->debug("recognized ftp") if $CPAN::DEBUG;
3788 my($host,$dir,$getfile) = ($1,$2,$3);
3789 if ($CPAN::META->has_usable('Net::FTP')) {
3791 $CPAN::Frontend->myprint("Fetching with Net::FTP:
3794 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
3795 "aslocal[$aslocal]") if $CPAN::DEBUG;
3796 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
3797 $ThesiteURL = $ro_url;
3800 if ($aslocal !~ /\.gz(?!\n)\Z/) {
3801 my $gz = "$aslocal.gz";
3802 $CPAN::Frontend->myprint("Fetching with Net::FTP
3805 if (CPAN::FTP->ftp_get($host,
3809 eval{CPAN::Tarzip->new($gz)->gunzip($aslocal)}
3811 $ThesiteURL = $ro_url;
3817 CPAN->debug("Net::FTP does not count as usable atm") if $CPAN::DEBUG;
3821 UNIVERSAL::can($ro_url,"text")
3823 $ro_url->{FROM} eq "USER"
3825 ##address #17973: default URLs should not try to override
3826 ##user-defined URLs just because LWP is not available
3827 my $ret = $self->hosthard([$ro_url],$file,$aslocal,$stats);
3828 return $ret if $ret;
3830 return if $CPAN::Signal;
3834 # package CPAN::FTP;
3836 my($self,$host_seq,$file,$aslocal,$stats) = @_;
3838 # Came back if Net::FTP couldn't establish connection (or
3839 # failed otherwise) Maybe they are behind a firewall, but they
3840 # gave us a socksified (or other) ftp program...
3843 my($devnull) = $CPAN::Config->{devnull} || "";
3845 my($aslocal_dir) = File::Basename::dirname($aslocal);
3846 File::Path::mkpath($aslocal_dir);
3847 HOSTHARD: for $ro_url (@$host_seq) {
3848 $self->_set_attempt($stats,"hard",$ro_url);
3849 my $url = "$ro_url$file";
3850 my($proto,$host,$dir,$getfile);
3852 # Courtesy Mark Conty mark_conty@cargill.com change from
3853 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3855 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
3856 # proto not yet used
3857 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
3859 next HOSTHARD; # who said, we could ftp anything except ftp?
3861 next HOSTHARD if $proto eq "file"; # file URLs would have had
3862 # success above. Likely a bogus URL
3864 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
3866 # Try the most capable first and leave ncftp* for last as it only
3868 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
3869 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
3870 next unless defined $funkyftp;
3871 next if $funkyftp =~ /^\s*$/;
3873 my($asl_ungz, $asl_gz);
3874 ($asl_ungz = $aslocal) =~ s/\.gz//;
3875 $asl_gz = "$asl_ungz.gz";
3877 my($src_switch) = "";
3879 my($stdout_redir) = " > $asl_ungz";
3881 $src_switch = " -source";
3882 } elsif ($f eq "ncftp"){
3883 $src_switch = " -c";
3884 } elsif ($f eq "wget"){
3885 $src_switch = " -O $asl_ungz";
3887 } elsif ($f eq 'curl'){
3888 $src_switch = ' -L -f -s -S --netrc-optional';
3891 if ($f eq "ncftpget"){
3892 $chdir = "cd $aslocal_dir && ";
3895 $CPAN::Frontend->myprint(
3897 Trying with "$funkyftp$src_switch" to get
3901 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
3902 $self->debug("system[$system]") if $CPAN::DEBUG;
3903 my($wstatus) = system($system);
3905 # lynx returns 0 when it fails somewhere
3907 my $content = do { local *FH;
3908 open FH, $asl_ungz or die;
3911 if ($content =~ /^<.*(<title>[45]|Error [45])/si) {
3912 $CPAN::Frontend->mywarn(qq{
3913 No success, the file that lynx has has downloaded looks like an error message:
3916 $CPAN::Frontend->mysleep(1);
3920 $CPAN::Frontend->myprint(qq{
3921 No success, the file that lynx has has downloaded is an empty file.
3926 if ($wstatus == 0) {
3929 } elsif ($asl_ungz ne $aslocal) {
3930 # test gzip integrity
3931 if (eval{CPAN::Tarzip->new($asl_ungz)->gtest}) {
3932 # e.g. foo.tar is gzipped --> foo.tar.gz
3933 rename $asl_ungz, $aslocal;
3935 eval{CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz)};
3938 $ThesiteURL = $ro_url;
3940 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3942 -f $asl_ungz && -s _ == 0;
3943 my $gz = "$aslocal.gz";
3944 my $gzurl = "$url.gz";
3945 $CPAN::Frontend->myprint(
3947 Trying with "$funkyftp$src_switch" to get
3950 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
3951 $self->debug("system[$system]") if $CPAN::DEBUG;
3953 if (($wstatus = system($system)) == 0
3957 # test gzip integrity
3958 my $ct = eval{CPAN::Tarzip->new($asl_gz)};
3959 if ($ct && $ct->gtest) {
3960 $ct->gunzip($aslocal);
3962 # somebody uncompressed file for us?
3963 rename $asl_ungz, $aslocal;
3965 $ThesiteURL = $ro_url;
3968 unlink $asl_gz if -f $asl_gz;
3971 my $estatus = $wstatus >> 8;
3972 my $size = -f $aslocal ?
3973 ", left\n$aslocal with size ".-s _ :
3974 "\nWarning: expected file [$aslocal] doesn't exist";
3975 $CPAN::Frontend->myprint(qq{
3976 System call "$system"
3977 returned status $estatus (wstat $wstatus)$size
3980 return if $CPAN::Signal;
3981 } # transfer programs
3985 # package CPAN::FTP;
3987 my($self,$host_seq,$file,$aslocal,$stats) = @_;
3990 my($aslocal_dir) = File::Basename::dirname($aslocal);
3991 File::Path::mkpath($aslocal_dir);
3992 my $ftpbin = $CPAN::Config->{ftp};
3993 unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) {
3994 $CPAN::Frontend->myprint("No external ftp command available\n\n");
3997 $CPAN::Frontend->mywarn(qq{
3998 As a last ressort we now switch to the external ftp command '$ftpbin'
4001 Doing so often leads to problems that are hard to diagnose.
4003 If you're victim of such problems, please consider unsetting the ftp
4004 config variable with
4010 $CPAN::Frontend->mysleep(2);
4011 HOSTHARDEST: for $ro_url (@$host_seq) {
4012 $self->_set_attempt($stats,"hardest",$ro_url);
4013 my $url = "$ro_url$file";
4014 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
4015 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
4018 my($host,$dir,$getfile) = ($1,$2,$3);
4020 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
4021 $ctime,$blksize,$blocks) = stat($aslocal);
4022 $timestamp = $mtime ||= 0;
4023 my($netrc) = CPAN::FTP::netrc->new;
4024 my($netrcfile) = $netrc->netrc;
4025 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
4026 my $targetfile = File::Basename::basename($aslocal);
4032 map("cd $_", split /\//, $dir), # RFC 1738
4034 "get $getfile $targetfile",
4038 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
4039 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
4040 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
4042 $netrc->contains($host))) if $CPAN::DEBUG;
4043 if ($netrc->protected) {
4044 my $dialog = join "", map { " $_\n" } @dialog;
4046 if ($netrc->contains($host)) {
4047 $netrc_explain = "Relying that your .netrc entry for '$host' ".
4048 "manages the login";
4050 $netrc_explain = "Relying that your default .netrc entry ".
4051 "manages the login";
4053 $CPAN::Frontend->myprint(qq{
4054 Trying with external ftp to get
4057 Going to send the dialog
4061 $self->talk_ftp("$ftpbin$verbose $host",
4063 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4064 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
4066 if ($mtime > $timestamp) {
4067 $CPAN::Frontend->myprint("GOT $aslocal\n");
4068 $ThesiteURL = $ro_url;
4071 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
4073 return if $CPAN::Signal;
4075 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
4076 qq{correctly protected.\n});
4079 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
4080 nor does it have a default entry\n");
4083 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
4084 # then and login manually to host, using e-mail as
4086 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
4090 "user anonymous $Config::Config{'cf_email'}"
4092 my $dialog = join "", map { " $_\n" } @dialog;
4093 $CPAN::Frontend->myprint(qq{
4094 Trying with external ftp to get
4096 Going to send the dialog
4100 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
4101 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4102 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
4104 if ($mtime > $timestamp) {
4105 $CPAN::Frontend->myprint("GOT $aslocal\n");
4106 $ThesiteURL = $ro_url;
4109 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
4111 return if $CPAN::Signal;
4112 $CPAN::Frontend->mywarn("Can't access URL $url.\n\n");
4113 $CPAN::Frontend->mysleep(2);
4117 # package CPAN::FTP;
4119 my($self,$command,@dialog) = @_;
4120 my $fh = FileHandle->new;
4121 $fh->open("|$command") or die "Couldn't open ftp: $!";
4122 foreach (@dialog) { $fh->print("$_\n") }
4123 $fh->close; # Wait for process to complete
4125 my $estatus = $wstatus >> 8;
4126 $CPAN::Frontend->myprint(qq{
4127 Subprocess "|$command"
4128 returned status $estatus (wstat $wstatus)
4132 # find2perl needs modularization, too, all the following is stolen
4136 my($self,$name) = @_;
4137 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
4138 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
4140 my($perms,%user,%group);
4144 $blocks = int(($blocks + 1) / 2);
4147 $blocks = int(($sizemm + 1023) / 1024);
4150 if (-f _) { $perms = '-'; }
4151 elsif (-d _) { $perms = 'd'; }
4152 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
4153 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
4154 elsif (-p _) { $perms = 'p'; }
4155 elsif (-S _) { $perms = 's'; }
4156 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
4158 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
4159 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
4160 my $tmpmode = $mode;
4161 my $tmp = $rwx[$tmpmode & 7];
4163 $tmp = $rwx[$tmpmode & 7] . $tmp;
4165 $tmp = $rwx[$tmpmode & 7] . $tmp;
4166 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
4167 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
4168 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
4171 my $user = $user{$uid} || $uid; # too lazy to implement lookup
4172 my $group = $group{$gid} || $gid;
4174 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
4176 my($moname) = $moname[$mon];
4177 if (-M _ > 365.25 / 2) {
4178 $timeyear = $year + 1900;
4181 $timeyear = sprintf("%02d:%02d", $hour, $min);
4184 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
4198 package CPAN::FTP::netrc;
4201 # package CPAN::FTP::netrc;
4204 my $home = CPAN::HandleConfig::home;
4205 my $file = File::Spec->catfile($home,".netrc");
4207 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4208 $atime,$mtime,$ctime,$blksize,$blocks)
4213 my($fh,@machines,$hasdefault);
4215 $fh = FileHandle->new or die "Could not create a filehandle";
4217 if($fh->open($file)){
4218 $protected = ($mode & 077) == 0;
4220 NETRC: while (<$fh>) {
4221 my(@tokens) = split " ", $_;
4222 TOKEN: while (@tokens) {
4223 my($t) = shift @tokens;
4224 if ($t eq "default"){
4228 last TOKEN if $t eq "macdef";
4229 if ($t eq "machine") {
4230 push @machines, shift @tokens;
4235 $file = $hasdefault = $protected = "";
4239 'mach' => [@machines],
4241 'hasdefault' => $hasdefault,
4242 'protected' => $protected,
4246 # CPAN::FTP::netrc::hasdefault;
4247 sub hasdefault { shift->{'hasdefault'} }
4248 sub netrc { shift->{'netrc'} }
4249 sub protected { shift->{'protected'} }
4251 my($self,$mach) = @_;
4252 for ( @{$self->{'mach'}} ) {
4253 return 1 if $_ eq $mach;
4258 package CPAN::Complete;
4262 my($text, $line, $start, $end) = @_;
4263 my(@perlret) = cpl($text, $line, $start);
4264 # find longest common match. Can anybody show me how to peruse
4265 # T::R::Gnu to have this done automatically? Seems expensive.
4266 return () unless @perlret;
4267 my($newtext) = $text;
4268 for (my $i = length($text)+1;;$i++) {
4269 last unless length($perlret[0]) && length($perlret[0]) >= $i;
4270 my $try = substr($perlret[0],0,$i);
4271 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
4272 # warn "try[$try]tries[@tries]";
4273 if (@tries == @perlret) {
4279 ($newtext,@perlret);
4282 #-> sub CPAN::Complete::cpl ;
4284 my($word,$line,$pos) = @_;
4288 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4290 if ($line =~ s/^((?:notest|f?force)\s*)//) {
4295 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
4296 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
4298 } elsif ($line =~ /^(a|ls)\s/) {
4299 @return = cplx('CPAN::Author',uc($word));
4300 } elsif ($line =~ /^b\s/) {
4301 CPAN::Shell->local_bundles;
4302 @return = cplx('CPAN::Bundle',$word);
4303 } elsif ($line =~ /^d\s/) {
4304 @return = cplx('CPAN::Distribution',$word);
4305 } elsif ($line =~ m/^(
4306 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
4308 if ($word =~ /^Bundle::/) {
4309 CPAN::Shell->local_bundles;
4311 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
4312 } elsif ($line =~ /^i\s/) {
4313 @return = cpl_any($word);
4314 } elsif ($line =~ /^reload\s/) {
4315 @return = cpl_reload($word,$line,$pos);
4316 } elsif ($line =~ /^o\s/) {
4317 @return = cpl_option($word,$line,$pos);
4318 } elsif ($line =~ m/^\S+\s/ ) {
4319 # fallback for future commands and what we have forgotten above
4320 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
4327 #-> sub CPAN::Complete::cplx ;
4329 my($class, $word) = @_;
4330 if (CPAN::_sqlite_running) {
4331 $CPAN::SQLite->search($class, "^\Q$word\E");
4333 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
4336 #-> sub CPAN::Complete::cpl_any ;
4340 cplx('CPAN::Author',$word),
4341 cplx('CPAN::Bundle',$word),
4342 cplx('CPAN::Distribution',$word),
4343 cplx('CPAN::Module',$word),
4347 #-> sub CPAN::Complete::cpl_reload ;
4349 my($word,$line,$pos) = @_;
4351 my(@words) = split " ", $line;
4352 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4353 my(@ok) = qw(cpan index);
4354 return @ok if @words == 1;
4355 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
4358 #-> sub CPAN::Complete::cpl_option ;
4360 my($word,$line,$pos) = @_;
4362 my(@words) = split " ", $line;
4363 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4364 my(@ok) = qw(conf debug);
4365 return @ok if @words == 1;
4366 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
4368 } elsif ($words[1] eq 'index') {
4370 } elsif ($words[1] eq 'conf') {
4371 return CPAN::HandleConfig::cpl(@_);
4372 } elsif ($words[1] eq 'debug') {
4373 return sort grep /^\Q$word\E/i,
4374 sort keys %CPAN::DEBUG, 'all';
4378 package CPAN::Index;
4381 #-> sub CPAN::Index::force_reload ;
4384 $CPAN::Index::LAST_TIME = 0;
4388 #-> sub CPAN::Index::reload ;
4390 my($self,$force) = @_;
4393 # XXX check if a newer one is available. (We currently read it
4394 # from time to time)
4395 for ($CPAN::Config->{index_expire}) {
4396 $_ = 0.001 unless $_ && $_ > 0.001;
4398 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
4399 # debug here when CPAN doesn't seem to read the Metadata
4401 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
4403 unless ($CPAN::META->{PROTOCOL}) {
4404 $self->read_metadata_cache;
4405 $CPAN::META->{PROTOCOL} ||= "1.0";
4407 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
4408 # warn "Setting last_time to 0";
4409 $LAST_TIME = 0; # No warning necessary
4411 if ($LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
4414 # CPAN->debug("LAST_TIME[$LAST_TIME]index_expire[$CPAN::Config->{index_expire}]time[$time]");
4416 # IFF we are developing, it helps to wipe out the memory
4417 # between reloads, otherwise it is not what a user expects.
4418 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
4419 $CPAN::META = CPAN->new;
4422 local $LAST_TIME = $time;
4423 local $CPAN::META->{PROTOCOL} = PROTOCOL;
4425 my $needshort = $^O eq "dos";
4427 $self->rd_authindex($self
4429 "authors/01mailrc.txt.gz",
4431 File::Spec->catfile('authors', '01mailrc.gz') :
4432 File::Spec->catfile('authors', '01mailrc.txt.gz'),
4435 $debug = "timing reading 01[".($t2 - $time)."]";
4437 return if $CPAN::Signal; # this is sometimes lengthy
4438 $self->rd_modpacks($self
4440 "modules/02packages.details.txt.gz",
4442 File::Spec->catfile('modules', '02packag.gz') :
4443 File::Spec->catfile('modules', '02packages.details.txt.gz'),
4446 $debug .= "02[".($t2 - $time)."]";
4448 return if $CPAN::Signal; # this is sometimes lengthy
4449 $self->rd_modlist($self
4451 "modules/03modlist.data.gz",
4453 File::Spec->catfile('modules', '03mlist.gz') :
4454 File::Spec->catfile('modules', '03modlist.data.gz'),
4456 $self->write_metadata_cache;
4458 $debug .= "03[".($t2 - $time)."]";
4460 CPAN->debug($debug) if $CPAN::DEBUG;
4462 if ($CPAN::Config->{build_dir_reuse}) {
4463 $self->reanimate_build_dir;
4465 if (CPAN::_sqlite_running) {
4466 $CPAN::SQLite->reload(time => $time, force => $force)
4470 $CPAN::META->{PROTOCOL} = PROTOCOL;
4473 #-> sub CPAN::Index::reanimate_build_dir ;
4474 sub reanimate_build_dir {
4476 unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module}||"YAML")) {
4479 return if $HAVE_REANIMATED++;
4480 my $d = $CPAN::Config->{build_dir};
4481 my $dh = DirHandle->new;
4482 opendir $dh, $d or return; # does not exist
4487 $CPAN::Frontend->myprint("Going to read $CPAN::Config->{build_dir}/\n");
4488 my @candidates = map { $_->[0] }
4489 sort { $b->[1] <=> $a->[1] }
4490 map { [ $_, -M File::Spec->catfile($d,$_) ] }
4491 grep {/\.yml$/} readdir $dh;
4492 DISTRO: for $dirent (@candidates) {
4493 my $y = eval {CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))};
4496 if ($c && CPAN->_perl_fingerprint($c->{perl})) {
4497 my $key = $c->{distribution}{ID};
4498 for my $k (keys %{$c->{distribution}}) {
4499 if ($c->{distribution}{$k}
4500 && ref $c->{distribution}{$k}
4501 && UNIVERSAL::isa($c->{distribution}{$k},"CPAN::Distrostatus")) {
4502 $c->{distribution}{$k}{COMMANDID} = $i - @candidates;
4506 #we tried to restore only if element already
4507 #exists; but then we do not work with metadata
4510 = $CPAN::META->{readwrite}{'CPAN::Distribution'}{$key}
4511 = $c->{distribution};
4512 delete $do->{badtestcnt};
4514 if ($do->{make_test}
4516 && !$do->{make_test}->failed
4520 $do->{install}->failed
4523 $CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME});
4528 while (($painted/76) < ($i/@candidates)) {
4529 $CPAN::Frontend->myprint(".");
4533 $CPAN::Frontend->myprint(sprintf(
4534 "DONE\nFound %s old builds, restored the state of %s\n",
4535 @candidates ? sprintf("%d",scalar @candidates) : "no",
4536 $restored || "none",
4541 #-> sub CPAN::Index::reload_x ;
4543 my($cl,$wanted,$localname,$force) = @_;
4544 $force |= 2; # means we're dealing with an index here
4545 CPAN::HandleConfig->load; # we should guarantee loading wherever
4546 # we rely on Config XXX
4547 $localname ||= $wanted;
4548 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
4552 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
4555 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
4556 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
4557 qq{day$s. I\'ll use that.});
4560 $force |= 1; # means we're quite serious about it.
4562 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
4565 #-> sub CPAN::Index::rd_authindex ;
4567 my($cl, $index_target) = @_;
4568 return unless defined $index_target;
4569 return if CPAN::_sqlite_running;
4571 $CPAN::Frontend->myprint("Going to read $index_target\n");
4573 tie *FH, 'CPAN::Tarzip', $index_target;
4576 push @lines, split /\012/ while <FH>;
4580 my($userid,$fullname,$email) =
4581 m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/;
4582 $fullname ||= $email;
4583 if ($userid && $fullname && $email){
4584 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
4585 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
4587 CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG;
4590 while (($painted/76) < ($i/@lines)) {
4591 $CPAN::Frontend->myprint(".");
4594 return if $CPAN::Signal;
4596 $CPAN::Frontend->myprint("DONE\n");
4600 my($self,$dist) = @_;
4601 $dist = $self->{'id'} unless defined $dist;
4602 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
4606 #-> sub CPAN::Index::rd_modpacks ;
4608 my($self, $index_target) = @_;
4609 return unless defined $index_target;
4610 return if CPAN::_sqlite_running;
4611 $CPAN::Frontend->myprint("Going to read $index_target\n");
4612 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
4614 CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
4617 while (my $bytes = $fh->READ(\$chunk,8192)) {
4620 my @lines = split /\012/, $slurp;
4621 CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG;
4624 my($line_count,$last_updated);
4626 my $shift = shift(@lines);
4627 last if $shift =~ /^\s*$/;
4628 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
4629 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
4631 CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
4632 if (not defined $line_count) {
4634 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
4635 Please check the validity of the index file by comparing it to more
4636 than one CPAN mirror. I'll continue but problems seem likely to
4640 $CPAN::Frontend->mysleep(5);
4641 } elsif ($line_count != scalar @lines) {
4643 $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
4644 contains a Line-Count header of %d but I see %d lines there. Please
4645 check the validity of the index file by comparing it to more than one
4646 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
4647 $index_target, $line_count, scalar(@lines));
4650 if (not defined $last_updated) {
4652 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
4653 Please check the validity of the index file by comparing it to more
4654 than one CPAN mirror. I'll continue but problems seem likely to
4658 $CPAN::Frontend->mysleep(5);
4662 ->myprint(sprintf qq{ Database was generated on %s\n},
4664 $DATE_OF_02 = $last_updated;
4667 if ($CPAN::META->has_inst('HTTP::Date')) {
4669 $age -= HTTP::Date::str2time($last_updated);
4671 $CPAN::Frontend->mywarn(" HTTP::Date not available\n");
4672 require Time::Local;
4673 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
4674 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
4675 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
4682 qq{Warning: This index file is %d days old.
4683 Please check the host you chose as your CPAN mirror for staleness.
4684 I'll continue but problems seem likely to happen.\a\n},
4687 } elsif ($age < -1) {
4691 qq{Warning: Your system date is %d days behind this index file!
4693 Timestamp index file: %s
4694 Please fix your system time, problems with the make command expected.\n},
4704 # A necessity since we have metadata_cache: delete what isn't
4706 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
4707 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
4712 # before 1.56 we split into 3 and discarded the rest. From
4713 # 1.57 we assign remaining text to $comment thus allowing to
4714 # influence isa_perl
4715 my($mod,$version,$dist,$comment) = split " ", $_, 4;
4716 my($bundle,$id,$userid);
4718 if ($mod eq 'CPAN' &&
4720 CPAN::Queue->exists('Bundle::CPAN') ||
4721 CPAN::Queue->exists('CPAN')
4725 if ($version > $CPAN::VERSION){
4726 $CPAN::Frontend->mywarn(qq{
4727 New CPAN.pm version (v$version) available.
4728 [Currently running version is v$CPAN::VERSION]
4729 You might want to try
4732 to both upgrade CPAN.pm and run the new version without leaving
4733 the current session.
4736 $CPAN::Frontend->mysleep(2);
4737 $CPAN::Frontend->myprint(qq{\n});
4739 last if $CPAN::Signal;
4740 } elsif ($mod =~ /^Bundle::(.*)/) {
4745 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
4746 # Let's make it a module too, because bundles have so much
4747 # in common with modules.
4749 # Changed in 1.57_63: seems like memory bloat now without
4750 # any value, so commented out
4752 # $CPAN::META->instance('CPAN::Module',$mod);
4756 # instantiate a module object
4757 $id = $CPAN::META->instance('CPAN::Module',$mod);
4761 # Although CPAN prohibits same name with different version the
4762 # indexer may have changed the version for the same distro
4763 # since the last time ("Force Reindexing" feature)
4764 if ($id->cpan_file ne $dist
4766 $id->cpan_version ne $version
4768 $userid = $id->userid || $self->userid($dist);
4770 'CPAN_USERID' => $userid,
4771 'CPAN_VERSION' => $version,
4772 'CPAN_FILE' => $dist,
4776 # instantiate a distribution object
4777 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
4778 # we do not need CONTAINSMODS unless we do something with
4779 # this dist, so we better produce it on demand.
4781 ## my $obj = $CPAN::META->instance(
4782 ## 'CPAN::Distribution' => $dist
4784 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
4786 $CPAN::META->instance(
4787 'CPAN::Distribution' => $dist
4789 'CPAN_USERID' => $userid,
4790 'CPAN_COMMENT' => $comment,
4794 for my $name ($mod,$dist) {
4795 # $self->debug("exists name[$name]") if $CPAN::DEBUG;
4796 $exists{$name} = undef;
4800 while (($painted/76) < ($i/@lines)) {
4801 $CPAN::Frontend->myprint(".");
4804 return if $CPAN::Signal;
4806 $CPAN::Frontend->myprint("DONE\n");
4808 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
4809 for my $o ($CPAN::META->all_objects($class)) {
4810 next if exists $exists{$o->{ID}};
4811 $CPAN::META->delete($class,$o->{ID});
4812 # CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
4819 #-> sub CPAN::Index::rd_modlist ;
4821 my($cl,$index_target) = @_;
4822 return unless defined $index_target;
4823 return if CPAN::_sqlite_running;
4824 $CPAN::Frontend->myprint("Going to read $index_target\n");
4825 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
4829 while (my $bytes = $fh->READ(\$chunk,8192)) {
4832 my @eval2 = split /\012/, $slurp;
4835 my $shift = shift(@eval2);
4836 if ($shift =~ /^Date:\s+(.*)/){
4837 if ($DATE_OF_03 eq $1){
4838 $CPAN::Frontend->myprint("Unchanged.\n");
4843 last if $shift =~ /^\s*$/;
4845 push @eval2, q{CPAN::Modulelist->data;};
4847 my($comp) = Safe->new("CPAN::Safe1");
4848 my($eval2) = join("\n", @eval2);
4849 CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
4850 my $ret = $comp->reval($eval2);
4851 Carp::confess($@) if $@;
4852 return if $CPAN::Signal;
4854 my $until = keys(%$ret);
4856 CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
4858 my $obj = $CPAN::META->instance("CPAN::Module",$_);
4859 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
4860 $obj->set(%{$ret->{$_}});
4862 while (($painted/76) < ($i/$until)) {
4863 $CPAN::Frontend->myprint(".");
4866 return if $CPAN::Signal;
4868 $CPAN::Frontend->myprint("DONE\n");
4871 #-> sub CPAN::Index::write_metadata_cache ;
4872 sub write_metadata_cache {
4874 return unless $CPAN::Config->{'cache_metadata'};
4875 return if CPAN::_sqlite_running;
4876 return unless $CPAN::META->has_usable("Storable");
4878 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
4879 CPAN::Distribution)) {
4880 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
4882 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4883 $cache->{last_time} = $LAST_TIME;
4884 $cache->{DATE_OF_02} = $DATE_OF_02;
4885 $cache->{PROTOCOL} = PROTOCOL;
4886 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
4887 eval { Storable::nstore($cache, $metadata_file) };
4888 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4891 #-> sub CPAN::Index::read_metadata_cache ;
4892 sub read_metadata_cache {
4894 return unless $CPAN::Config->{'cache_metadata'};
4895 return if CPAN::_sqlite_running;
4896 return unless $CPAN::META->has_usable("Storable");
4897 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4898 return unless -r $metadata_file and -f $metadata_file;
4899 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
4901 eval { $cache = Storable::retrieve($metadata_file) };
4902 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4903 if (!$cache || !UNIVERSAL::isa($cache, 'HASH')){
4907 if (exists $cache->{PROTOCOL}) {
4908 if (PROTOCOL > $cache->{PROTOCOL}) {
4909 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
4910 "with protocol v%s, requiring v%s\n",
4917 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
4918 "with protocol v1.0\n");
4923 while(my($class,$v) = each %$cache) {
4924 next unless $class =~ /^CPAN::/;
4925 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
4926 while (my($id,$ro) = each %$v) {
4927 $CPAN::META->{readwrite}{$class}{$id} ||=
4928 $class->new(ID=>$id, RO=>$ro);
4933 unless ($clcnt) { # sanity check
4934 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
4937 if ($idcnt < 1000) {
4938 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
4939 "in $metadata_file\n");
4942 $CPAN::META->{PROTOCOL} ||=
4943 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
4944 # does initialize to some protocol
4945 $LAST_TIME = $cache->{last_time};
4946 $DATE_OF_02 = $cache->{DATE_OF_02};
4947 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
4948 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
4952 package CPAN::InfoObj;
4957 exists $self->{RO} and return $self->{RO};
4960 #-> sub CPAN::InfoObj::cpan_userid
4965 return $ro->{CPAN_USERID} || "N/A";
4967 $self->debug("ID[$self->{ID}]");
4968 # N/A for bundles found locally
4973 sub id { shift->{ID}; }
4975 #-> sub CPAN::InfoObj::new ;
4977 my $this = bless {}, shift;
4982 # The set method may only be used by code that reads index data or
4983 # otherwise "objective" data from the outside world. All session
4984 # related material may do anything else with instance variables but
4985 # must not touch the hash under the RO attribute. The reason is that
4986 # the RO hash gets written to Metadata file and is thus persistent.
4988 #-> sub CPAN::InfoObj::safe_chdir ;
4990 my($self,$todir) = @_;
4991 # we die if we cannot chdir and we are debuggable
4992 Carp::confess("safe_chdir called without todir argument")
4993 unless defined $todir and length $todir;
4995 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4999 unless (-x $todir) {
5000 unless (chmod 0755, $todir) {
5001 my $cwd = CPAN::anycwd();
5002 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
5003 "permission to change the permission; cannot ".
5004 "chdir to '$todir'\n");
5005 $CPAN::Frontend->mysleep(5);
5006 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
5007 qq{to todir[$todir]: $!});
5011 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
5014 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
5017 my $cwd = CPAN::anycwd();
5018 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
5019 qq{to todir[$todir] (a chmod has been issued): $!});
5024 #-> sub CPAN::InfoObj::set ;
5026 my($self,%att) = @_;
5027 my $class = ref $self;
5029 # This must be ||=, not ||, because only if we write an empty
5030 # reference, only then the set method will write into the readonly
5031 # area. But for Distributions that spring into existence, maybe
5032 # because of a typo, we do not like it that they are written into
5033 # the readonly area and made permanent (at least for a while) and
5034 # that is why we do not "allow" other places to call ->set.
5035 unless ($self->id) {
5036 CPAN->debug("Bug? Empty ID, rejecting");
5039 my $ro = $self->{RO} =
5040 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
5042 while (my($k,$v) = each %att) {
5047 #-> sub CPAN::InfoObj::as_glimpse ;
5051 my $class = ref($self);
5052 $class =~ s/^CPAN:://;
5053 my $id = $self->can("pretty_id") ? $self->pretty_id : $self->{ID};
5054 push @m, sprintf "%-15s %s\n", $class, $id;
5058 #-> sub CPAN::InfoObj::as_string ;
5062 my $class = ref($self);
5063 $class =~ s/^CPAN:://;
5064 push @m, $class, " id = $self->{ID}\n";
5066 unless ($ro = $self->ro) {
5067 if (substr($self->{ID},-1,1) eq ".") { # directory
5070 $CPAN::Frontend->mydie("Unknown object $self->{ID}");
5073 for (sort keys %$ro) {
5074 # next if m/^(ID|RO)$/;
5076 if ($_ eq "CPAN_USERID") {
5078 $extra .= $self->fullname;
5079 my $email; # old perls!
5080 if ($email = $CPAN::META->instance("CPAN::Author",
5083 $extra .= " <$email>";
5085 $extra .= " <no email>";
5088 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
5089 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
5092 next unless defined $ro->{$_};
5093 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
5095 KEY: for (sort keys %$self) {
5096 next if m/^(ID|RO)$/;
5097 unless (defined $self->{$_}) {
5101 if (ref($self->{$_}) eq "ARRAY") {
5102 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
5103 } elsif (ref($self->{$_}) eq "HASH") {
5105 if (/^CONTAINSMODS$/) {
5106 $value = join(" ",sort keys %{$self->{$_}});
5107 } elsif (/^prereq_pm$/) {
5109 my $v = $self->{$_};
5110 for my $x (sort keys %$v) {
5112 for my $y (sort keys %{$v->{$x}}) {
5113 push @svalue, "$y=>$v->{$x}{$y}";
5115 push @value, "$x\:" . join ",", @svalue if @svalue;
5117 $value = join ";", @value;
5119 $value = $self->{$_};
5127 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
5133 #-> sub CPAN::InfoObj::fullname ;
5136 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
5139 #-> sub CPAN::InfoObj::dump ;
5141 my($self, $what) = @_;
5142 unless ($CPAN::META->has_inst("Data::Dumper")) {
5143 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
5145 local $Data::Dumper::Sortkeys;
5146 $Data::Dumper::Sortkeys = 1;
5147 my $out = Data::Dumper::Dumper($what ? eval $what : $self);
5148 if (length $out > 100000) {
5149 my $fh_pager = FileHandle->new;
5150 local($SIG{PIPE}) = "IGNORE";
5151 my $pager = $CPAN::Config->{'pager'} || "cat";
5152 $fh_pager->open("|$pager")
5153 or die "Could not open pager $pager\: $!";
5154 $fh_pager->print($out);
5157 $CPAN::Frontend->myprint($out);
5161 package CPAN::Author;
5164 #-> sub CPAN::Author::force
5170 #-> sub CPAN::Author::force
5173 delete $self->{force};
5176 #-> sub CPAN::Author::id
5179 my $id = $self->{ID};
5180 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
5184 #-> sub CPAN::Author::as_glimpse ;
5188 my $class = ref($self);
5189 $class =~ s/^CPAN:://;
5190 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
5198 #-> sub CPAN::Author::fullname ;
5200 shift->ro->{FULLNAME};
5204 #-> sub CPAN::Author::email ;
5205 sub email { shift->ro->{EMAIL}; }
5207 #-> sub CPAN::Author::ls ;
5210 my $glob = shift || "";
5211 my $silent = shift || 0;
5214 # adapted from CPAN::Distribution::verifyCHECKSUM ;
5215 my(@csf); # chksumfile
5216 @csf = $self->id =~ /(.)(.)(.*)/;
5217 $csf[1] = join "", @csf[0,1];
5218 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
5220 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
5221 unless (grep {$_->[2] eq $csf[1]} @dl) {
5222 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
5225 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
5226 unless (grep {$_->[2] eq $csf[2]} @dl) {
5227 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
5230 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
5232 if ($CPAN::META->has_inst("Text::Glob")) {
5233 my $rglob = Text::Glob::glob_to_regex($glob);
5234 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
5236 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
5239 $CPAN::Frontend->myprint(join "", map {
5240 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
5241 } sort { $a->[2] cmp $b->[2] } @dl);
5245 # returns an array of arrays, the latter contain (size,mtime,filename)
5246 #-> sub CPAN::Author::dir_listing ;
5249 my $chksumfile = shift;
5250 my $recursive = shift;
5251 my $may_ftp = shift;
5254 File::Spec->catfile($CPAN::Config->{keep_source_where},
5255 "authors", "id", @$chksumfile);
5259 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
5260 # hazard. (Without GPG installed they are not that much better,
5262 $fh = FileHandle->new;
5263 if (open($fh, $lc_want)) {
5264 my $line = <$fh>; close $fh;
5265 unlink($lc_want) unless $line =~ /PGP/;
5269 # connect "force" argument with "index_expire".
5270 my $force = $self->{force};
5271 if (my @stat = stat $lc_want) {
5272 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
5276 $lc_file = CPAN::FTP->localize(
5277 "authors/id/@$chksumfile",
5282 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
5283 $chksumfile->[-1] .= ".gz";
5284 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
5287 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
5288 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
5294 $lc_file = $lc_want;
5295 # we *could* second-guess and if the user has a file: URL,
5296 # then we could look there. But on the other hand, if they do
5297 # have a file: URL, wy did they choose to set
5298 # $CPAN::Config->{show_upload_date} to false?
5301 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
5302 $fh = FileHandle->new;
5304 if (open $fh, $lc_file){
5307 $eval =~ s/\015?\012/\n/g;
5309 my($comp) = Safe->new();
5310 $cksum = $comp->reval($eval);
5312 rename $lc_file, "$lc_file.bad";
5313 Carp::confess($@) if $@;
5315 } elsif ($may_ftp) {
5316 Carp::carp "Could not open '$lc_file' for reading.";
5318 # Maybe should warn: "You may want to set show_upload_date to a true value"
5322 for $f (sort keys %$cksum) {
5323 if (exists $cksum->{$f}{isdir}) {
5325 my(@dir) = @$chksumfile;
5327 push @dir, $f, "CHECKSUMS";
5329 [$_->[0], $_->[1], "$f/$_->[2]"]
5330 } $self->dir_listing(\@dir,1,$may_ftp);
5332 push @result, [ 0, "-", $f ];
5336 ($cksum->{$f}{"size"}||0),
5337 $cksum->{$f}{"mtime"}||"---",
5345 package CPAN::Distribution;
5351 my $ro = $self->ro or return;
5355 # CPAN::Distribution::undelay
5358 delete $self->{later};
5361 # add the A/AN/ stuff
5362 # CPAN::Distribution::normalize
5365 $s = $self->id unless defined $s;
5366 if (substr($s,-1,1) eq ".") {
5367 # using a global because we are sometimes called as static method
5368 if (!$CPAN::META->{LOCK}
5369 && !$CPAN::Have_warned->{"$s is unlocked"}++
5371 $CPAN::Frontend->mywarn("You are visiting the local directory
5373 without lock, take care that concurrent processes do not do likewise.\n");
5374 $CPAN::Frontend->mysleep(1);
5377 $s = "$CPAN::iCwd/.";
5378 } elsif (File::Spec->file_name_is_absolute($s)) {
5379 } elsif (File::Spec->can("rel2abs")) {
5380 $s = File::Spec->rel2abs($s);
5382 $CPAN::Frontend->mydie("Your File::Spec is too old, please upgrade File::Spec");
5384 CPAN->debug("s[$s]") if $CPAN::DEBUG;
5385 unless ($CPAN::META->exists("CPAN::Distribution", $s)) {
5386 for ($CPAN::META->instance("CPAN::Distribution", $s)) {
5387 $_->{build_dir} = $s;
5388 $_->{archived} = "local_directory";
5389 $_->{unwrapped} = CPAN::Distrostatus->new("YES -- local_directory");
5395 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
5397 return $s if $s =~ m:^N/A|^Contact Author: ;
5398 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
5399 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
5400 CPAN->debug("s[$s]") if $CPAN::DEBUG;
5405 #-> sub CPAN::Distribution::author ;
5409 if (substr($self->id,-1,1) eq ".") {
5410 $authorid = "LOCAL";
5412 ($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
5414 CPAN::Shell->expand("Author",$authorid);
5417 # tries to get the yaml from CPAN instead of the distro itself:
5418 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
5421 my $meta = $self->pretty_id;
5422 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
5423 my(@ls) = CPAN::Shell->globls($meta);
5424 my $norm = $self->normalize($meta);
5428 File::Spec->catfile(
5429 $CPAN::Config->{keep_source_where},
5434 $self->debug("Doing localize") if $CPAN::DEBUG;
5435 unless ($local_file =
5436 CPAN::FTP->localize("authors/id/$norm",
5438 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
5440 my $yaml = CPAN->_yaml_loadfile($local_file)->[0];
5443 #-> sub CPAN::Distribution::cpan_userid
5446 if ($self->{ID} =~ m{[A-Z]/[A-Z\-]{2}/([A-Z\-]+)/}) {
5449 return $self->SUPER::cpan_userid;
5452 #-> sub CPAN::Distribution::pretty_id
5456 return $id unless $id =~ m|^./../|;
5460 # mark as dirty/clean for the sake of recursion detection. $color=1
5461 # means "in use", $color=0 means "not in use anymore". $color=2 means
5462 # we have determined prereqs now and thus insist on passing this
5463 # through (at least) once again.
5465 #-> sub CPAN::Distribution::color_cmd_tmps ;
5466 sub color_cmd_tmps {
5468 my($depth) = shift || 0;
5469 my($color) = shift || 0;
5470 my($ancestors) = shift || [];
5471 # a distribution needs to recurse into its prereq_pms
5473 return if exists $self->{incommandcolor}
5475 && $self->{incommandcolor}==$color;
5476 if ($depth>=$CPAN::MAX_RECURSION){
5477 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
5479 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
5480 my $prereq_pm = $self->prereq_pm;
5481 if (defined $prereq_pm) {
5482 PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
5483 keys %{$prereq_pm->{build_requires}||{}}) {
5484 next PREREQ if $pre eq "perl";
5486 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
5487 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
5488 $CPAN::Frontend->mysleep(2);
5491 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
5495 delete $self->{sponsored_mods};
5497 # as we are at the end of a command, we'll give up this
5498 # reminder of a broken test. Other commands may test this guy
5499 # again. Maybe 'badtestcnt' should be renamed to
5500 # 'make_test_failed_within_command'?
5501 delete $self->{badtestcnt};
5503 $self->{incommandcolor} = $color;
5506 #-> sub CPAN::Distribution::as_string ;
5509 $self->containsmods;
5511 $self->SUPER::as_string(@_);
5514 #-> sub CPAN::Distribution::containsmods ;
5517 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
5518 my $dist_id = $self->{ID};
5519 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
5520 my $mod_file = $mod->cpan_file or next;
5521 my $mod_id = $mod->{ID} or next;
5522 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
5524 if ($CPAN::Signal) {
5525 delete $self->{CONTAINSMODS};
5528 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
5530 keys %{$self->{CONTAINSMODS}||{}};
5533 #-> sub CPAN::Distribution::upload_date ;
5536 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
5537 my(@local_wanted) = split(/\//,$self->id);
5538 my $filename = pop @local_wanted;
5539 push @local_wanted, "CHECKSUMS";
5540 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
5541 return unless $author;
5542 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
5544 my($dirent) = grep { $_->[2] eq $filename } @dl;
5545 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
5546 return unless $dirent->[1];
5547 return $self->{UPLOAD_DATE} = $dirent->[1];
5550 #-> sub CPAN::Distribution::uptodate ;
5554 foreach $c ($self->containsmods) {
5555 my $obj = CPAN::Shell->expandany($c);
5556 unless ($obj->uptodate){
5557 my $id = $self->pretty_id;
5558 $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG;
5565 #-> sub CPAN::Distribution::called_for ;
5568 $self->{CALLED_FOR} = $id if defined $id;
5569 return $self->{CALLED_FOR};
5572 #-> sub CPAN::Distribution::get ;
5575 $self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
5576 if (my $goto = $self->prefs->{goto}) {
5577 $CPAN::Frontend->mywarn
5579 "delegating to '%s' as specified in prefs file '%s' doc %d\n",
5581 $self->{prefs_file},
5582 $self->{prefs_file_doc},
5584 return $self->goto($goto);
5586 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
5588 : ($ENV{PERLLIB} || "");
5590 $CPAN::META->set_perl5lib;
5591 local $ENV{MAKEFLAGS}; # protect us from outer make calls
5595 $self->debug("checking disabled id[$self->{ID}]") if $CPAN::DEBUG;
5596 if ($self->prefs->{disabled}) {
5598 "Disabled via prefs file '%s' doc %d",
5599 $self->{prefs_file},
5600 $self->{prefs_file_doc},
5603 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $why");
5604 # note: not intended to be persistent but at least visible
5605 # during this session
5607 if (exists $self->{build_dir}) {
5608 # this deserves print, not warn:
5609 $CPAN::Frontend->myprint(" Has already been unwrapped into directory ".
5610 "$self->{build_dir}\n"
5615 # although we talk about 'force' we shall not test on
5616 # force directly. New model of force tries to refrain from
5617 # direct checking of force.
5618 exists $self->{unwrapped} and (
5619 UNIVERSAL::can($self->{unwrapped},"failed") ?
5620 $self->{unwrapped}->failed :
5621 $self->{unwrapped} =~ /^NO/
5623 and push @e, "Unwrapping had some problem, won't try again without force";
5626 $CPAN::Frontend->mywarn(join "", map {"$_\n"} @e) and return if @e;
5628 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
5631 # Get the file on local disk
5636 File::Spec->catfile(
5637 $CPAN::Config->{keep_source_where},
5640 split(/\//,$self->id)
5643 $self->debug("Doing localize") if $CPAN::DEBUG;
5644 unless ($local_file =
5645 CPAN::FTP->localize("authors/id/$self->{ID}",
5648 if ($CPAN::Index::DATE_OF_02) {
5649 $note = "Note: Current database in memory was generated ".
5650 "on $CPAN::Index::DATE_OF_02\n";
5652 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
5655 $self->debug("local_wanted[$local_wanted]local_file[$local_file]") if $CPAN::DEBUG;
5656 $self->{localfile} = $local_file;
5657 return if $CPAN::Signal;
5662 if ($CPAN::META->has_inst("Digest::SHA")) {
5663 $self->debug("Digest::SHA is installed, verifying");
5664 $self->verifyCHECKSUM;
5666 $self->debug("Digest::SHA is NOT installed");
5668 return if $CPAN::Signal;
5671 # Create a clean room and go there
5673 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
5674 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
5675 $self->safe_chdir($builddir);
5676 $self->debug("Removing tmp-$$") if $CPAN::DEBUG;
5677 File::Path::rmtree("tmp-$$");
5678 unless (mkdir "tmp-$$", 0755) {
5679 $CPAN::Frontend->unrecoverable_error(<<EOF);
5680 Couldn't mkdir '$builddir/tmp-$$': $!
5682 Cannot continue: Please find the reason why I cannot make the
5685 and fix the problem, then retry.
5690 $self->safe_chdir($sub_wd);
5693 $self->safe_chdir("tmp-$$");
5698 my $ct = eval{CPAN::Tarzip->new($local_file)};
5700 $self->{unwrapped} = CPAN::Distrostatus->new("NO");
5701 delete $self->{build_dir};
5704 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
5705 $self->{was_uncompressed}++ unless eval{$ct->gtest()};
5706 $self->untar_me($ct);
5707 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
5708 $self->unzip_me($ct);
5710 $self->{was_uncompressed}++ unless $ct->gtest();
5711 $local_file = $self->handle_singlefile($local_file);
5713 # $self->{archived} = "NO";
5714 # $self->safe_chdir($sub_wd);
5718 # we are still in the tmp directory!
5719 # Let's check if the package has its own directory.
5720 my $dh = DirHandle->new(File::Spec->curdir)
5721 or Carp::croak("Couldn't opendir .: $!");
5722 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
5725 # XXX here we want in each branch File::Temp to protect all build_dir directories
5726 if (CPAN->has_inst("File::Temp")) {
5730 if (@readdir == 1 && -d $readdir[0]) {
5731 $tdir_base = $readdir[0];
5732 $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]);
5733 my $dh2 = DirHandle->new($from_dir)
5734 or Carp::croak("Couldn't opendir $from_dir: $!");
5735 @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC??
5737 my $userid = $self->cpan_userid;
5738 CPAN->debug("userid[$userid]");
5739 if (!$userid or $userid eq "N/A") {
5742 $tdir_base = $userid;
5743 $from_dir = File::Spec->curdir;
5744 @dirents = @readdir;
5746 $packagedir = File::Temp::tempdir(
5747 "$tdir_base-XXXXXX",
5752 for $f (@dirents) { # is already without "." and ".."
5753 my $from = File::Spec->catdir($from_dir,$f);
5754 my $to = File::Spec->catdir($packagedir,$f);
5755 unless (File::Copy::move($from,$to)) {
5757 $from = File::Spec->rel2abs($from);
5758 Carp::confess("Couldn't move $from to $to: $err");
5761 } else { # older code below, still better than nothing when there is no File::Temp
5763 if (@readdir == 1 && -d $readdir[0]) {
5764 $distdir = $readdir[0];
5765 $packagedir = File::Spec->catdir($builddir,$distdir);
5766 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
5768 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
5770 File::Path::rmtree($packagedir);
5771 unless (File::Copy::move($distdir,$packagedir)) {
5772 $CPAN::Frontend->unrecoverable_error(<<EOF);
5773 Couldn't move '$distdir' to '$packagedir': $!
5775 Cannot continue: Please find the reason why I cannot move
5776 $builddir/tmp-$$/$distdir
5779 and fix the problem, then retry
5783 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
5790 my $userid = $self->cpan_userid;
5791 CPAN->debug("userid[$userid]") if $CPAN::DEBUG;
5792 if (!$userid or $userid eq "N/A") {
5795 my $pragmatic_dir = $userid . '000';
5796 $pragmatic_dir =~ s/\W_//g;
5797 $pragmatic_dir++ while -d "../$pragmatic_dir";
5798 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
5799 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
5800 File::Path::mkpath($packagedir);
5802 for $f (@readdir) { # is already without "." and ".."
5803 my $to = File::Spec->catdir($packagedir,$f);
5804 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
5809 $self->safe_chdir($sub_wd);
5813 $self->{build_dir} = $packagedir;
5814 $self->safe_chdir($builddir);
5815 File::Path::rmtree("tmp-$$");
5817 $self->safe_chdir($packagedir);
5818 $self->_signature_business();
5819 $self->safe_chdir($builddir);
5820 return if $CPAN::Signal;
5823 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
5824 my($mpl_exists) = -f $mpl;
5825 unless ($mpl_exists) {
5826 # NFS has been reported to have racing problems after the
5827 # renaming of a directory in some environments.
5829 $CPAN::Frontend->mysleep(1);
5830 my $mpldh = DirHandle->new($packagedir)
5831 or Carp::croak("Couldn't opendir $packagedir: $!");
5832 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
5835 my $prefer_installer = "eumm"; # eumm|mb
5836 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
5837 if ($mpl_exists) { # they *can* choose
5838 if ($CPAN::META->has_inst("Module::Build")) {
5839 $prefer_installer = CPAN::HandleConfig->prefs_lookup($self,
5840 q{prefer_installer});
5843 $prefer_installer = "mb";
5846 return unless $self->patch;
5847 if (lc($prefer_installer) eq "mb") {
5848 $self->{modulebuild} = 1;
5849 } elsif (! $mpl_exists) {
5850 $self->_edge_cases($mpl,$packagedir,$local_file);
5852 if ($self->{build_dir}
5854 $CPAN::Config->{build_dir_reuse}
5856 $self->store_persistent_state;
5862 #-> CPAN::Distribution::store_persistent_state
5863 sub store_persistent_state {
5865 my $dir = $self->{build_dir};
5866 unless (File::Spec->canonpath(File::Basename::dirname($dir))
5867 eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
5868 $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
5869 "will not store persistent state\n");
5872 my $file = sprintf "%s.yml", $dir;
5873 my $yaml_module = CPAN::_yaml_module;
5874 if ($CPAN::META->has_inst($yaml_module)) {
5875 CPAN->_yaml_dumpfile(
5879 perl => CPAN::_perl_fingerprint,
5880 distribution => $self,
5884 $CPAN::Frontend->myprint("Warning (usually harmless): '$yaml_module' not installed, ".
5885 "will not store persistent state\n");
5889 #-> CPAN::Distribution::patch
5891 my($self,$patch) = @_;
5892 my $norm = $self->normalize($patch);
5894 File::Spec->catfile(
5895 $CPAN::Config->{keep_source_where},
5900 $self->debug("Doing localize") if $CPAN::DEBUG;
5901 return CPAN::FTP->localize("authors/id/$norm",
5905 #-> CPAN::Distribution::patch
5908 $self->debug("checking patches id[$self->{ID}]") if $CPAN::DEBUG;
5909 my $patches = $self->prefs->{patches};
5911 $self->debug("patches[$patches]") if $CPAN::DEBUG;
5913 return unless @$patches;
5914 $self->safe_chdir($self->{build_dir});
5915 CPAN->debug("patches[$patches]") if $CPAN::DEBUG;
5916 my $patchbin = $CPAN::Config->{patch};
5917 unless ($patchbin && length $patchbin) {
5918 $CPAN::Frontend->mydie("No external patch command configured\n\n".
5919 "Please run 'o conf init /patch/'\n\n");
5921 unless (MM->maybe_command($patchbin)) {
5922 $CPAN::Frontend->mydie("No external patch command available\n\n".
5923 "Please run 'o conf init /patch/'\n\n");
5925 $patchbin = CPAN::HandleConfig->safe_quote($patchbin);
5926 local $ENV{PATCH_GET} = 0; # shall replace -g0 which is not
5927 # supported everywhere (and then,
5928 # not ever necessary there)
5929 my $stdpatchargs = "-N --fuzz=3";
5930 my $countedpatches = @$patches == 1 ? "1 patch" : (scalar @$patches . " patches");
5931 $CPAN::Frontend->myprint("Going to apply $countedpatches:\n");
5932 for my $patch (@$patches) {
5933 unless (-f $patch) {
5934 if (my $trydl = $self->try_download($patch)) {
5937 my $fail = "Could not find patch '$patch'";
5938 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5939 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5940 delete $self->{build_dir};
5944 $CPAN::Frontend->myprint(" $patch\n");
5945 my $readfh = CPAN::Tarzip->TIEHANDLE($patch);
5948 my $ppp = $self->_patch_p_parameter($readfh);
5949 if ($ppp eq "applypatch") {
5950 $pcommand = "$CPAN::Config->{applypatch} -verbose";
5952 my $thispatchargs = join " ", $stdpatchargs, $ppp;
5953 $pcommand = "$patchbin $thispatchargs";
5956 $readfh = CPAN::Tarzip->TIEHANDLE($patch); # open again
5957 my $writefh = FileHandle->new;
5958 $CPAN::Frontend->myprint(" $pcommand\n");
5959 unless (open $writefh, "|$pcommand") {
5960 my $fail = "Could not fork '$pcommand'";
5961 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5962 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5963 delete $self->{build_dir};
5966 while (my $x = $readfh->READLINE) {
5969 unless (close $writefh) {
5970 my $fail = "Could not apply patch '$patch'";
5971 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5972 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5973 delete $self->{build_dir};
5982 sub _patch_p_parameter {
5985 my $cnt_p0files = 0;
5987 while ($_ = $fh->READLINE) {
5989 $CPAN::Config->{applypatch}
5991 /\#\#\#\# ApplyPatch data follows \#\#\#\#/
5995 next unless /^[\*\+]{3}\s(\S+)/;
5998 $cnt_p0files++ if -f $file;
5999 CPAN->debug("file[$file]cnt_files[$cnt_files]cnt_p0files[$cnt_p0files]")
6002 return "-p1" unless $cnt_files;
6003 return $cnt_files==$cnt_p0files ? "-p0" : "-p1";
6006 #-> sub CPAN::Distribution::_edge_cases
6007 # with "configure" or "Makefile" or single file scripts
6009 my($self,$mpl,$packagedir,$local_file) = @_;
6010 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
6014 my($configure) = File::Spec->catfile($packagedir,"Configure");
6015 if (-f $configure) {
6016 # do we have anything to do?
6017 $self->{configure} = $configure;
6018 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
6019 $CPAN::Frontend->mywarn(qq{
6020 Package comes with a Makefile and without a Makefile.PL.
6021 We\'ll try to build it with that Makefile then.
6023 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
6024 $CPAN::Frontend->mysleep(2);
6026 my $cf = $self->called_for || "unknown";
6031 $cf =~ s|[/\\:]||g; # risk of filesystem damage
6032 $cf = "unknown" unless length($cf);
6033 $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
6034 (The test -f "$mpl" returned false.)
6035 Writing one on our own (setting NAME to $cf)\a\n});
6036 $self->{had_no_makefile_pl}++;
6037 $CPAN::Frontend->mysleep(3);
6039 # Writing our own Makefile.PL
6042 if ($self->{archived} eq "maybe_pl") {
6043 my $fh = FileHandle->new;
6044 my $script_file = File::Spec->catfile($packagedir,$local_file);
6045 $fh->open($script_file)
6046 or Carp::croak("Could not open $script_file: $!");
6048 # name parsen und prereq
6049 my($state) = "poddir";
6050 my($name, $prereq) = ("", "");
6052 if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
6055 } elsif ($1 eq 'PREREQUISITES') {
6058 } elsif ($state =~ m{^(name|prereq)$}) {
6063 } elsif ($state eq "name") {
6068 } elsif ($state eq "prereq") {
6071 } elsif (/^=cut\b/) {
6078 s{.*<}{}; # strip X<...>
6082 $prereq = join " ", split /\s+/, $prereq;
6083 my($PREREQ_PM) = join("\n", map {
6084 s{.*<}{}; # strip X<...>
6086 if (/[\s\'\"]/) { # prose?
6088 s/[^\w:]$//; # period?
6089 " "x28 . "'$_' => 0,";
6091 } split /\s*,\s*/, $prereq);
6094 EXE_FILES => ['$name'],
6100 my $to_file = File::Spec->catfile($packagedir, $name);
6101 rename $script_file, $to_file
6102 or die "Can't rename $script_file to $to_file: $!";
6106 my $fh = FileHandle->new;
6108 or Carp::croak("Could not open >$mpl: $!");
6110 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
6111 # because there was no Makefile.PL supplied.
6112 # Autogenerated on: }.scalar localtime().qq{
6114 use ExtUtils::MakeMaker;
6116 NAME => q[$cf],$script
6123 #-> CPAN::Distribution::_signature_business
6124 sub _signature_business {
6126 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
6129 if ($CPAN::META->has_inst("Module::Signature")) {
6130 if (-f "SIGNATURE") {
6131 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
6132 my $rv = Module::Signature::verify();
6133 if ($rv != Module::Signature::SIGNATURE_OK() and
6134 $rv != Module::Signature::SIGNATURE_MISSING()) {
6135 $CPAN::Frontend->mywarn(
6136 qq{\nSignature invalid for }.
6137 qq{distribution file. }.
6138 qq{Please investigate.\n\n}
6142 sprintf(qq{I'd recommend removing %s. Its signature
6143 is invalid. Maybe you have configured your 'urllist' with
6144 a bad URL. Please check this array with 'o conf urllist', and
6145 retry. For more information, try opening a subshell with
6153 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
6154 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
6155 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
6157 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
6158 $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
6161 $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n});
6164 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
6169 #-> CPAN::Distribution::untar_me ;
6172 $self->{archived} = "tar";
6174 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6176 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- untar failed");
6180 # CPAN::Distribution::unzip_me ;
6183 $self->{archived} = "zip";
6185 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6187 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- unzip failed");
6192 sub handle_singlefile {
6193 my($self,$local_file) = @_;
6195 if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ){
6196 $self->{archived} = "pm";
6198 $self->{archived} = "maybe_pl";
6201 my $to = File::Basename::basename($local_file);
6202 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
6203 if (eval{CPAN::Tarzip->new($local_file)->gunzip($to)}) {
6204 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6206 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- uncompressing failed");
6209 File::Copy::cp($local_file,".");
6210 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- copying failed");
6215 #-> sub CPAN::Distribution::new ;
6217 my($class,%att) = @_;
6219 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
6221 my $this = { %att };
6222 return bless $this, $class;
6225 #-> sub CPAN::Distribution::look ;
6229 if ($^O eq 'MacOS') {
6230 $self->Mac::BuildTools::look;
6234 if ( $CPAN::Config->{'shell'} ) {
6235 $CPAN::Frontend->myprint(qq{
6236 Trying to open a subshell in the build directory...
6239 $CPAN::Frontend->myprint(qq{
6240 Your configuration does not define a value for subshells.
6241 Please define it with "o conf shell <your shell>"
6245 my $dist = $self->id;
6247 unless ($dir = $self->dir) {
6250 unless ($dir ||= $self->dir) {
6251 $CPAN::Frontend->mywarn(qq{
6252 Could not determine which directory to use for looking at $dist.
6256 my $pwd = CPAN::anycwd();
6257 $self->safe_chdir($dir);
6258 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
6260 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
6261 $ENV{CPAN_SHELL_LEVEL} += 1;
6262 my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
6263 unless (system($shell) == 0) {
6265 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
6268 $self->safe_chdir($pwd);
6271 # CPAN::Distribution::cvs_import ;
6275 my $dir = $self->dir;
6277 my $package = $self->called_for;
6278 my $module = $CPAN::META->instance('CPAN::Module', $package);
6279 my $version = $module->cpan_version;
6281 my $userid = $self->cpan_userid;
6283 my $cvs_dir = (split /\//, $dir)[-1];
6284 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
6286 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
6288 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
6289 if ($cvs_site_perl) {
6290 $cvs_dir = "$cvs_site_perl/$cvs_dir";
6292 my $cvs_log = qq{"imported $package $version sources"};
6293 $version =~ s/\./_/g;
6294 # XXX cvs: undocumented and unclear how it was meant to work
6295 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
6296 "$cvs_dir", $userid, "v$version");
6298 my $pwd = CPAN::anycwd();
6299 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
6301 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
6303 $CPAN::Frontend->myprint(qq{@cmd\n});
6304 system(@cmd) == 0 or
6306 $CPAN::Frontend->mydie("cvs import failed");
6307 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
6310 #-> sub CPAN::Distribution::readme ;
6313 my($dist) = $self->id;
6314 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
6315 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
6318 File::Spec->catfile(
6319 $CPAN::Config->{keep_source_where},
6322 split(/\//,"$sans.readme"),
6324 $self->debug("Doing localize") if $CPAN::DEBUG;
6325 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
6327 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
6329 if ($^O eq 'MacOS') {
6330 Mac::BuildTools::launch_file($local_file);
6334 my $fh_pager = FileHandle->new;
6335 local($SIG{PIPE}) = "IGNORE";
6336 my $pager = $CPAN::Config->{'pager'} || "cat";
6337 $fh_pager->open("|$pager")
6338 or die "Could not open pager $pager\: $!";
6339 my $fh_readme = FileHandle->new;
6340 $fh_readme->open($local_file)
6341 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
6342 $CPAN::Frontend->myprint(qq{
6347 $fh_pager->print(<$fh_readme>);
6351 #-> sub CPAN::Distribution::verifyCHECKSUM ;
6352 sub verifyCHECKSUM {
6356 $self->{CHECKSUM_STATUS} ||= "";
6357 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
6358 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6360 my($lc_want,$lc_file,@local,$basename);
6361 @local = split(/\//,$self->id);
6363 push @local, "CHECKSUMS";
6365 File::Spec->catfile($CPAN::Config->{keep_source_where},
6366 "authors", "id", @local);
6368 if (my $size = -s $lc_want) {
6369 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
6370 if ($self->CHECKSUM_check_file($lc_want,1)) {
6371 return $self->{CHECKSUM_STATUS} = "OK";
6374 $lc_file = CPAN::FTP->localize("authors/id/@local",
6377 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
6378 $local[-1] .= ".gz";
6379 $lc_file = CPAN::FTP->localize("authors/id/@local",
6382 $lc_file =~ s/\.gz(?!\n)\Z//;
6383 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
6388 if ($self->CHECKSUM_check_file($lc_file)) {
6389 return $self->{CHECKSUM_STATUS} = "OK";
6393 #-> sub CPAN::Distribution::SIG_check_file ;
6394 sub SIG_check_file {
6395 my($self,$chk_file) = @_;
6396 my $rv = eval { Module::Signature::_verify($chk_file) };
6398 if ($rv == Module::Signature::SIGNATURE_OK()) {
6399 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
6400 return $self->{SIG_STATUS} = "OK";
6402 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
6403 qq{distribution file. }.
6404 qq{Please investigate.\n\n}.
6406 $CPAN::META->instance(
6411 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
6412 is invalid. Maybe you have configured your 'urllist' with
6413 a bad URL. Please check this array with 'o conf urllist', and
6416 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
6420 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
6422 # sloppy is 1 when we have an old checksums file that maybe is good
6425 sub CHECKSUM_check_file {
6426 my($self,$chk_file,$sloppy) = @_;
6427 my($cksum,$file,$basename);
6430 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
6431 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
6434 if ($CPAN::META->has_inst("Module::Signature")) {
6435 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
6436 $self->SIG_check_file($chk_file);
6438 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
6442 $file = $self->{localfile};
6443 $basename = File::Basename::basename($file);
6444 my $fh = FileHandle->new;
6445 if (open $fh, $chk_file){
6448 $eval =~ s/\015?\012/\n/g;
6450 my($comp) = Safe->new();
6451 $cksum = $comp->reval($eval);
6453 rename $chk_file, "$chk_file.bad";
6454 Carp::confess($@) if $@;
6457 Carp::carp "Could not open $chk_file for reading";
6460 if (! ref $cksum or ref $cksum ne "HASH") {
6461 $CPAN::Frontend->mywarn(qq{
6462 Warning: checksum file '$chk_file' broken.
6464 When trying to read that file I expected to get a hash reference
6465 for further processing, but got garbage instead.
6467 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
6468 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
6469 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
6471 } elsif (exists $cksum->{$basename}{sha256}) {
6472 $self->debug("Found checksum for $basename:" .
6473 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
6477 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
6479 $fh = CPAN::Tarzip->TIEHANDLE($file);
6482 my $dg = Digest::SHA->new(256);
6485 while ($fh->READ($ref, 4096) > 0){
6488 my $hexdigest = $dg->hexdigest;
6489 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
6493 $CPAN::Frontend->myprint("Checksum for $file ok\n");
6494 return $self->{CHECKSUM_STATUS} = "OK";
6496 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
6497 qq{distribution file. }.
6498 qq{Please investigate.\n\n}.
6500 $CPAN::META->instance(
6505 my $wrap = qq{I\'d recommend removing $file. Its
6506 checksum is incorrect. Maybe you have configured your 'urllist' with
6507 a bad URL. Please check this array with 'o conf urllist', and
6510 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
6512 # former versions just returned here but this seems a
6513 # serious threat that deserves a die
6515 # $CPAN::Frontend->myprint("\n\n");
6519 # close $fh if fileno($fh);
6522 unless ($self->{CHECKSUM_STATUS}) {
6523 $CPAN::Frontend->mywarn(qq{
6524 Warning: No checksum for $basename in $chk_file.
6526 The cause for this may be that the file is very new and the checksum
6527 has not yet been calculated, but it may also be that something is
6528 going awry right now.
6530 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes");
6531 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
6533 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
6538 #-> sub CPAN::Distribution::eq_CHECKSUM ;
6540 my($self,$fh,$expect) = @_;
6541 if ($CPAN::META->has_inst("Digest::SHA")) {
6542 my $dg = Digest::SHA->new(256);
6544 while (read($fh, $data, 4096)){
6547 my $hexdigest = $dg->hexdigest;
6548 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
6549 return $hexdigest eq $expect;
6554 #-> sub CPAN::Distribution::force ;
6556 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
6557 # effect by autoinspection, not by inspecting a global variable. One
6558 # of the reason why this was chosen to work that way was the treatment
6559 # of dependencies. They should not automatically inherit the force
6560 # status. But this has the downside that ^C and die() will return to
6561 # the prompt but will not be able to reset the force_update
6562 # attributes. We try to correct for it currently in the read_metadata
6563 # routine, and immediately before we check for a Signal. I hope this
6564 # works out in one of v1.57_53ff
6566 # "Force get forgets previous error conditions"
6568 #-> sub CPAN::Distribution::fforce ;
6570 my($self, $method) = @_;
6571 $self->force($method,1);
6574 #-> sub CPAN::Distribution::force ;
6576 my($self, $method,$fforce) = @_;
6594 "prereq_pm_detected",
6608 my $methodmatch = 0;
6610 PHASE: for my $phase (qw(unknown get make test install)) { # order matters
6611 $methodmatch = 1 if $fforce || $phase eq $method;
6612 next unless $methodmatch;
6613 ATTRIBUTE: for my $att (@{$phase_map{$phase}}) {
6614 if ($phase eq "get") {
6615 if (substr($self->id,-1,1) eq "."
6616 && $att =~ /(unwrapped|build_dir|archived)/ ) {
6617 # cannot be undone for local distros
6620 if ($att eq "build_dir"
6621 && $self->{build_dir}
6622 && $CPAN::META->{is_tested}
6624 delete $CPAN::META->{is_tested}{$self->{build_dir}};
6626 } elsif ($phase eq "test") {
6627 if ($att eq "make_test"
6628 && $self->{make_test}
6629 && $self->{make_test}{COMMANDID}
6630 && $self->{make_test}{COMMANDID} == $CPAN::CurrentCommandId
6632 # endless loop too likely
6636 delete $self->{$att};
6637 if ($ldebug || $CPAN::DEBUG) {
6638 # local $CPAN::DEBUG = 16; # Distribution
6639 CPAN->debug(sprintf "id[%s]phase[%s]att[%s]", $self->id, $phase, $att);
6643 if ($method && $method =~ /make|test|install/) {
6644 $self->{force_update} = 1; # name should probably have been force_install
6648 #-> sub CPAN::Distribution::notest ;
6650 my($self, $method) = @_;
6651 # warn "XDEBUG: set notest for $self $method";
6652 $self->{"notest"}++; # name should probably have been force_install
6655 #-> sub CPAN::Distribution::unnotest ;
6658 # warn "XDEBUG: deleting notest";
6659 delete $self->{'notest'};
6662 #-> sub CPAN::Distribution::unforce ;
6665 delete $self->{force_update};
6668 #-> sub CPAN::Distribution::isa_perl ;
6671 my $file = File::Basename::basename($self->id);
6672 if ($file =~ m{ ^ perl
6681 \.tar[._-](?:gz|bz2)
6685 } elsif ($self->cpan_comment
6687 $self->cpan_comment =~ /isa_perl\(.+?\)/){
6693 #-> sub CPAN::Distribution::perl ;
6698 carp __PACKAGE__ . "::perl was called without parameters.";
6700 return CPAN::HandleConfig->safe_quote($CPAN::Perl);
6704 #-> sub CPAN::Distribution::make ;
6707 if (my $goto = $self->prefs->{goto}) {
6708 return $self->goto($goto);
6710 my $make = $self->{modulebuild} ? "Build" : "make";
6711 # Emergency brake if they said install Pippi and get newest perl
6712 if ($self->isa_perl) {
6714 $self->called_for ne $self->id &&
6715 ! $self->{force_update}
6717 # if we die here, we break bundles
6720 qq{The most recent version "%s" of the module "%s"
6721 is part of the perl-%s distribution. To install that, you need to run
6722 force install %s --or--
6725 $CPAN::META->instance(
6734 $self->{make} = CPAN::Distrostatus->new("NO isa perl");
6735 $CPAN::Frontend->mysleep(1);
6739 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
6741 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
6743 : ($ENV{PERLLIB} || "");
6744 $CPAN::META->set_perl5lib;
6745 local $ENV{MAKEFLAGS}; # protect us from outer make calls
6748 delete $self->{force_update};
6755 if (!$self->{archived} || $self->{archived} eq "NO") {
6756 push @e, "Is neither a tar nor a zip archive.";
6759 if (!$self->{unwrapped}
6761 UNIVERSAL::can($self->{unwrapped},"failed") ?
6762 $self->{unwrapped}->failed :
6763 $self->{unwrapped} =~ /^NO/
6765 push @e, "Had problems unarchiving. Please build manually";
6768 unless ($self->{force_update}) {
6769 exists $self->{signature_verify} and
6771 UNIVERSAL::can($self->{signature_verify},"failed") ?
6772 $self->{signature_verify}->failed :
6773 $self->{signature_verify} =~ /^NO/
6775 and push @e, "Did not pass the signature test.";
6778 if (exists $self->{writemakefile} &&
6780 UNIVERSAL::can($self->{writemakefile},"failed") ?
6781 $self->{writemakefile}->failed :
6782 $self->{writemakefile} =~ /^NO/
6784 # XXX maybe a retry would be in order?
6785 my $err = UNIVERSAL::can($self->{writemakefile},"text") ?
6786 $self->{writemakefile}->text :
6787 $self->{writemakefile};
6789 $err ||= "Had some problem writing Makefile";
6790 $err .= ", won't make";
6794 defined $self->{make} and push @e,
6795 "Has already been made";
6797 if (exists $self->{later} and length($self->{later})) {
6798 if ($self->unsat_prereq) {
6799 push @e, $self->{later};
6800 # RT ticket 18438 raises doubts if the deletion of {later} is valid.
6801 # YAML-0.53 triggered the later hodge-podge here, but my margin notes
6802 # are not sufficient to be sure if we really must/may do the delete
6803 # here. SO I accept the suggested patch for now. If we trigger a bug
6804 # again, I must go into deep contemplation about the {later} flag.
6807 # delete $self->{later};
6811 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6812 $builddir = $self->dir or
6813 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
6814 unless (chdir $builddir) {
6815 push @e, "Couldn't chdir to '$builddir': $!";
6817 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
6820 delete $self->{force_update};
6823 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
6824 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
6826 if ($^O eq 'MacOS') {
6827 Mac::BuildTools::make($self);
6832 while (my($k,$v) = each %ENV) {
6833 next unless defined $v;
6838 if (my $commandline = $self->prefs->{pl}{commandline}) {
6839 $system = $commandline;
6841 } elsif ($self->{'configure'}) {
6842 $system = $self->{'configure'};
6843 } elsif ($self->{modulebuild}) {
6844 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
6845 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
6847 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
6849 # This needs a handler that can be turned on or off:
6850 # $switch = "-MExtUtils::MakeMaker ".
6851 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
6853 my $makepl_arg = $self->make_x_arg("pl");
6854 $system = sprintf("%s%s Makefile.PL%s",
6856 $switch ? " $switch" : "",
6857 $makepl_arg ? " $makepl_arg" : "",
6860 if (my $env = $self->prefs->{pl}{env}) {
6861 for my $e (keys %$env) {
6862 $ENV{$e} = $env->{$e};
6865 if (exists $self->{writemakefile}) {
6867 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
6871 if ($CPAN::Config->{inactivity_timeout}) {
6873 if ($Config::Config{d_alarm}
6875 $Config::Config{d_alarm} eq "define"
6879 $CPAN::Frontend->mywarn("Warning: you have configured the config ".
6880 "variable 'inactivity_timeout' to ".
6881 "'$CPAN::Config->{inactivity_timeout}'. But ".
6882 "on this machine the system call 'alarm' ".
6883 "isn't available. This means that we cannot ".
6884 "provide the feature of intercepting long ".
6885 "waiting code and will turn this feature off.\n"
6887 $CPAN::Config->{inactivity_timeout} = 0;
6890 if ($go_via_alarm) {
6892 alarm $CPAN::Config->{inactivity_timeout};
6893 local $SIG{CHLD}; # = sub { wait };
6894 if (defined($pid = fork)) {
6899 # note, this exec isn't necessary if
6900 # inactivity_timeout is 0. On the Mac I'd
6901 # suggest, we set it always to 0.
6905 $CPAN::Frontend->myprint("Cannot fork: $!");
6914 $CPAN::Frontend->myprint($err);
6915 $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
6920 if (my $expect_model = $self->_prefs_with_expect("pl")) {
6921 $ret = $self->_run_via_expect($system,$expect_model);
6923 && $self->{writemakefile}
6924 && $self->{writemakefile}->failed) {
6929 $ret = system($system);
6932 $self->{writemakefile} = CPAN::Distrostatus
6933 ->new("NO '$system' returned status $ret");
6934 $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
6935 $self->store_persistent_state;
6936 $self->store_persistent_state;
6940 if (-f "Makefile" || -f "Build") {
6941 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
6942 delete $self->{make_clean}; # if cleaned before, enable next
6944 $self->{writemakefile} = CPAN::Distrostatus
6945 ->new(qq{NO -- Unknown reason});
6949 delete $self->{force_update};
6952 if (my @prereq = $self->unsat_prereq){
6953 if ($prereq[0][0] eq "perl") {
6954 my $need = "requires perl '$prereq[0][1]'";
6955 my $id = $self->pretty_id;
6956 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
6957 $self->{make} = CPAN::Distrostatus->new("NO $need");
6958 $self->store_persistent_state;
6961 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
6965 delete $self->{force_update};
6968 if (my $commandline = $self->prefs->{make}{commandline}) {
6969 $system = $commandline;
6972 if ($self->{modulebuild}) {
6973 unless (-f "Build") {
6974 my $cwd = CPAN::anycwd();
6975 $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'".
6976 " in cwd[$cwd]. Danger, Will Robinson!");
6977 $CPAN::Frontend->mysleep(5);
6979 $system = join " ", $self->_build_command(), $CPAN::Config->{mbuild_arg};
6981 $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
6983 $system =~ s/\s+$//;
6984 my $make_arg = $self->make_x_arg("make");
6985 $system = sprintf("%s%s",
6987 $make_arg ? " $make_arg" : "",
6990 if (my $env = $self->prefs->{make}{env}) { # overriding the local
6991 # ENV of PL, not the
6993 # unlikely to be a risk
6994 for my $e (keys %$env) {
6995 $ENV{$e} = $env->{$e};
6998 my $expect_model = $self->_prefs_with_expect("make");
6999 my $want_expect = 0;
7000 if ( $expect_model && @{$expect_model->{talk}} ) {
7001 my $can_expect = $CPAN::META->has_inst("Expect");
7005 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
7011 $system_ok = $self->_run_via_expect($system,$expect_model) == 0;
7013 $system_ok = system($system) == 0;
7015 $self->introduce_myself;
7017 $CPAN::Frontend->myprint(" $system -- OK\n");
7018 $self->{make} = CPAN::Distrostatus->new("YES");
7020 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
7021 $self->{make} = CPAN::Distrostatus->new("NO");
7022 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
7024 $self->store_persistent_state;
7027 # CPAN::Distribution::_run_via_expect
7028 sub _run_via_expect {
7029 my($self,$system,$expect_model) = @_;
7030 CPAN->debug("system[$system]expect_model[$expect_model]") if $CPAN::DEBUG;
7031 if ($CPAN::META->has_inst("Expect")) {
7032 my $expo = Expect->new; # expo Expect object;
7033 $expo->spawn($system);
7034 $expect_model->{mode} ||= "deterministic";
7035 if ($expect_model->{mode} eq "deterministic") {
7036 return $self->_run_via_expect_deterministic($expo,$expect_model);
7037 } elsif ($expect_model->{mode} eq "anyorder") {
7038 return $self->_run_via_expect_anyorder($expo,$expect_model);
7040 die "Panic: Illegal expect mode: $expect_model->{mode}";
7043 $CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n");
7044 return system($system);
7048 sub _run_via_expect_anyorder {
7049 my($self,$expo,$expect_model) = @_;
7050 my $timeout = $expect_model->{timeout} || 5;
7051 my @expectacopy = @{$expect_model->{talk}}; # we trash it!
7054 my($eof,$ran_into_timeout);
7055 my @match = $expo->expect($timeout,
7060 $ran_into_timeout++;
7067 $but .= $expo->clear_accum;
7070 return $expo->exitstatus();
7071 } elsif ($ran_into_timeout) {
7072 # warn "DEBUG: they are asking a question, but[$but]";
7073 for (my $i = 0; $i <= $#expectacopy; $i+=2) {
7074 my($next,$send) = @expectacopy[$i,$i+1];
7075 my $regex = eval "qr{$next}";
7076 # warn "DEBUG: will compare with regex[$regex].";
7077 if ($but =~ /$regex/) {
7078 # warn "DEBUG: will send send[$send]";
7080 splice @expectacopy, $i, 2; # never allow reusing an QA pair
7084 my $why = "could not answer a question during the dialog";
7085 $CPAN::Frontend->mywarn("Failing: $why\n");
7086 $self->{writemakefile} =
7087 CPAN::Distrostatus->new("NO $why");
7093 sub _run_via_expect_deterministic {
7094 my($self,$expo,$expect_model) = @_;
7095 my $ran_into_timeout;
7096 my $timeout = $expect_model->{timeout} || 15; # currently unsettable
7097 my $expecta = $expect_model->{talk};
7098 EXPECT: for (my $i = 0; $i <= $#$expecta; $i+=2) {
7099 my($re,$send) = @$expecta[$i,$i+1];
7100 CPAN->debug("timeout[$timeout]re[$re]") if $CPAN::DEBUG;
7101 my $regex = eval "qr{$re}";
7102 $expo->expect($timeout,
7104 my $but = $expo->clear_accum;
7105 $CPAN::Frontend->mywarn("EOF (maybe harmless)
7106 expected[$regex]\nbut[$but]\n\n");
7110 my $but = $expo->clear_accum;
7111 $CPAN::Frontend->mywarn("TIMEOUT
7112 expected[$regex]\nbut[$but]\n\n");
7113 $ran_into_timeout++;
7116 if ($ran_into_timeout){
7117 # note that the caller expects 0 for success
7118 $self->{writemakefile} =
7119 CPAN::Distrostatus->new("NO timeout during expect dialog");
7125 return $expo->exitstatus();
7128 #-> CPAN::Distribution::_validate_distropref
7129 sub _validate_distropref {
7130 my($self,@args) = @_;
7132 $CPAN::META->has_inst("CPAN::Kwalify")
7134 $CPAN::META->has_inst("Kwalify")
7136 eval {CPAN::Kwalify::_validate("distroprefs",@args);};
7138 $CPAN::Frontend->mywarn($@);
7141 CPAN->debug("not validating '@args'") if $CPAN::DEBUG;
7145 #-> CPAN::Distribution::_find_prefs
7148 my $distroid = $self->pretty_id;
7149 #CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
7150 my $prefs_dir = $CPAN::Config->{prefs_dir};
7151 eval { File::Path::mkpath($prefs_dir); };
7153 $CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
7155 my $yaml_module = CPAN::_yaml_module;
7157 if ($CPAN::META->has_inst($yaml_module)) {
7158 push @extensions, "yml";
7161 if ($CPAN::META->has_inst("Data::Dumper")) {
7162 push @extensions, "dd";
7163 push @fallbacks, "Data::Dumper";
7165 if ($CPAN::META->has_inst("Storable")) {
7166 push @extensions, "st";
7167 push @fallbacks, "Storable";
7171 unless ($self->{have_complained_about_missing_yaml}++) {
7172 $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back ".
7173 "to @fallbacks to read prefs '$prefs_dir'\n");
7176 unless ($self->{have_complained_about_missing_yaml}++) {
7177 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot ".
7178 "read prefs '$prefs_dir'\n");
7183 my $dh = DirHandle->new($prefs_dir)
7184 or die Carp::croak("Couldn't open '$prefs_dir': $!");
7185 DIRENT: for (sort $dh->read) {
7186 next if $_ eq "." || $_ eq "..";
7187 my $exte = join "|", @extensions;
7188 next unless /\.($exte)$/;
7190 my $abs = File::Spec->catfile($prefs_dir, $_);
7192 #CPAN->debug(sprintf "abs[%s]", $abs) if $CPAN::DEBUG;
7194 if ($thisexte eq "yml") {
7195 # need no eval because if we have no YAML we do not try to read *.yml
7196 #CPAN->debug(sprintf "before yaml load abs[%s]", $abs) if $CPAN::DEBUG;
7197 @distropref = @{CPAN->_yaml_loadfile($abs)};
7198 #CPAN->debug(sprintf "after yaml load abs[%s]", $abs) if $CPAN::DEBUG;
7199 } elsif ($thisexte eq "dd") {
7202 open FH, "<$abs" or $CPAN::Frontend->mydie("Could not open '$abs': $!");
7208 $CPAN::Frontend->mydie("Error in distroprefs file $_\: $@");
7211 while (${"VAR".$i}) {
7212 push @distropref, ${"VAR".$i};
7215 } elsif ($thisexte eq "st") {
7216 # eval because Storable is never forward compatible
7217 eval { @distropref = @{scalar Storable::retrieve($abs)}; };
7219 $CPAN::Frontend->mywarn("Error reading distroprefs file ".
7220 "$_, skipping\: $@");
7221 $CPAN::Frontend->mysleep(4);
7226 #CPAN->debug(sprintf "#distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
7227 ELEMENT: for my $y (0..$#distropref) {
7228 my $distropref = $distropref[$y];
7229 $self->_validate_distropref($distropref,$abs,$y);
7230 my $match = $distropref->{match};
7232 #CPAN->debug("no 'match' in abs[$abs], skipping") if $CPAN::DEBUG;
7236 # do not take the order of C<keys %$match> because
7237 # "module" is by far the slowest
7238 for my $sub_attribute (qw(distribution perl module)) {
7239 next unless exists $match->{$sub_attribute};
7240 my $qr = eval "qr{$distropref->{match}{$sub_attribute}}";
7241 if ($sub_attribute eq "module") {
7243 #CPAN->debug(sprintf "distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
7244 my @modules = $self->containsmods;
7245 #CPAN->debug(sprintf "modules[%s]", join(",",@modules)) if $CPAN::DEBUG;
7246 MODULE: for my $module (@modules) {
7247 $okm ||= $module =~ /$qr/;
7248 last MODULE if $okm;
7251 } elsif ($sub_attribute eq "distribution") {
7252 my $okd = $distroid =~ /$qr/;
7254 } elsif ($sub_attribute eq "perl") {
7255 my $okp = $^X =~ /$qr/;
7258 $CPAN::Frontend->mydie("Nonconforming .$thisexte file '$abs': ".
7259 "unknown sub_attribut '$sub_attribute'. ".
7261 "remove, cannot continue.");
7263 last if $ok == 0; # short circuit
7265 #CPAN->debug(sprintf "ok[%d]", $ok) if $CPAN::DEBUG;
7268 prefs => $distropref,
7270 prefs_file_doc => $y,
7282 # CPAN::Distribution::prefs
7285 if (exists $self->{negative_prefs_cache}
7287 $self->{negative_prefs_cache} != $CPAN::CurrentCommandId
7289 delete $self->{negative_prefs_cache};
7290 delete $self->{prefs};
7292 if (exists $self->{prefs}) {
7293 return $self->{prefs}; # XXX comment out during debugging
7295 if ($CPAN::Config->{prefs_dir}) {
7296 CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG;
7297 my $prefs = $self->_find_prefs();
7298 $prefs ||= ""; # avoid warning next line
7299 CPAN->debug("prefs[$prefs]") if $CPAN::DEBUG;
7301 for my $x (qw(prefs prefs_file prefs_file_doc)) {
7302 $self->{$x} = $prefs->{$x};
7306 File::Basename::basename($self->{prefs_file}),
7307 $self->{prefs_file_doc},
7309 my $filler1 = "_" x 22;
7310 my $filler2 = int(66 - length($bs))/2;
7311 $filler2 = 0 if $filler2 < 0;
7312 $filler2 = " " x $filler2;
7313 $CPAN::Frontend->myprint("
7314 $filler1 D i s t r o P r e f s $filler1
7315 $filler2 $bs $filler2
7317 $CPAN::Frontend->mysleep(1);
7318 return $self->{prefs};
7321 $self->{negative_prefs_cache} = $CPAN::CurrentCommandId;
7322 return $self->{prefs} = +{};
7325 # CPAN::Distribution::make_x_arg
7327 my($self, $whixh) = @_;
7329 my $prefs = $self->prefs;
7332 && exists $prefs->{$whixh}
7333 && exists $prefs->{$whixh}{args}
7334 && $prefs->{$whixh}{args}
7336 $make_x_arg = join(" ",
7337 map {CPAN::HandleConfig
7338 ->safe_quote($_)} @{$prefs->{$whixh}{args}},
7341 my $what = sprintf "make%s_arg", $whixh eq "make" ? "" : $whixh;
7342 $make_x_arg ||= $CPAN::Config->{$what};
7346 # CPAN::Distribution::_make_command
7353 CPAN::HandleConfig->prefs_lookup($self,
7355 || $Config::Config{make}
7359 # Old style call, without object. Deprecated
7360 Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
7363 CPAN::HandleConfig->prefs_lookup($self,q{make})
7364 || $CPAN::Config->{make}
7365 || $Config::Config{make}
7370 #-> sub CPAN::Distribution::follow_prereqs ;
7371 sub follow_prereqs {
7373 my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_;
7374 return unless @prereq_tuples;
7375 my @prereq = map { $_->[0] } @prereq_tuples;
7376 my $pretty_id = $self->pretty_id;
7378 b => "build_requires",
7382 my($filler1,$filler2,$filler3,$filler4);
7384 my $unsat = "Unsatisfied dependencies detected during";
7385 my $w = length($unsat) > length($pretty_id) ? length($unsat) : length($pretty_id);
7387 my $r = int(($w - length($unsat))/2);
7388 my $l = $w - length($unsat) - $r;
7389 $filler1 = "-"x4 . " "x$l;
7390 $filler2 = " "x$r . "-"x4 . "\n";
7393 my $r = int(($w - length($pretty_id))/2);
7394 my $l = $w - length($pretty_id) - $r;
7395 $filler3 = "-"x4 . " "x$l;
7396 $filler4 = " "x$r . "-"x4 . "\n";
7399 myprint("$filler1 $unsat $filler2".
7400 "$filler3 $pretty_id $filler4".
7401 join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @prereq_tuples),
7404 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
7406 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
7407 my $answer = CPAN::Shell::colorable_makemaker_prompt(
7408 "Shall I follow them and prepend them to the queue
7409 of modules we are processing right now?", "yes");
7410 $follow = $answer =~ /^\s*y/i;
7414 myprint(" Ignoring dependencies on modules @prereq\n");
7418 # color them as dirty
7419 for my $p (@prereq) {
7420 # warn "calling color_cmd_tmps(0,1)";
7421 my $any = CPAN::Shell->expandany($p);
7423 $any->color_cmd_tmps(0,2);
7425 $CPAN::Frontend->mywarn("Warning (maybe a bug): Cannot expand prereq '$p'\n");
7426 $CPAN::Frontend->mysleep(2);
7429 # queue them and re-queue yourself
7430 CPAN::Queue->jumpqueue([$id,$self->{reqtype}],
7431 reverse @prereq_tuples);
7432 $self->{later} = "Delayed until after prerequisites";
7433 return 1; # signal success to the queuerunner
7437 #-> sub CPAN::Distribution::unsat_prereq ;
7438 # return ([Foo=>1],[Bar=>1.2]) for normal modules
7439 # return ([perl=>5.008]) if we need a newer perl than we are running under
7442 my $prereq_pm = $self->prereq_pm or return;
7444 my %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
7445 my @merged = %merged;
7446 CPAN->debug("all merged_prereqs[@merged]") if $CPAN::DEBUG;
7447 NEED: while (my($need_module, $need_version) = each %merged) {
7448 my($available_version,$available_file,$nmo);
7449 if ($need_module eq "perl") {
7450 $available_version = $];
7451 $available_file = $^X;
7453 $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
7454 next if $nmo->uptodate;
7455 $available_file = $nmo->available_file;
7457 # if they have not specified a version, we accept any installed one
7458 if (not defined $need_version or
7459 $need_version == 0 or
7460 $need_version eq "undef") {
7461 next if defined $available_file;
7464 $available_version = $nmo->available_version;
7467 # We only want to install prereqs if either they're not installed
7468 # or if the installed version is too old. We cannot omit this
7469 # check, because if 'force' is in effect, nobody else will check.
7470 if (defined $available_file) {
7471 my(@all_requirements) = split /\s*,\s*/, $need_version;
7474 RQ: for my $rq (@all_requirements) {
7475 if ($rq =~ s|>=\s*||) {
7476 } elsif ($rq =~ s|>\s*||) {
7478 if (CPAN::Version->vgt($available_version,$rq)){
7482 } elsif ($rq =~ s|!=\s*||) {
7484 if (CPAN::Version->vcmp($available_version,$rq)){
7490 } elsif ($rq =~ m|<=?\s*|) {
7492 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])\n");
7496 if (! CPAN::Version->vgt($rq, $available_version)){
7499 CPAN->debug(sprintf("need_module[%s]available_file[%s]".
7500 "available_version[%s]rq[%s]ok[%d]",
7504 CPAN::Version->readable($rq),
7508 next NEED if $ok == @all_requirements;
7511 if ($need_module eq "perl") {
7512 return ["perl", $need_version];
7514 if ($self->{sponsored_mods}{$need_module}++){
7515 # We have already sponsored it and for some reason it's still
7516 # not available. So we do ... what??
7518 # if we push it again, we have a potential infinite loop
7520 # The following "next" was a very problematic construct.
7521 # It helped a lot but broke some day and must be replaced.
7523 # We must be able to deal with modules that come again and
7524 # again as a prereq and have themselves prereqs and the
7525 # queue becomes long but finally we would find the correct
7526 # order. The RecursiveDependency check should trigger a
7527 # die when it's becoming too weird. Unfortunately removing
7528 # this next breaks many other things.
7530 # The bug that brought this up is described in Todo under
7531 # "5.8.9 cannot install Compress::Zlib"
7533 # next; # this is the next that must go away
7535 # The following "next NEED" are fine and the error message
7536 # explains well what is going on. For example when the DBI
7537 # fails and consequently DBD::SQLite fails and now we are
7538 # processing CPAN::SQLite. Then we must have a "next" for
7539 # DBD::SQLite. How can we get it and how can we identify
7540 # all other cases we must identify?
7542 my $do = $nmo->distribution;
7543 next NEED unless $do; # not on CPAN
7544 NOSAYER: for my $nosayer (
7555 &&(UNIVERSAL::can($do->{$nosayer},"failed") ?
7556 $do->{$nosayer}->failed :
7557 $do->{$nosayer} =~ /^NO/)
7559 if ($nosayer eq "make_test"
7561 $do->{make_test}{COMMANDID} != $CPAN::CurrentCommandId
7565 $CPAN::Frontend->mywarn("Warning: Prerequisite ".
7566 "'$need_module => $need_version' ".
7567 "for '$self->{ID}' failed when ".
7568 "processing '$do->{ID}' with ".
7569 "'$nosayer => $do->{$nosayer}'. Continuing, ".
7570 "but chances to succeed are limited.\n"
7576 my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
7577 push @need, [$need_module,$needed_as];
7579 my @unfolded = map { "[".join(",",@$_)."]" } @need;
7580 CPAN->debug("returning from unsat_prereq[@unfolded]") if $CPAN::DEBUG;
7584 #-> sub CPAN::Distribution::read_yaml ;
7587 return $self->{yaml_content} if exists $self->{yaml_content};
7588 my $build_dir = $self->{build_dir};
7589 my $yaml = File::Spec->catfile($build_dir,"META.yml");
7590 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
7591 return unless -f $yaml;
7592 eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml)->[0]; };
7594 $CPAN::Frontend->mywarn("Could not read ".
7595 "'$yaml'. Falling back to other ".
7596 "methods to determine prerequisites\n");
7597 return $self->{yaml_content} = undef; # if we die, then we
7598 # cannot read YAML's own
7601 # not "authoritative"
7602 if (not exists $self->{yaml_content}{dynamic_config}
7603 or $self->{yaml_content}{dynamic_config}
7605 $self->{yaml_content} = undef;
7607 $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
7609 return $self->{yaml_content};
7612 #-> sub CPAN::Distribution::prereq_pm ;
7615 $self->{prereq_pm_detected} ||= 0;
7616 CPAN->debug("ID[$self->{ID}]prereq_pm_detected[$self->{prereq_pm_detected}]") if $CPAN::DEBUG;
7617 return $self->{prereq_pm} if $self->{prereq_pm_detected};
7618 return unless $self->{writemakefile} # no need to have succeeded
7619 # but we must have run it
7620 || $self->{modulebuild};
7621 CPAN->debug(sprintf "writemakefile[%s]modulebuild[%s]",
7622 $self->{writemakefile}||"",
7623 $self->{modulebuild}||"",
7626 if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
7627 $req = $yaml->{requires} || {};
7628 $breq = $yaml->{build_requires} || {};
7629 undef $req unless ref $req eq "HASH" && %$req;
7631 if ($yaml->{generated_by} &&
7632 $yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
7633 my $eummv = do { local $^W = 0; $1+0; };
7634 if ($eummv < 6.2501) {
7635 # thanks to Slaven for digging that out: MM before
7636 # that could be wrong because it could reflect a
7643 while (my($k,$v) = each %{$req||{}}) {
7646 } elsif ($k =~ /[A-Za-z]/ &&
7648 $CPAN::META->exists("Module",$v)
7650 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
7651 "requires hash: $k => $v; I'll take both ".
7652 "key and value as a module name\n");
7653 $CPAN::Frontend->mysleep(1);
7659 $req = $areq if $do_replace;
7662 unless ($req || $breq) {
7663 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
7664 my $makefile = File::Spec->catfile($build_dir,"Makefile");
7668 $fh = FileHandle->new("<$makefile\0")) {
7669 CPAN->debug("Getting prereq from Makefile") if $CPAN::DEBUG;
7672 last if /MakeMaker post_initialize section/;
7674 \s+PREREQ_PM\s+=>\s+(.+)
7677 # warn "Found prereq expr[$p]";
7679 # Regexp modified by A.Speer to remember actual version of file
7680 # PREREQ_PM hash key wants, then add to
7681 while ( $p =~ m/(?:\s)([\w\:]+)=>(q\[.*?\]|undef),?/g ){
7682 # In case a prereq is mentioned twice, complain.
7683 if ( defined $req->{$1} ) {
7684 warn "Warning: PREREQ_PM mentions $1 more than once, ".
7685 "last mention wins";
7687 my($m,$n) = ($1,$2);
7688 if ($n =~ /^q\[(.*?)\]$/) {
7697 unless ($req || $breq) {
7698 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
7699 my $buildfile = File::Spec->catfile($build_dir,"Build");
7700 if (-f $buildfile) {
7701 CPAN->debug("Found '$buildfile'") if $CPAN::DEBUG;
7702 my $build_prereqs = File::Spec->catfile($build_dir,"_build","prereqs");
7703 if (-f $build_prereqs) {
7704 CPAN->debug("Getting prerequisites from '$build_prereqs'") if $CPAN::DEBUG;
7705 my $content = do { local *FH;
7706 open FH, $build_prereqs
7707 or $CPAN::Frontend->mydie("Could not open ".
7708 "'$build_prereqs': $!");
7712 my $bphash = eval $content;
7715 $req = $bphash->{requires} || +{};
7716 $breq = $bphash->{build_requires} || +{};
7722 && ! -f "Makefile.PL"
7723 && ! exists $req->{"Module::Build"}
7724 && ! $CPAN::META->has_inst("Module::Build")) {
7725 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
7726 "undeclared prerequisite.\n".
7727 " Adding it now as such.\n"
7729 $CPAN::Frontend->mysleep(5);
7730 $req->{"Module::Build"} = 0;
7731 delete $self->{writemakefile};
7733 if ($req || $breq) {
7734 $self->{prereq_pm_detected}++;
7735 return $self->{prereq_pm} = { requires => $req, build_requires => $breq };
7739 #-> sub CPAN::Distribution::test ;
7742 if (my $goto = $self->prefs->{goto}) {
7743 return $self->goto($goto);
7747 delete $self->{force_update};
7750 # warn "XDEBUG: checking for notest: $self->{notest} $self";
7751 if ($self->{notest}) {
7752 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
7756 my $make = $self->{modulebuild} ? "Build" : "make";
7758 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
7760 : ($ENV{PERLLIB} || "");
7762 $CPAN::META->set_perl5lib;
7763 local $ENV{MAKEFLAGS}; # protect us from outer make calls
7765 $CPAN::Frontend->myprint("Running $make test\n");
7767 # if (my @prereq = $self->unsat_prereq){
7768 # if ( $CPAN::DEBUG ) {
7769 # require Data::Dumper;
7770 # CPAN->debug(sprintf "unsat_prereq[%s]", Data::Dumper::Dumper(\@prereq));
7772 # unless ($prereq[0][0] eq "perl") {
7773 # return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
7779 unless (exists $self->{make} or exists $self->{later}) {
7781 "Make had some problems, won't test";
7784 exists $self->{make} and
7786 UNIVERSAL::can($self->{make},"failed") ?
7787 $self->{make}->failed :
7788 $self->{make} =~ /^NO/
7789 ) and push @e, "Can't test without successful make";
7791 $self->{badtestcnt} ||= 0;
7792 if ($self->{badtestcnt} > 0) {
7793 require Data::Dumper;
7794 CPAN->debug(sprintf "NOREPEAT[%s]", Data::Dumper::Dumper($self)) if $CPAN::DEBUG;
7795 push @e, "Won't repeat unsuccessful test during this command";
7798 exists $self->{later} and length($self->{later}) and
7799 push @e, $self->{later};
7801 if (exists $self->{build_dir}) {
7802 if ($CPAN::META->{is_tested}{$self->{build_dir}}
7804 exists $self->{make_test}
7807 UNIVERSAL::can($self->{make_test},"failed") ?
7808 $self->{make_test}->failed :
7809 $self->{make_test} =~ /^NO/
7812 push @e, "Has already been tested successfully";
7815 push @e, "Has no own directory";
7817 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
7818 unless (chdir $self->{build_dir}) {
7819 push @e, "Couldn't chdir to '$self->{build_dir}': $!";
7821 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
7823 $self->debug("Changed directory to $self->{build_dir}")
7826 if ($^O eq 'MacOS') {
7827 Mac::BuildTools::make_test($self);
7831 if ($self->{modulebuild}) {
7832 my $v = CPAN::Shell->expand("Module","Test::Harness")->inst_version;
7833 if (CPAN::Version->vlt($v,2.62)) {
7834 $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only
7835 '$v', you need at least '2.62'. Please upgrade your Test::Harness.\n});
7836 $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old");
7842 if (my $commandline = $self->prefs->{test}{commandline}) {
7843 $system = $commandline;
7845 } elsif ($self->{modulebuild}) {
7846 $system = sprintf "%s test", $self->_build_command();
7848 $system = join " ", $self->_make_command(), "test";
7850 my $make_test_arg = $self->make_x_arg("test");
7851 $system = sprintf("%s%s",
7853 $make_test_arg ? " $make_test_arg" : "",
7857 while (my($k,$v) = each %ENV) {
7858 next unless defined $v;
7862 if (my $env = $self->prefs->{test}{env}) {
7863 for my $e (keys %$env) {
7864 $ENV{$e} = $env->{$e};
7867 my $expect_model = $self->_prefs_with_expect("test");
7868 my $want_expect = 0;
7869 if ( $expect_model && @{$expect_model->{talk}} ) {
7870 my $can_expect = $CPAN::META->has_inst("Expect");
7874 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
7875 "testing without\n");
7878 my $test_report = CPAN::HandleConfig->prefs_lookup($self,
7882 my $can_report = $CPAN::META->has_inst("CPAN::Reporter");
7886 $CPAN::Frontend->mywarn("CPAN::Reporter not installed, falling back to ".
7887 "testing without\n");
7890 my $ready_to_report = $want_report;
7891 if ($ready_to_report
7893 substr($self->id,-1,1) eq "."
7895 $self->author->id eq "LOCAL"
7898 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
7899 "for local directories\n");
7900 $ready_to_report = 0;
7902 if ($ready_to_report
7904 $self->prefs->{patches}
7906 @{$self->prefs->{patches}}
7910 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
7911 "when the source has been patched\n");
7912 $ready_to_report = 0;
7915 if ($ready_to_report) {
7916 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is currently ".
7917 "not supported when distroprefs specify ".
7918 "an interactive test\n");
7920 $tests_ok = $self->_run_via_expect($system,$expect_model) == 0;
7921 } elsif ( $ready_to_report ) {
7922 $tests_ok = CPAN::Reporter::test($self, $system);
7924 $tests_ok = system($system) == 0;
7926 $self->introduce_myself;
7931 # local $CPAN::DEBUG = 16; # Distribution
7932 for my $m (keys %{$self->{sponsored_mods}}) {
7933 my $m_obj = CPAN::Shell->expand("Module",$m) or next;
7934 # XXX we need available_version which reflects
7935 # $ENV{PERL5LIB} so that already tested but not yet
7936 # installed modules are counted.
7937 my $available_version = $m_obj->available_version;
7938 my $available_file = $m_obj->available_file;
7939 if ($available_version &&
7940 !CPAN::Version->vlt($available_version,$self->{prereq_pm}{$m})
7942 CPAN->debug("m[$m] good enough available_version[$available_version]")
7944 } elsif ($available_file
7946 !$self->{prereq_pm}{$m}
7948 $self->{prereq_pm}{$m} == 0
7951 # lex Class::Accessor::Chained::Fast which has no $VERSION
7952 CPAN->debug("m[$m] have available_file[$available_file]")
7960 my $which = join ",", @prereq;
7961 my $but = $cnt == 1 ? "one dependency not OK ($which)" :
7962 "$cnt dependencies missing ($which)";
7963 $CPAN::Frontend->mywarn("Tests succeeded but $but\n");
7964 $self->{make_test} = CPAN::Distrostatus->new("NO $but");
7965 $self->store_persistent_state;
7970 $CPAN::Frontend->myprint(" $system -- OK\n");
7971 $self->{make_test} = CPAN::Distrostatus->new("YES");
7972 $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
7973 # probably impossible to need the next line because badtestcnt
7974 # has a lifespan of one command
7975 delete $self->{badtestcnt};
7977 $self->{make_test} = CPAN::Distrostatus->new("NO");
7978 $self->{badtestcnt}++;
7979 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
7981 $self->store_persistent_state;
7984 sub _prefs_with_expect {
7985 my($self,$where) = @_;
7986 return unless my $prefs = $self->prefs;
7987 return unless my $where_prefs = $prefs->{$where};
7988 if ($where_prefs->{expect}) {
7990 mode => "deterministic",
7992 talk => $where_prefs->{expect},
7994 } elsif ($where_prefs->{"eexpect"}) {
7995 return $where_prefs->{"eexpect"};
8000 #-> sub CPAN::Distribution::clean ;
8003 my $make = $self->{modulebuild} ? "Build" : "make";
8004 $CPAN::Frontend->myprint("Running $make clean\n");
8005 unless (exists $self->{archived}) {
8006 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
8007 "/untarred, nothing done\n");
8010 unless (exists $self->{build_dir}) {
8011 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
8016 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
8017 push @e, "make clean already called once";
8018 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
8020 chdir $self->{build_dir} or
8021 Carp::confess("Couldn't chdir to $self->{build_dir}: $!");
8022 $self->debug("Changed directory to $self->{build_dir}") if $CPAN::DEBUG;
8024 if ($^O eq 'MacOS') {
8025 Mac::BuildTools::make_clean($self);
8030 if ($self->{modulebuild}) {
8031 unless (-f "Build") {
8032 my $cwd = CPAN::anycwd();
8033 $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}".
8034 " in cwd[$cwd]. Danger, Will Robinson!");
8035 $CPAN::Frontend->mysleep(5);
8037 $system = sprintf "%s clean", $self->_build_command();
8039 $system = join " ", $self->_make_command(), "clean";
8041 my $system_ok = system($system) == 0;
8042 $self->introduce_myself;
8044 $CPAN::Frontend->myprint(" $system -- OK\n");
8048 # Jost Krieger pointed out that this "force" was wrong because
8049 # it has the effect that the next "install" on this distribution
8050 # will untar everything again. Instead we should bring the
8051 # object's state back to where it is after untarring.
8062 $self->{make_clean} = CPAN::Distrostatus->new("YES");
8065 # Hmmm, what to do if make clean failed?
8067 $self->{make_clean} = CPAN::Distrostatus->new("NO");
8068 $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n});
8070 # 2006-02-27: seems silly to me to force a make now
8071 # $self->force("make"); # so that this directory won't be used again
8074 $self->store_persistent_state;
8077 #-> sub CPAN::Distribution::goto ;
8079 my($self,$goto) = @_;
8080 $goto = $self->normalize($goto);
8082 # inject into the queue
8084 CPAN::Queue->delete($self->id);
8085 CPAN::Queue->jumpqueue([$goto,$self->{reqtype}]);
8087 # and run where we left off
8089 my($method) = (caller(1))[3];
8090 CPAN->instance("CPAN::Distribution",$goto)->$method;
8091 CPAN::Queue->delete_first($goto);
8094 #-> sub CPAN::Distribution::install ;
8097 if (my $goto = $self->prefs->{goto}) {
8098 return $self->goto($goto);
8101 unless ($self->{badtestcnt}) {
8105 delete $self->{force_update};
8108 my $make = $self->{modulebuild} ? "Build" : "make";
8109 $CPAN::Frontend->myprint("Running $make install\n");
8112 unless (exists $self->{make} or exists $self->{later}) {
8114 "Make had some problems, won't install";
8117 exists $self->{make} and
8119 UNIVERSAL::can($self->{make},"failed") ?
8120 $self->{make}->failed :
8121 $self->{make} =~ /^NO/
8123 push @e, "Make had returned bad status, install seems impossible";
8125 if (exists $self->{build_dir}) {
8127 push @e, "Has no own directory";
8130 if (exists $self->{make_test} and
8132 UNIVERSAL::can($self->{make_test},"failed") ?
8133 $self->{make_test}->failed :
8134 $self->{make_test} =~ /^NO/
8136 if ($self->{force_update}) {
8137 $self->{make_test}->text("FAILED but failure ignored because ".
8138 "'force' in effect");
8140 push @e, "make test had returned bad status, ".
8141 "won't install without force"
8144 if (exists $self->{install}) {
8145 if (UNIVERSAL::can($self->{install},"text") ?
8146 $self->{install}->text eq "YES" :
8147 $self->{install} =~ /^YES/
8149 push @e, "Already done";
8151 # comment in Todo on 2006-02-11; maybe retry?
8152 push @e, "Already tried without success";
8156 exists $self->{later} and length($self->{later}) and
8157 push @e, $self->{later};
8159 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
8160 unless (chdir $self->{build_dir}) {
8161 push @e, "Couldn't chdir to '$self->{build_dir}': $!";
8163 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
8165 $self->debug("Changed directory to $self->{build_dir}")
8168 if ($^O eq 'MacOS') {
8169 Mac::BuildTools::make_install($self);
8174 if (my $commandline = $self->prefs->{install}{commandline}) {
8175 $system = $commandline;
8177 } elsif ($self->{modulebuild}) {
8178 my($mbuild_install_build_command) =
8179 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
8180 $CPAN::Config->{mbuild_install_build_command} ?
8181 $CPAN::Config->{mbuild_install_build_command} :
8182 $self->_build_command();
8183 $system = sprintf("%s install %s",
8184 $mbuild_install_build_command,
8185 $CPAN::Config->{mbuild_install_arg},
8188 my($make_install_make_command) =
8189 CPAN::HandleConfig->prefs_lookup($self,
8190 q{make_install_make_command})
8191 || $self->_make_command();
8192 $system = sprintf("%s install %s",
8193 $make_install_make_command,
8194 $CPAN::Config->{make_install_arg},
8198 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
8199 my $brip = CPAN::HandleConfig->prefs_lookup($self,
8200 q{build_requires_install_policy});
8203 my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command
8204 my $want_install = "yes";
8205 if ($reqtype eq "b") {
8206 if ($brip eq "no") {
8207 $want_install = "no";
8208 } elsif ($brip =~ m|^ask/(.+)|) {
8210 $default = "yes" unless $default =~ /^(y|n)/i;
8212 CPAN::Shell::colorable_makemaker_prompt
8213 ("$id is just needed temporarily during building or testing. ".
8214 "Do you want to install it permanently? (Y/n)",
8218 unless ($want_install =~ /^y/i) {
8219 my $is_only = "is only 'build_requires'";
8220 $CPAN::Frontend->mywarn("Not installing because $is_only\n");
8221 $self->{install} = CPAN::Distrostatus->new("NO -- $is_only");
8222 delete $self->{force_update};
8225 my($pipe) = FileHandle->new("$system $stderr |");
8228 print $_; # intentionally NOT use Frontend->myprint because it
8229 # looks irritating when we markup in color what we
8230 # just pass through from an external program
8234 my $close_ok = $? == 0;
8235 $self->introduce_myself;
8237 $CPAN::Frontend->myprint(" $system -- OK\n");
8238 $CPAN::META->is_installed($self->{build_dir});
8239 $self->{install} = CPAN::Distrostatus->new("YES");
8241 $self->{install} = CPAN::Distrostatus->new("NO");
8242 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
8244 CPAN::HandleConfig->prefs_lookup($self,
8245 q{make_install_make_command});
8247 $makeout =~ /permission/s
8251 || $mimc eq (CPAN::HandleConfig->prefs_lookup($self,
8255 $CPAN::Frontend->myprint(
8257 qq{ You may have to su }.
8258 qq{to root to install the package\n}.
8259 qq{ (Or you may want to run something like\n}.
8260 qq{ o conf make_install_make_command 'sudo make'\n}.
8261 qq{ to raise your permissions.}
8265 delete $self->{force_update};
8267 $self->store_persistent_state;
8270 sub introduce_myself {
8272 $CPAN::Frontend->myprint(sprintf(" %s\n",$self->pretty_id));
8275 #-> sub CPAN::Distribution::dir ;
8280 #-> sub CPAN::Distribution::perldoc ;
8284 my($dist) = $self->id;
8285 my $package = $self->called_for;
8287 $self->_display_url( $CPAN::Defaultdocs . $package );
8290 #-> sub CPAN::Distribution::_check_binary ;
8292 my ($dist,$shell,$binary) = @_;
8295 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
8298 if ($CPAN::META->has_inst("File::Which")) {
8299 return File::Which::which($binary);
8302 $pid = open README, "which $binary|"
8303 or $CPAN::Frontend->mywarn(qq{Could not fork 'which $binary': $!\n});
8309 or $CPAN::Frontend->mywarn("Could not run 'which $binary': $!\n")
8313 $CPAN::Frontend->myprint(qq{ + $out \n})
8314 if $CPAN::DEBUG && $out;
8319 #-> sub CPAN::Distribution::_display_url ;
8321 my($self,$url) = @_;
8322 my($res,$saved_file,$pid,$out);
8324 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
8327 # should we define it in the config instead?
8328 my $html_converter = "html2text";
8330 my $web_browser = $CPAN::Config->{'lynx'} || undef;
8331 my $web_browser_out = $web_browser
8332 ? CPAN::Distribution->_check_binary($self,$web_browser)
8335 if ($web_browser_out) {
8336 # web browser found, run the action
8337 my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
8338 $CPAN::Frontend->myprint(qq{system[$browser $url]})
8340 $CPAN::Frontend->myprint(qq{
8343 with browser $browser
8345 $CPAN::Frontend->mysleep(1);
8346 system("$browser $url");
8347 if ($saved_file) { 1 while unlink($saved_file) }
8349 # web browser not found, let's try text only
8350 my $html_converter_out =
8351 CPAN::Distribution->_check_binary($self,$html_converter);
8352 $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
8354 if ($html_converter_out ) {
8355 # html2text found, run it
8356 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
8357 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
8358 unless defined($saved_file);
8361 $pid = open README, "$html_converter $saved_file |"
8362 or $CPAN::Frontend->mydie(qq{
8363 Could not fork '$html_converter $saved_file': $!});
8365 if ($CPAN::META->has_inst("File::Temp")) {
8366 $fh = File::Temp->new(
8367 template => 'cpan_htmlconvert_XXXX',
8371 $filename = $fh->filename;
8373 $filename = "cpan_htmlconvert_$$.txt";
8374 $fh = FileHandle->new();
8375 open $fh, ">$filename" or die;
8381 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
8382 my $tmpin = $fh->filename;
8383 $CPAN::Frontend->myprint(sprintf(qq{
8385 saved output to %s\n},
8393 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
8394 my $fh_pager = FileHandle->new;
8395 local($SIG{PIPE}) = "IGNORE";
8396 my $pager = $CPAN::Config->{'pager'} || "cat";
8397 $fh_pager->open("|$pager")
8398 or $CPAN::Frontend->mydie(qq{
8399 Could not open pager '$pager': $!});
8400 $CPAN::Frontend->myprint(qq{
8405 $CPAN::Frontend->mysleep(1);
8406 $fh_pager->print(<FH>);
8409 # coldn't find the web browser or html converter
8410 $CPAN::Frontend->myprint(qq{
8411 You need to install lynx or $html_converter to use this feature.});
8416 #-> sub CPAN::Distribution::_getsave_url ;
8418 my($dist, $shell, $url) = @_;
8420 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
8424 if ($CPAN::META->has_inst("File::Temp")) {
8425 $fh = File::Temp->new(
8426 template => "cpan_getsave_url_XXXX",
8430 $filename = $fh->filename;
8432 $fh = FileHandle->new;
8433 $filename = "cpan_getsave_url_$$.html";
8435 my $tmpin = $filename;
8436 if ($CPAN::META->has_usable('LWP')) {
8437 $CPAN::Frontend->myprint("Fetching with LWP:
8441 CPAN::LWP::UserAgent->config;
8442 eval { $Ua = CPAN::LWP::UserAgent->new; };
8444 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
8448 $Ua->proxy('http', $var)
8449 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
8451 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
8454 my $req = HTTP::Request->new(GET => $url);
8455 $req->header('Accept' => 'text/html');
8456 my $res = $Ua->request($req);
8457 if ($res->is_success) {
8458 $CPAN::Frontend->myprint(" + request successful.\n")
8460 print $fh $res->content;
8462 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
8466 $CPAN::Frontend->myprint(sprintf(
8467 "LWP failed with code[%s], message[%s]\n",
8474 $CPAN::Frontend->mywarn(" LWP not available\n");
8479 # sub CPAN::Distribution::_build_command
8480 sub _build_command {
8482 if ($^O eq "MSWin32") { # special code needed at least up to
8483 # Module::Build 0.2611 and 0.2706; a fix
8484 # in M:B has been promised 2006-01-30
8485 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
8486 return "$perl ./Build";
8491 package CPAN::Bundle;
8496 $CPAN::Frontend->myprint($self->as_string);
8501 delete $self->{later};
8502 for my $c ( $self->contains ) {
8503 my $obj = CPAN::Shell->expandany($c) or next;
8508 # mark as dirty/clean
8509 #-> sub CPAN::Bundle::color_cmd_tmps ;
8510 sub color_cmd_tmps {
8512 my($depth) = shift || 0;
8513 my($color) = shift || 0;
8514 my($ancestors) = shift || [];
8515 # a module needs to recurse to its cpan_file, a distribution needs
8516 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
8518 return if exists $self->{incommandcolor}
8520 && $self->{incommandcolor}==$color;
8521 if ($depth>=$CPAN::MAX_RECURSION){
8522 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
8524 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
8526 for my $c ( $self->contains ) {
8527 my $obj = CPAN::Shell->expandany($c) or next;
8528 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
8529 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
8531 # never reached code?
8533 #delete $self->{badtestcnt};
8535 $self->{incommandcolor} = $color;
8538 #-> sub CPAN::Bundle::as_string ;
8542 # following line must be "=", not "||=" because we have a moving target
8543 $self->{INST_VERSION} = $self->inst_version;
8544 return $self->SUPER::as_string;
8547 #-> sub CPAN::Bundle::contains ;
8550 my($inst_file) = $self->inst_file || "";
8551 my($id) = $self->id;
8552 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
8553 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
8556 unless ($inst_file) {
8557 # Try to get at it in the cpan directory
8558 $self->debug("no inst_file") if $CPAN::DEBUG;
8560 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
8561 $cpan_file = $self->cpan_file;
8562 if ($cpan_file eq "N/A") {
8563 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
8564 Maybe stale symlink? Maybe removed during session? Giving up.\n");
8566 my $dist = $CPAN::META->instance('CPAN::Distribution',
8568 $self->debug("before get id[$dist->{ID}]") if $CPAN::DEBUG;
8570 $self->debug("after get id[$dist->{ID}]") if $CPAN::DEBUG;
8571 my($todir) = $CPAN::Config->{'cpan_home'};
8572 my(@me,$from,$to,$me);
8573 @me = split /::/, $self->id;
8575 $me = File::Spec->catfile(@me);
8576 $from = $self->find_bundle_file($dist->{build_dir},join('/',@me));
8577 $to = File::Spec->catfile($todir,$me);
8578 File::Path::mkpath(File::Basename::dirname($to));
8579 File::Copy::copy($from, $to)
8580 or Carp::confess("Couldn't copy $from to $to: $!");
8584 my $fh = FileHandle->new;
8586 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
8588 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
8590 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
8591 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
8592 next unless $in_cont;
8597 push @result, (split " ", $_, 2)[0];
8600 delete $self->{STATUS};
8601 $self->{CONTAINS} = \@result;
8602 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
8604 $CPAN::Frontend->mywarn(qq{
8605 The bundle file "$inst_file" may be a broken
8606 bundlefile. It seems not to contain any bundle definition.
8607 Please check the file and if it is bogus, please delete it.
8608 Sorry for the inconvenience.
8614 #-> sub CPAN::Bundle::find_bundle_file
8615 # $where is in local format, $what is in unix format
8616 sub find_bundle_file {
8617 my($self,$where,$what) = @_;
8618 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
8619 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
8620 ### my $bu = File::Spec->catfile($where,$what);
8621 ### return $bu if -f $bu;
8622 my $manifest = File::Spec->catfile($where,"MANIFEST");
8623 unless (-f $manifest) {
8624 require ExtUtils::Manifest;
8625 my $cwd = CPAN::anycwd();
8626 $self->safe_chdir($where);
8627 ExtUtils::Manifest::mkmanifest();
8628 $self->safe_chdir($cwd);
8630 my $fh = FileHandle->new($manifest)
8631 or Carp::croak("Couldn't open $manifest: $!");
8633 my $bundle_filename = $what;
8634 $bundle_filename =~ s|Bundle.*/||;
8635 my $bundle_unixpath;
8638 my($file) = /(\S+)/;
8639 if ($file =~ m|\Q$what\E$|) {
8640 $bundle_unixpath = $file;
8641 # return File::Spec->catfile($where,$bundle_unixpath); # bad
8644 # retry if she managed to have no Bundle directory
8645 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
8647 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
8648 if $bundle_unixpath;
8649 Carp::croak("Couldn't find a Bundle file in $where");
8652 # needs to work quite differently from Module::inst_file because of
8653 # cpan_home/Bundle/ directory and the possibility that we have
8654 # shadowing effect. As it makes no sense to take the first in @INC for
8655 # Bundles, we parse them all for $VERSION and take the newest.
8657 #-> sub CPAN::Bundle::inst_file ;
8662 @me = split /::/, $self->id;
8665 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
8666 my $bfile = File::Spec->catfile($incdir, @me);
8667 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
8668 next unless -f $bfile;
8669 my $foundv = MM->parse_version($bfile);
8670 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
8671 $self->{INST_FILE} = $bfile;
8672 $self->{INST_VERSION} = $bestv = $foundv;
8678 #-> sub CPAN::Bundle::inst_version ;
8681 $self->inst_file; # finds INST_VERSION as side effect
8682 $self->{INST_VERSION};
8685 #-> sub CPAN::Bundle::rematein ;
8687 my($self,$meth) = @_;
8688 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
8689 my($id) = $self->id;
8690 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
8691 unless $self->inst_file || $self->cpan_file;
8693 for $s ($self->contains) {
8694 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
8695 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
8696 if ($type eq 'CPAN::Distribution') {
8697 $CPAN::Frontend->mywarn(qq{
8698 The Bundle }.$self->id.qq{ contains
8699 explicitly a file '$s'.
8700 Going to $meth that.
8702 $CPAN::Frontend->mysleep(5);
8704 # possibly noisy action:
8705 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
8706 my $obj = $CPAN::META->instance($type,$s);
8707 $obj->{reqtype} = $self->{reqtype};
8712 # If a bundle contains another that contains an xs_file we have here,
8713 # we just don't bother I suppose
8714 #-> sub CPAN::Bundle::xs_file
8719 #-> sub CPAN::Bundle::force ;
8720 sub fforce { shift->rematein('fforce',@_); }
8721 #-> sub CPAN::Bundle::force ;
8722 sub force { shift->rematein('force',@_); }
8723 #-> sub CPAN::Bundle::notest ;
8724 sub notest { shift->rematein('notest',@_); }
8725 #-> sub CPAN::Bundle::get ;
8726 sub get { shift->rematein('get',@_); }
8727 #-> sub CPAN::Bundle::make ;
8728 sub make { shift->rematein('make',@_); }
8729 #-> sub CPAN::Bundle::test ;
8732 # $self->{badtestcnt} ||= 0;
8733 $self->rematein('test',@_);
8735 #-> sub CPAN::Bundle::install ;
8738 $self->rematein('install',@_);
8740 #-> sub CPAN::Bundle::clean ;
8741 sub clean { shift->rematein('clean',@_); }
8743 #-> sub CPAN::Bundle::uptodate ;
8746 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
8748 foreach $c ($self->contains) {
8749 my $obj = CPAN::Shell->expandany($c);
8750 return 0 unless $obj->uptodate;
8755 #-> sub CPAN::Bundle::readme ;
8758 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
8759 No File found for bundle } . $self->id . qq{\n}), return;
8760 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
8761 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
8764 package CPAN::Module;
8768 # sub CPAN::Module::userid
8773 return $ro->{userid} || $ro->{CPAN_USERID};
8775 # sub CPAN::Module::description
8778 my $ro = $self->ro or return "";
8784 CPAN::Shell->expand("Distribution",$self->cpan_file);
8787 # sub CPAN::Module::undelay
8790 delete $self->{later};
8791 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
8796 # mark as dirty/clean
8797 #-> sub CPAN::Module::color_cmd_tmps ;
8798 sub color_cmd_tmps {
8800 my($depth) = shift || 0;
8801 my($color) = shift || 0;
8802 my($ancestors) = shift || [];
8803 # a module needs to recurse to its cpan_file
8805 return if exists $self->{incommandcolor}
8807 && $self->{incommandcolor}==$color;
8808 return if $color==0 && !$self->{incommandcolor};
8810 if ( $self->uptodate ) {
8811 $self->{incommandcolor} = $color;
8813 } elsif (my $have_version = $self->available_version) {
8814 # maybe what we have is good enough
8816 my $who_asked_for_me = $ancestors->[-1];
8817 my $obj = CPAN::Shell->expandany($who_asked_for_me);
8819 } elsif ($obj->isa("CPAN::Bundle")) {
8820 # bundles cannot specify a minimum version
8822 } elsif ($obj->isa("CPAN::Distribution")) {
8823 if (my $prereq_pm = $obj->prereq_pm) {
8824 for my $k (keys %$prereq_pm) {
8825 if (my $want_version = $prereq_pm->{$k}{$self->id}) {
8826 if (CPAN::Version->vcmp($have_version,$want_version) >= 0) {
8827 $self->{incommandcolor} = $color;
8837 $self->{incommandcolor} = $color; # set me before recursion,
8838 # so we can break it
8840 if ($depth>=$CPAN::MAX_RECURSION){
8841 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
8843 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
8845 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
8846 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
8850 # delete $self->{badtestcnt};
8852 $self->{incommandcolor} = $color;
8855 #-> sub CPAN::Module::as_glimpse ;
8859 my $class = ref($self);
8860 $class =~ s/^CPAN:://;
8864 $CPAN::Shell::COLOR_REGISTERED
8866 $CPAN::META->has_inst("Term::ANSIColor")
8870 $color_on = Term::ANSIColor::color("green");
8871 $color_off = Term::ANSIColor::color("reset");
8873 my $uptodateness = " ";
8874 if ($class eq "Bundle") {
8875 } elsif ($self->uptodate) {
8876 $uptodateness = "=";
8877 } elsif ($self->inst_version) {
8878 $uptodateness = "<";
8880 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
8886 ($self->distribution ?
8887 $self->distribution->pretty_id :
8894 #-> sub CPAN::Module::dslip_status
8898 # development status
8899 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
8900 pre-alpha alpha beta released
8903 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
8904 developer comp.lang.perl.*
8907 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
8909 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
8911 object-oriented pragma
8914 @{$stat->{P}}{qw,p g l b a o d r n,} = qw,Standard-Perl
8918 distribution_allowed
8919 restricted_distribution
8921 for my $x (qw(d s l i p)) {
8922 $stat->{$x}{' '} = 'unknown';
8923 $stat->{$x}{'?'} = 'unknown';
8926 return +{} unless $ro && $ro->{statd};
8933 DV => $stat->{D}{$ro->{statd}},
8934 SV => $stat->{S}{$ro->{stats}},
8935 LV => $stat->{L}{$ro->{statl}},
8936 IV => $stat->{I}{$ro->{stati}},
8937 PV => $stat->{P}{$ro->{statp}},
8941 #-> sub CPAN::Module::as_string ;
8945 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
8946 my $class = ref($self);
8947 $class =~ s/^CPAN:://;
8949 push @m, $class, " id = $self->{ID}\n";
8950 my $sprintf = " %-12s %s\n";
8951 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
8952 if $self->description;
8953 my $sprintf2 = " %-12s %s (%s)\n";
8955 $userid = $self->userid;
8958 if ($author = CPAN::Shell->expand('Author',$userid)) {
8961 if ($m = $author->email) {
8968 $author->fullname . $email
8972 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
8973 if $self->cpan_version;
8974 if (my $cpan_file = $self->cpan_file){
8975 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
8976 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
8977 my $upload_date = $dist->upload_date;
8979 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
8983 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
8984 my $dslip = $self->dslip_status;
8988 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
8990 my $local_file = $self->inst_file;
8991 unless ($self->{MANPAGE}) {
8994 $manpage = $self->manpage_headline($local_file);
8996 # If we have already untarred it, we should look there
8997 my $dist = $CPAN::META->instance('CPAN::Distribution',
8999 # warn "dist[$dist]";
9000 # mff=manifest file; mfh=manifest handle
9005 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
9007 $mfh = FileHandle->new($mff)
9009 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
9010 my $lfre = $self->id; # local file RE
9013 my($lfl); # local file file
9015 my(@mflines) = <$mfh>;
9020 while (length($lfre)>5 and !$lfl) {
9021 ($lfl) = grep /$lfre/, @mflines;
9022 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
9025 $lfl =~ s/\s.*//; # remove comments
9026 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
9027 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
9028 # warn "lfl_abs[$lfl_abs]";
9030 $manpage = $self->manpage_headline($lfl_abs);
9034 $self->{MANPAGE} = $manpage if $manpage;
9037 for $item (qw/MANPAGE/) {
9038 push @m, sprintf($sprintf, $item, $self->{$item})
9039 if exists $self->{$item};
9041 for $item (qw/CONTAINS/) {
9042 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
9043 if exists $self->{$item} && @{$self->{$item}};
9045 push @m, sprintf($sprintf, 'INST_FILE',
9046 $local_file || "(not installed)");
9047 push @m, sprintf($sprintf, 'INST_VERSION',
9048 $self->inst_version) if $local_file;
9052 sub manpage_headline {
9053 my($self,$local_file) = @_;
9054 my(@local_file) = $local_file;
9055 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
9056 push @local_file, $local_file;
9058 for $locf (@local_file) {
9059 next unless -f $locf;
9060 my $fh = FileHandle->new($locf)
9061 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
9065 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
9066 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
9083 #-> sub CPAN::Module::cpan_file ;
9084 # Note: also inherited by CPAN::Bundle
9087 # CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
9088 unless ($self->ro) {
9089 CPAN::Index->reload;
9092 if ($ro && defined $ro->{CPAN_FILE}){
9093 return $ro->{CPAN_FILE};
9095 my $userid = $self->userid;
9097 if ($CPAN::META->exists("CPAN::Author",$userid)) {
9098 my $author = $CPAN::META->instance("CPAN::Author",
9100 my $fullname = $author->fullname;
9101 my $email = $author->email;
9102 unless (defined $fullname && defined $email) {
9103 return sprintf("Contact Author %s",
9107 return "Contact Author $fullname <$email>";
9109 return "Contact Author $userid (Email address not available)";
9117 #-> sub CPAN::Module::cpan_version ;
9123 # Can happen with modules that are not on CPAN
9126 $ro->{CPAN_VERSION} = 'undef'
9127 unless defined $ro->{CPAN_VERSION};
9128 $ro->{CPAN_VERSION};
9131 #-> sub CPAN::Module::force ;
9134 $self->{force_update} = 1;
9137 #-> sub CPAN::Module::fforce ;
9140 $self->{force_update} = 2;
9145 # warn "XDEBUG: set notest for Module";
9146 $self->{'notest'}++;
9149 #-> sub CPAN::Module::rematein ;
9151 my($self,$meth) = @_;
9152 $CPAN::Frontend->myprint(sprintf("Running %s for module '%s'\n",
9155 my $cpan_file = $self->cpan_file;
9156 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
9157 $CPAN::Frontend->mywarn(sprintf qq{
9158 The module %s isn\'t available on CPAN.
9160 Either the module has not yet been uploaded to CPAN, or it is
9161 temporary unavailable. Please contact the author to find out
9162 more about the status. Try 'i %s'.
9169 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
9170 $pack->called_for($self->id);
9171 if (exists $self->{force_update}){
9172 if ($self->{force_update} == 2) {
9173 $pack->fforce($meth);
9175 $pack->force($meth);
9178 $pack->notest($meth) if exists $self->{'notest'};
9180 $pack->{reqtype} ||= "";
9181 CPAN->debug("dist-reqtype[$pack->{reqtype}]".
9182 "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG;
9183 if ($pack->{reqtype}) {
9184 if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) {
9185 $pack->{reqtype} = $self->{reqtype};
9187 exists $pack->{install}
9190 UNIVERSAL::can($pack->{install},"failed") ?
9191 $pack->{install}->failed :
9192 $pack->{install} =~ /^NO/
9195 delete $pack->{install};
9196 $CPAN::Frontend->mywarn
9197 ("Promoting $pack->{ID} from 'build_requires' to 'requires'");
9201 $pack->{reqtype} = $self->{reqtype};
9208 $pack->unforce if $pack->can("unforce") && exists $self->{force_update};
9209 $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
9210 delete $self->{force_update};
9211 delete $self->{'notest'};
9217 #-> sub CPAN::Module::perldoc ;
9218 sub perldoc { shift->rematein('perldoc') }
9219 #-> sub CPAN::Module::readme ;
9220 sub readme { shift->rematein('readme') }
9221 #-> sub CPAN::Module::look ;
9222 sub look { shift->rematein('look') }
9223 #-> sub CPAN::Module::cvs_import ;
9224 sub cvs_import { shift->rematein('cvs_import') }
9225 #-> sub CPAN::Module::get ;
9226 sub get { shift->rematein('get',@_) }
9227 #-> sub CPAN::Module::make ;
9228 sub make { shift->rematein('make') }
9229 #-> sub CPAN::Module::test ;
9232 # $self->{badtestcnt} ||= 0;
9233 $self->rematein('test',@_);
9235 #-> sub CPAN::Module::uptodate ;
9238 local($_); # protect against a bug in MakeMaker 6.17
9239 my($latest) = $self->cpan_version;
9241 my($inst_file) = $self->inst_file;
9243 if (defined $inst_file) {
9244 $have = $self->inst_version;
9249 ! CPAN::Version->vgt($latest, $have)
9251 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
9252 "latest[$latest] have[$have]") if $CPAN::DEBUG;
9257 #-> sub CPAN::Module::install ;
9263 not exists $self->{force_update}
9265 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
9267 $self->inst_version,
9273 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
9274 $CPAN::Frontend->mywarn(qq{
9275 \n\n\n ***WARNING***
9276 The module $self->{ID} has no active maintainer.\n\n\n
9278 $CPAN::Frontend->mysleep(5);
9280 $self->rematein('install') if $doit;
9282 #-> sub CPAN::Module::clean ;
9283 sub clean { shift->rematein('clean') }
9285 #-> sub CPAN::Module::inst_file ;
9288 $self->_file_in_path([@INC]);
9291 #-> sub CPAN::Module::available_file ;
9292 sub available_file {
9294 my $sep = $Config::Config{path_sep};
9295 my $perllib = $ENV{PERL5LIB};
9296 $perllib = $ENV{PERLLIB} unless defined $perllib;
9297 my @perllib = split(/$sep/,$perllib) if defined $perllib;
9298 $self->_file_in_path([@perllib,@INC]);
9301 #-> sub CPAN::Module::file_in_path ;
9303 my($self,$path) = @_;
9305 @packpath = split /::/, $self->{ID};
9306 $packpath[-1] .= ".pm";
9307 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
9308 unshift @packpath, "Term", "ReadLine"; # historical reasons
9310 foreach $dir (@$path) {
9311 my $pmfile = File::Spec->catfile($dir,@packpath);
9319 #-> sub CPAN::Module::xs_file ;
9323 @packpath = split /::/, $self->{ID};
9324 push @packpath, $packpath[-1];
9325 $packpath[-1] .= "." . $Config::Config{'dlext'};
9326 foreach $dir (@INC) {
9327 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
9335 #-> sub CPAN::Module::inst_version ;
9338 my $parsefile = $self->inst_file or return;
9339 my $have = $self->parse_version($parsefile);
9343 #-> sub CPAN::Module::inst_version ;
9344 sub available_version {
9346 my $parsefile = $self->available_file or return;
9347 my $have = $self->parse_version($parsefile);
9351 #-> sub CPAN::Module::parse_version ;
9353 my($self,$parsefile) = @_;
9354 my $have = MM->parse_version($parsefile);
9355 $have = "undef" unless defined $have && length $have;
9356 $have =~ s/^ //; # since the %vd hack these two lines here are needed
9357 $have =~ s/ $//; # trailing whitespace happens all the time
9359 $have = CPAN::Version->readable($have);
9361 $have =~ s/\s*//g; # stringify to float around floating point issues
9362 $have; # no stringify needed, \s* above matches always
9375 CPAN - query, download and build perl modules from CPAN sites
9381 perl -MCPAN -e shell
9391 cpan> install Acme::Meta # in the shell
9393 CPAN::Shell->install("Acme::Meta"); # in perl
9397 cpan> install NWCLARK/Acme-Meta-0.02.tar.gz # in the shell
9400 install("NWCLARK/Acme-Meta-0.02.tar.gz"); # in perl
9404 $mo = CPAN::Shell->expandany($mod);
9405 $mo = CPAN::Shell->expand("Module",$mod); # same thing
9407 # distribution objects:
9409 $do = CPAN::Shell->expand("Module",$mod)->distribution;
9410 $do = CPAN::Shell->expandany($distro); # same thing
9411 $do = CPAN::Shell->expand("Distribution",
9412 $distro); # same thing
9416 The CPAN module automates or at least simplifies the make and install
9417 of perl modules and extensions. It includes some primitive searching
9418 capabilities and knows how to use Net::FTP or LWP or some external
9419 download clients to fetch the distributions from the net.
9421 These are fetched from one or more of the mirrored CPAN (Comprehensive
9422 Perl Archive Network) sites and unpacked in a dedicated directory.
9424 The CPAN module also supports the concept of named and versioned
9425 I<bundles> of modules. Bundles simplify the handling of sets of
9426 related modules. See Bundles below.
9428 The package contains a session manager and a cache manager. The
9429 session manager keeps track of what has been fetched, built and
9430 installed in the current session. The cache manager keeps track of the
9431 disk space occupied by the make processes and deletes excess space
9432 according to a simple FIFO mechanism.
9434 All methods provided are accessible in a programmer style and in an
9435 interactive shell style.
9437 =head2 CPAN::shell([$prompt, $command]) Starting Interactive Mode
9439 The interactive mode is entered by running
9441 perl -MCPAN -e shell
9447 which puts you into a readline interface. If C<Term::ReadKey> and
9448 either C<Term::ReadLine::Perl> or C<Term::ReadLine::Gnu> are installed
9449 it supports both history and command completion.
9451 Once you are on the command line, type C<h> to get a one page help
9452 screen and the rest should be self-explanatory.
9454 The function call C<shell> takes two optional arguments, one is the
9455 prompt, the second is the default initial command line (the latter
9456 only works if a real ReadLine interface module is installed).
9458 The most common uses of the interactive modes are
9462 =item Searching for authors, bundles, distribution files and modules
9464 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
9465 for each of the four categories and another, C<i> for any of the
9466 mentioned four. Each of the four entities is implemented as a class
9467 with slightly differing methods for displaying an object.
9469 Arguments you pass to these commands are either strings exactly matching
9470 the identification string of an object or regular expressions that are
9471 then matched case-insensitively against various attributes of the
9472 objects. The parser recognizes a regular expression only if you
9473 enclose it between two slashes.
9475 The principle is that the number of found objects influences how an
9476 item is displayed. If the search finds one item, the result is
9477 displayed with the rather verbose method C<as_string>, but if we find
9478 more than one, we display each object with the terse method
9481 =item C<get>, C<make>, C<test>, C<install>, C<clean> modules or distributions
9483 These commands take any number of arguments and investigate what is
9484 necessary to perform the action. If the argument is a distribution
9485 file name (recognized by embedded slashes), it is processed. If it is
9486 a module, CPAN determines the distribution file in which this module
9487 is included and processes that, following any dependencies named in
9488 the module's META.yml or Makefile.PL (this behavior is controlled by
9489 the configuration parameter C<prerequisites_policy>.)
9491 C<get> downloads a distribution file and untars or unzips it, C<make>
9492 builds it, C<test> runs the test suite, and C<install> installs it.
9494 Any C<make> or C<test> are run unconditionally. An
9496 install <distribution_file>
9498 also is run unconditionally. But for
9502 CPAN checks if an install is actually needed for it and prints
9503 I<module up to date> in the case that the distribution file containing
9504 the module doesn't need to be updated.
9506 CPAN also keeps track of what it has done within the current session
9507 and doesn't try to build a package a second time regardless if it
9508 succeeded or not. It does not repeat a test run if the test
9509 has been run successfully before. Same for install runs.
9511 The C<force> pragma may precede another command (currently: C<get>,
9512 C<make>, C<test>, or C<install>) and executes the command from scratch
9513 and tries to continue in case of some errors. See the section below on
9514 the C<force> and the C<fforce> pragma.
9516 The C<notest> pragma may be used to skip the test part in the build
9521 cpan> notest install Tk
9523 A C<clean> command results in a
9527 being executed within the distribution file's working directory.
9529 =item C<readme>, C<perldoc>, C<look> module or distribution
9531 C<readme> displays the README file of the associated distribution.
9532 C<Look> gets and untars (if not yet done) the distribution file,
9533 changes to the appropriate directory and opens a subshell process in
9534 that directory. C<perldoc> displays the pod documentation of the
9535 module in html or plain text format.
9539 =item C<ls> globbing_expression
9541 The first form lists all distribution files in and below an author's
9542 CPAN directory as they are stored in the CHECKUMS files distributed on
9543 CPAN. The listing goes recursive into all subdirectories.
9545 The second form allows to limit or expand the output with shell
9546 globbing as in the following examples:
9552 The last example is very slow and outputs extra progress indicators
9553 that break the alignment of the result.
9555 Note that globbing only lists directories explicitly asked for, for
9556 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
9557 regarded as a bug and may be changed in future versions.
9561 The C<failed> command reports all distributions that failed on one of
9562 C<make>, C<test> or C<install> for some reason in the currently
9563 running shell session.
9565 =item Persistence between sessions
9567 If the C<YAML> or the c<YAML::Syck> module is installed a record of
9568 the internal state of all modules is written to disk after each step.
9569 The files contain a signature of the currently running perl version
9572 If the configurations variable C<build_dir_reuse> is set to a true
9573 value, then CPAN.pm reads the collected YAML files. If the stored
9574 signature matches the currently running perl the stored state is
9575 loaded into memory such that effectively persistence between sessions
9578 =item The C<force> and the C<fforce> pragma
9580 To speed things up in complex installation scenarios, CPAN.pm keeps
9581 track of what it has already done and refuses to do some things a
9582 second time. A C<get>, a C<make>, and an C<install> are not repeated.
9583 A C<test> is only repeated if the previous test was unsuccessful. The
9584 diagnostic message when CPAN.pm refuses to do something a second time
9585 is one of I<Has already been >C<unwrapped|made|tested successfully> or
9586 something similar. Another situation where CPAN refuses to act is an
9587 C<install> if the according C<test> was not successful.
9589 In all these cases, the user can override the goatish behaviour by
9590 prepending the command with the word force, for example:
9593 cpan> force make AUTHOR/Bar-3.14.tar.gz
9594 cpan> force test Baz
9595 cpan> force install Acme::Meta
9597 Each I<forced> command is executed with the according part of its
9600 The C<fforce> pragma is a variant that emulates a C<force get> which
9601 erases the entire memory followed by the action specified, effectively
9602 restarting the whole get/make/test/install procedure from scratch.
9606 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>.
9607 Batch jobs can run without a lockfile and do not disturb each other.
9609 The shell offers to run in I<degraded mode> when another process is
9610 holding the lockfile. This is an experimental feature that is not yet
9611 tested very well. This second shell then does not write the history
9612 file, does not use the metadata file and has a different prompt.
9616 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
9617 in the cpan-shell it is intended that you can press C<^C> anytime and
9618 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
9619 to clean up and leave the shell loop. You can emulate the effect of a
9620 SIGTERM by sending two consecutive SIGINTs, which usually means by
9621 pressing C<^C> twice.
9623 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
9624 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
9625 Build.PL> subprocess.
9631 The commands that are available in the shell interface are methods in
9632 the package CPAN::Shell. If you enter the shell command, all your
9633 input is split by the Text::ParseWords::shellwords() routine which
9634 acts like most shells do. The first word is being interpreted as the
9635 method to be called and the rest of the words are treated as arguments
9636 to this method. Continuation lines are supported if a line ends with a
9641 C<autobundle> writes a bundle file into the
9642 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
9643 a list of all modules that are both available from CPAN and currently
9644 installed within @INC. The name of the bundle file is based on the
9645 current date and a counter.
9649 Note: this feature is still in alpha state and may change in future
9652 This commands provides a statistical overview over recent download
9653 activities. The data for this is collected in the YAML file
9654 C<FTPstats.yml> in your C<cpan_home> directory. If no YAML module is
9655 configured or YAML not installed, then no stats are provided.
9659 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
9660 directory so that you can save your own preferences instead of the
9665 recompile() is a very special command in that it takes no argument and
9666 runs the make/test/install cycle with brute force over all installed
9667 dynamically loadable extensions (aka XS modules) with 'force' in
9668 effect. The primary purpose of this command is to finish a network
9669 installation. Imagine, you have a common source tree for two different
9670 architectures. You decide to do a completely independent fresh
9671 installation. You start on one architecture with the help of a Bundle
9672 file produced earlier. CPAN installs the whole Bundle for you, but
9673 when you try to repeat the job on the second architecture, CPAN
9674 responds with a C<"Foo up to date"> message for all modules. So you
9675 invoke CPAN's recompile on the second architecture and you're done.
9677 Another popular use for C<recompile> is to act as a rescue in case your
9678 perl breaks binary compatibility. If one of the modules that CPAN uses
9679 is in turn depending on binary compatibility (so you cannot run CPAN
9680 commands), then you should try the CPAN::Nox module for recovery.
9682 =head2 report Bundle|Distribution|Module
9684 The C<report> command temporarily turns on the C<test_report> config
9685 variable, then runs the C<force test> command with the given
9686 arguments. The C<force> pragma is used to re-run the tests and repeat
9687 every step that might have failed before.
9689 =head2 upgrade [Module|/Regex/]...
9691 The C<upgrade> command first runs an C<r> command with the given
9692 arguments and then installs the newest versions of all modules that
9693 were listed by that.
9695 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
9697 Although it may be considered internal, the class hierarchy does matter
9698 for both users and programmer. CPAN.pm deals with above mentioned four
9699 classes, and all those classes share a set of methods. A classical
9700 single polymorphism is in effect. A metaclass object registers all
9701 objects of all kinds and indexes them with a string. The strings
9702 referencing objects have a separated namespace (well, not completely
9707 words containing a "/" (slash) Distribution
9708 words starting with Bundle:: Bundle
9709 everything else Module or Author
9711 Modules know their associated Distribution objects. They always refer
9712 to the most recent official release. Developers may mark their releases
9713 as unstable development versions (by inserting an underbar into the
9714 module version number which will also be reflected in the distribution
9715 name when you run 'make dist'), so the really hottest and newest
9716 distribution is not always the default. If a module Foo circulates
9717 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
9718 way to install version 1.23 by saying
9722 This would install the complete distribution file (say
9723 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
9724 like to install version 1.23_90, you need to know where the
9725 distribution file resides on CPAN relative to the authors/id/
9726 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
9727 so you would have to say
9729 install BAR/Foo-1.23_90.tar.gz
9731 The first example will be driven by an object of the class
9732 CPAN::Module, the second by an object of class CPAN::Distribution.
9734 =head2 Integrating local directories
9736 Note: this feature is still in alpha state and may change in future
9739 Distribution objects are normally distributions from the CPAN, but
9740 there is a slightly degenerate case for Distribution objects, too, of
9741 projects held on the local disk. These distribution objects have the
9742 same name as the local directory and end with a dot. A dot by itself
9743 is also allowed for the current directory at the time CPAN.pm was
9744 used. All actions such as C<make>, C<test>, and C<install> are applied
9745 directly to that directory. This gives the command C<cpan .> an
9746 interesting touch: while the normal mantra of installing a CPAN module
9747 without CPAN.pm is one of
9749 perl Makefile.PL perl Build.PL
9750 ( go and get prerequisites )
9752 make test ./Build test
9753 make install ./Build install
9755 the command C<cpan .> does all of this at once. It figures out which
9756 of the two mantras is appropriate, fetches and installs all
9757 prerequisites, cares for them recursively and finally finishes the
9758 installation of the module in the current directory, be it a CPAN
9761 The typical usage case is for private modules or working copies of
9762 projects from remote repositories on the local disk.
9764 =head1 CONFIGURATION
9766 When the CPAN module is used for the first time, a configuration
9767 dialog tries to determine a couple of site specific options. The
9768 result of the dialog is stored in a hash reference C< $CPAN::Config >
9769 in a file CPAN/Config.pm.
9771 The default values defined in the CPAN/Config.pm file can be
9772 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
9773 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
9774 added to the search path of the CPAN module before the use() or
9775 require() statements. The mkmyconfig command writes this file for you.
9777 The C<o conf> command has various bells and whistles:
9781 =item completion support
9783 If you have a ReadLine module installed, you can hit TAB at any point
9784 of the commandline and C<o conf> will offer you completion for the
9785 built-in subcommands and/or config variable names.
9787 =item displaying some help: o conf help
9789 Displays a short help
9791 =item displaying current values: o conf [KEY]
9793 Displays the current value(s) for this config variable. Without KEY
9794 displays all subcommands and config variables.
9800 =item changing of scalar values: o conf KEY VALUE
9802 Sets the config variable KEY to VALUE. The empty string can be
9803 specified as usual in shells, with C<''> or C<"">
9807 o conf wget /usr/bin/wget
9809 =item changing of list values: o conf KEY SHIFT|UNSHIFT|PUSH|POP|SPLICE|LIST
9811 If a config variable name ends with C<list>, it is a list. C<o conf
9812 KEY shift> removes the first element of the list, C<o conf KEY pop>
9813 removes the last element of the list. C<o conf KEYS unshift LIST>
9814 prepends a list of values to the list, C<o conf KEYS push LIST>
9815 appends a list of valued to the list.
9817 Likewise, C<o conf KEY splice LIST> passes the LIST to the according
9820 Finally, any other list of arguments is taken as a new list value for
9821 the KEY variable discarding the previous value.
9825 o conf urllist unshift http://cpan.dev.local/CPAN
9826 o conf urllist splice 3 1
9827 o conf urllist http://cpan1.local http://cpan2.local ftp://ftp.perl.org
9829 =item reverting to saved: o conf defaults
9831 Reverts all config variables to the state in the saved config file.
9833 =item saving the config: o conf commit
9835 Saves all config variables to the current config file (CPAN/Config.pm
9836 or CPAN/MyConfig.pm that was loaded at start).
9840 The configuration dialog can be started any time later again by
9841 issuing the command C< o conf init > in the CPAN shell. A subset of
9842 the configuration dialog can be run by issuing C<o conf init WORD>
9843 where WORD is any valid config variable or a regular expression.
9845 =head2 Config Variables
9847 Currently the following keys in the hash reference $CPAN::Config are
9850 applypatch path to external prg
9851 auto_commit commit all changes to config variables to disk
9852 build_cache size of cache for directories to build modules
9853 build_dir locally accessible directory to build modules
9854 build_dir_reuse boolean if distros in build_dir are persistent
9855 build_requires_install_policy
9856 to install or not to install when a module is
9857 only needed for building. yes|no|ask/yes|ask/no
9858 bzip2 path to external prg
9859 cache_metadata use serializer to cache metadata
9860 commands_quote prefered character to use for quoting external
9861 commands when running them. Defaults to double
9862 quote on Windows, single tick everywhere else;
9863 can be set to space to disable quoting
9864 check_sigs if signatures should be verified
9865 colorize_debug Term::ANSIColor attributes for debugging output
9866 colorize_output boolean if Term::ANSIColor should colorize output
9867 colorize_print Term::ANSIColor attributes for normal output
9868 colorize_warn Term::ANSIColor attributes for warnings
9869 commandnumber_in_prompt
9870 boolean if you want to see current command number
9871 cpan_home local directory reserved for this package
9872 curl path to external prg
9873 dontload_hash DEPRECATED
9874 dontload_list arrayref: modules in the list will not be
9875 loaded by the CPAN::has_inst() routine
9876 ftp path to external prg
9877 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
9878 ftp_proxy proxy host for ftp requests
9880 gpg path to external prg
9881 gzip location of external program gzip
9882 histfile file to maintain history between sessions
9883 histsize maximum number of lines to keep in histfile
9884 http_proxy proxy host for http requests
9885 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
9886 after this many seconds inactivity. Set to 0 to
9888 index_expire after this many days refetch index files
9889 inhibit_startup_message
9890 if true, does not print the startup message
9891 keep_source_where directory in which to keep the source (if we do)
9892 lynx path to external prg
9893 make location of external make program
9894 make_arg arguments that should always be passed to 'make'
9895 make_install_make_command
9896 the make command for running 'make install', for
9898 make_install_arg same as make_arg for 'make install'
9899 makepl_arg arguments passed to 'perl Makefile.PL'
9900 mbuild_arg arguments passed to './Build'
9901 mbuild_install_arg arguments passed to './Build install'
9902 mbuild_install_build_command
9903 command to use instead of './Build' when we are
9904 in the install stage, for example 'sudo ./Build'
9905 mbuildpl_arg arguments passed to 'perl Build.PL'
9906 ncftp path to external prg
9907 ncftpget path to external prg
9908 no_proxy don't proxy to these hosts/domains (comma separated list)
9909 pager location of external program more (or any pager)
9910 password your password if you CPAN server wants one
9911 patch path to external prg
9912 prefer_installer legal values are MB and EUMM: if a module comes
9913 with both a Makefile.PL and a Build.PL, use the
9914 former (EUMM) or the latter (MB); if the module
9915 comes with only one of the two, that one will be
9917 prerequisites_policy
9918 what to do if you are missing module prerequisites
9919 ('follow' automatically, 'ask' me, or 'ignore')
9920 prefs_dir local directory to store per-distro build options
9921 proxy_user username for accessing an authenticating proxy
9922 proxy_pass password for accessing an authenticating proxy
9923 randomize_urllist add some randomness to the sequence of the urllist
9924 scan_cache controls scanning of cache ('atstart' or 'never')
9925 shell your favorite shell
9926 show_upload_date boolean if commands should try to determine upload date
9927 tar location of external program tar
9928 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
9929 (and nonsense for characters outside latin range)
9930 term_ornaments boolean to turn ReadLine ornamenting on/off
9931 test_report email test reports (if CPAN::Reporter is installed)
9932 unzip location of external program unzip
9933 urllist arrayref to nearby CPAN sites (or equivalent locations)
9934 use_sqlite use CPAN::SQLite for metadata storage (fast and lean)
9935 username your username if you CPAN server wants one
9936 wait_list arrayref to a wait server to try (See CPAN::WAIT)
9937 wget path to external prg
9938 yaml_module which module to use to read/write YAML files
9940 You can set and query each of these options interactively in the cpan
9941 shell with the C<o conf> or the C<o conf init> command as specified below.
9945 =item C<o conf E<lt>scalar optionE<gt>>
9947 prints the current value of the I<scalar option>
9949 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
9951 Sets the value of the I<scalar option> to I<value>
9953 =item C<o conf E<lt>list optionE<gt>>
9955 prints the current value of the I<list option> in MakeMaker's
9958 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
9960 shifts or pops the array in the I<list option> variable
9962 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
9964 works like the corresponding perl commands.
9966 =item interactive editing: o conf init [MATCH|LIST]
9968 Runs an interactive configuration dialog for matching variables.
9969 Without argument runs the dialog over all supported config variables.
9970 To specify a MATCH the argument must be enclosed by slashes.
9974 o conf init ftp_passive ftp_proxy
9977 Note: this method of setting config variables often provides more
9978 explanation about the functioning of a variable than the manpage.
9982 =head2 CPAN::anycwd($path): Note on config variable getcwd
9984 CPAN.pm changes the current working directory often and needs to
9985 determine its own current working directory. Per default it uses
9986 Cwd::cwd but if this doesn't work on your system for some reason,
9987 alternatives can be configured according to the following table:
10005 Calls the external command cwd.
10009 =head2 Note on the format of the urllist parameter
10011 urllist parameters are URLs according to RFC 1738. We do a little
10012 guessing if your URL is not compliant, but if you have problems with
10013 C<file> URLs, please try the correct format. Either:
10015 file://localhost/whatever/ftp/pub/CPAN/
10019 file:///home/ftp/pub/CPAN/
10021 =head2 The urllist parameter has CD-ROM support
10023 The C<urllist> parameter of the configuration table contains a list of
10024 URLs that are to be used for downloading. If the list contains any
10025 C<file> URLs, CPAN always tries to get files from there first. This
10026 feature is disabled for index files. So the recommendation for the
10027 owner of a CD-ROM with CPAN contents is: include your local, possibly
10028 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
10030 o conf urllist push file://localhost/CDROM/CPAN
10032 CPAN.pm will then fetch the index files from one of the CPAN sites
10033 that come at the beginning of urllist. It will later check for each
10034 module if there is a local copy of the most recent version.
10036 Another peculiarity of urllist is that the site that we could
10037 successfully fetch the last file from automatically gets a preference
10038 token and is tried as the first site for the next request. So if you
10039 add a new site at runtime it may happen that the previously preferred
10040 site will be tried another time. This means that if you want to disallow
10041 a site for the next transfer, it must be explicitly removed from
10044 =head2 Maintaining the urllist parameter
10046 If you have YAML.pm (or some other YAML module configured in
10047 C<yaml_module>) installed, CPAN.pm collects a few statistical data
10048 about recent downloads. You can view the statistics with the C<hosts>
10049 command or inspect them directly by looking into the C<FTPstats.yml>
10050 file in your C<cpan_home> directory.
10052 To get some interesting statistics it is recommended to set the
10053 C<randomize_urllist> parameter that introduces some amount of
10054 randomness into the URL selection.
10056 =head2 The C<requires> and C<build_requires> dependency declarations
10058 Since CPAN.pm version 1.88_51 modules declared as C<build_requires> by
10059 a distribution are treated differently depending on the config
10060 variable C<build_requires_install_policy>. By setting
10061 C<build_requires_install_policy> to C<no> such a module is not being
10062 installed. It is only built and tested and then kept in the list of
10063 tested but uninstalled modules. As such it is available during the
10064 build of the dependent module by integrating the path to the
10065 C<blib/arch> and C<blib/lib> directories in the environment variable
10066 PERL5LIB. If C<build_requires_install_policy> is set ti C<yes>, then
10067 both modules declared as C<requires> and those declared as
10068 C<build_requires> are treated alike. By setting to C<ask/yes> or
10069 C<ask/no>, CPAN.pm asks the user and sets the default accordingly.
10071 =head2 Configuration for individual distributions (I<Distroprefs>)
10073 (B<Note:> This feature has been introduced in CPAN.pm 1.8854 and is
10074 still considered beta quality)
10076 Distributions on the CPAN usually behave according to what we call the
10077 CPAN mantra. Or since the event of Module::Build we should talk about
10080 perl Makefile.PL perl Build.PL
10082 make test ./Build test
10083 make install ./Build install
10085 But some modules cannot be built with this mantra. They try to get
10086 some extra data from the user via the environment, extra arguments or
10087 interactively thus disturbing the installation of large bundles like
10088 Phalanx100 or modules with many dependencies like Plagger.
10090 The distroprefs system of C<CPAN.pm> addresses this problem by
10091 allowing the user to specify extra informations and recipes in YAML
10098 pass additional arguments to one of the four commands,
10102 set environment variables
10106 instantiate an Expect object that reads from the console, waits for
10107 some regular expressions and enters some answers
10111 temporarily override assorted C<CPAN.pm> configuration variables
10115 disable the installation of an object altogether
10119 See the YAML and Data::Dumper files that come with the C<CPAN.pm>
10120 distribution in the C<distroprefs/> directory for examples.
10124 The YAML files themselves must have the C<.yml> extension, all other
10125 files are ignored (for two exceptions see I<Fallback Data::Dumper and
10126 Storable> below). The containing directory can be specified in
10127 C<CPAN.pm> in the C<prefs_dir> config variable. Try C<o conf init
10128 prefs_dir> in the CPAN shell to set and activate the distroprefs
10131 Every YAML file may contain arbitrary documents according to the YAML
10132 specification and every single document is treated as an entity that
10133 can specify the treatment of a single distribution.
10135 The names of the files can be picked freely, C<CPAN.pm> always reads
10136 all files (in alphabetical order) and takes the key C<match> (see
10137 below in I<Language Specs>) as a hashref containing match criteria
10138 that determine if the current distribution matches the YAML document
10141 =head2 Fallback Data::Dumper and Storable
10143 If neither your configured C<yaml_module> nor YAML.pm is installed
10144 CPAN.pm falls back to using Data::Dumper and Storable and looks for
10145 files with the extensions C<.dd> or C<.st> in the C<prefs_dir>
10146 directory. These files are expected to contain one or more hashrefs.
10147 For Data::Dumper generated files, this is expected to be done with by
10148 defining C<$VAR1>, C<$VAR2>, etc. The YAML shell would produce these
10151 ysh < somefile.yml > somefile.dd
10153 For Storable files the rule is that they must be constructed such that
10154 C<Storable::retrieve(file)> returns an array reference and the array
10155 elements represent one distropref object each. The conversion from
10156 YAML would look like so:
10158 perl -MYAML=LoadFile -MStorable=nstore -e '
10159 @y=LoadFile(shift);
10160 nstore(\@y, shift)' somefile.yml somefile.st
10162 In bootstrapping situations it is usually sufficient to translate only
10163 a few YAML files to Data::Dumper for the crucial modules like
10164 C<YAML::Syck>, C<YAML.pm> and C<Expect.pm>. If you prefer Storable
10165 over Data::Dumper, remember to pull out a Storable version that writes
10166 an older format than all the other Storable versions that will need to
10171 The following example contains all supported keywords and structures
10172 with the exception of C<eexpect> which can be used instead of
10178 module: "Dancing::Queen"
10179 distribution: "^CHACHACHA/Dancing-"
10180 perl: "/usr/local/cariba-perl/bin/perl"
10186 - "--somearg=specialcase"
10191 - "Which is your favorite fruit"
10203 commendline: "echo SKIPPING make"
10216 WANT_TO_INSTALL: YES
10219 - "Do you really want to install"
10223 - "ABCDE/Fedcba-3.14-ABCDE-01.patch"
10226 =head2 Language Specs
10228 Every YAML document represents a single hash reference. The valid keys
10229 in this hash are as follows:
10233 =item comment [scalar]
10237 =item cpanconfig [hash]
10239 Temporarily override assorted C<CPAN.pm> configuration variables.
10241 Supported are: C<build_requires_install_policy>, C<check_sigs>,
10242 C<make>, C<make_install_make_command>, C<prefer_installer>,
10243 C<test_report>. Please report as a bug when you need another one
10246 =item disabled [boolean]
10248 Specifies that this distribution shall not be processed at all.
10250 =item goto [string]
10252 The canonical name of a delegate distribution that shall be installed
10253 instead. Useful when a new version, although it tests OK itself,
10254 breaks something else or a developer release or a fork is already
10255 uploaded that is better than the last released version.
10257 =item install [hash]
10259 Processing instructions for the C<make install> or C<./Build install>
10260 phase of the CPAN mantra. See below under I<Processiong Instructions>.
10264 Processing instructions for the C<make> or C<./Build> phase of the
10265 CPAN mantra. See below under I<Processiong Instructions>.
10269 A hashref with one or more of the keys C<distribution>, C<modules>, or
10270 C<perl> that specify if a document is targeted at a specific CPAN
10273 The corresponding values are interpreted as regular expressions. The
10274 C<distribution> related one will be matched against the canonical
10275 distribution name, e.g. "AUTHOR/Foo-Bar-3.14.tar.gz".
10277 The C<module> related one will be matched against I<all> modules
10278 contained in the distribution until one module matches.
10280 The C<perl> related one will be matched against C<$^X>.
10282 If more than one restriction of C<module>, C<distribution>, and
10283 C<perl> is specified, the results of the separately computed match
10284 values must all match. If this is the case then the hashref
10285 represented by the YAML document is returned as the preference
10286 structure for the current distribution.
10288 =item patches [array]
10290 An array of patches on CPAN or on the local disk to be applied in
10291 order via the external patch program. If the value for the C<-p>
10292 parameter is C<0> or C<1> is determined by reading the patch
10295 Note: if the C<applypatch> program is installed and C<CPAN::Config>
10296 knows about it B<and> a patch is written by the C<makepatch> program,
10297 then C<CPAN.pm> lets C<applypatch> apply the patch. Both C<makepatch>
10298 and C<applypatch> are available from CPAN in the C<JV/makepatch-*>
10303 Processing instructions for the C<perl Makefile.PL> or C<perl
10304 Build.PL> phase of the CPAN mantra. See below under I<Processiong
10309 Processing instructions for the C<make test> or C<./Build test> phase
10310 of the CPAN mantra. See below under I<Processiong Instructions>.
10314 =head2 Processing Instructions
10320 Arguments to be added to the command line
10324 A full commandline that will be executed as it stands by a system
10325 call. During the execution the environment variable PERL will is set
10326 to $^X. If C<commandline> is specified, the content of C<args> is not
10329 =item eexpect [hash]
10331 Extended C<expect>. This is a hash reference with three allowed keys,
10332 C<mode>, C<timeout>, and C<talk>.
10334 C<mode> may have the values C<deterministic> for the case where all
10335 questions come in the order written down and C<anyorder> for the case
10336 where the questions may come in any order. The default mode is
10339 C<timeout> denotes a timeout in seconds. Floating point timeouts are
10340 OK. In the case of a C<mode=deterministic> the timeout denotes the
10341 timeout per question, in the case of C<mode=anyorder> it denotes the
10342 timeout per byte received from the stream or questions.
10344 C<talk> is a reference to an array that contains alternating questions
10345 and answers. Questions are regular expressions and answers are literal
10346 strings. The Expect module will then watch the stream coming from the
10347 execution of the external program (C<perl Makefile.PL>, C<perl
10348 Build.PL>, C<make>, etc.).
10350 In the case of C<mode=deterministic> the CPAN.pm will inject the
10351 according answer as soon as the stream matches the regular expression.
10352 In the case of C<mode=anyorder> the CPAN.pm will answer a question as
10353 soon as the timeout is reached for the next byte in the input stream.
10354 In the latter case it removes the according question/answer pair from
10355 the array, so if you want to answer the question C<Do you really want
10356 to do that> several times, then it must be included in the array at
10357 least as often as you want this answer to be given.
10361 Environment variables to be set during the command
10363 =item expect [array]
10365 C<< expect: <array> >> is a short notation for
10368 mode: deterministic
10374 =head2 Schema verification with C<Kwalify>
10376 If you have the C<Kwalify> module installed (which is part of the
10377 Bundle::CPANxxl), then all your distroprefs files are checked for
10378 syntactical correctness.
10380 =head2 Example Distroprefs Files
10382 C<CPAN.pm> comes with a collection of example YAML files. Note that these
10383 are really just examples and should not be used without care because
10384 they cannot fit everybody's purpose. After all the authors of the
10385 packages that ask questions had a need to ask, so you should watch
10386 their questions and adjust the examples to your environment and your
10387 needs. You have beend warned:-)
10389 =head1 PROGRAMMER'S INTERFACE
10391 If you do not enter the shell, the available shell commands are both
10392 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
10393 functions in the calling package (C<install(...)>). Before calling low-level
10394 commands it makes sense to initialize components of CPAN you need, e.g.:
10396 CPAN::HandleConfig->load;
10397 CPAN::Shell::setup_output;
10398 CPAN::Index->reload;
10400 High-level commands do such initializations automatically.
10402 There's currently only one class that has a stable interface -
10403 CPAN::Shell. All commands that are available in the CPAN shell are
10404 methods of the class CPAN::Shell. Each of the commands that produce
10405 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
10406 the IDs of all modules within the list.
10410 =item expand($type,@things)
10412 The IDs of all objects available within a program are strings that can
10413 be expanded to the corresponding real objects with the
10414 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
10415 list of CPAN::Module objects according to the C<@things> arguments
10416 given. In scalar context it only returns the first element of the
10419 =item expandany(@things)
10421 Like expand, but returns objects of the appropriate type, i.e.
10422 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
10423 CPAN::Distribution objects for distributions. Note: it does not expand
10424 to CPAN::Author objects.
10426 =item Programming Examples
10428 This enables the programmer to do operations that combine
10429 functionalities that are available in the shell.
10431 # install everything that is outdated on my disk:
10432 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
10434 # install my favorite programs if necessary:
10435 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
10436 CPAN::Shell->install($mod);
10439 # list all modules on my disk that have no VERSION number
10440 for $mod (CPAN::Shell->expand("Module","/./")){
10441 next unless $mod->inst_file;
10442 # MakeMaker convention for undefined $VERSION:
10443 next unless $mod->inst_version eq "undef";
10444 print "No VERSION in ", $mod->id, "\n";
10447 # find out which distribution on CPAN contains a module:
10448 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
10450 Or if you want to write a cronjob to watch The CPAN, you could list
10451 all modules that need updating. First a quick and dirty way:
10453 perl -e 'use CPAN; CPAN::Shell->r;'
10455 If you don't want to get any output in the case that all modules are
10456 up to date, you can parse the output of above command for the regular
10457 expression //modules are up to date// and decide to mail the output
10458 only if it doesn't match. Ick?
10460 If you prefer to do it more in a programmer style in one single
10461 process, maybe something like this suits you better:
10463 # list all modules on my disk that have newer versions on CPAN
10464 for $mod (CPAN::Shell->expand("Module","/./")){
10465 next unless $mod->inst_file;
10466 next if $mod->uptodate;
10467 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
10468 $mod->id, $mod->inst_version, $mod->cpan_version;
10471 If that gives you too much output every day, you maybe only want to
10472 watch for three modules. You can write
10474 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
10476 as the first line instead. Or you can combine some of the above
10479 # watch only for a new mod_perl module
10480 $mod = CPAN::Shell->expand("Module","mod_perl");
10481 exit if $mod->uptodate;
10482 # new mod_perl arrived, let me know all update recommendations
10487 =head2 Methods in the other Classes
10491 =item CPAN::Author::as_glimpse()
10493 Returns a one-line description of the author
10495 =item CPAN::Author::as_string()
10497 Returns a multi-line description of the author
10499 =item CPAN::Author::email()
10501 Returns the author's email address
10503 =item CPAN::Author::fullname()
10505 Returns the author's name
10507 =item CPAN::Author::name()
10509 An alias for fullname
10511 =item CPAN::Bundle::as_glimpse()
10513 Returns a one-line description of the bundle
10515 =item CPAN::Bundle::as_string()
10517 Returns a multi-line description of the bundle
10519 =item CPAN::Bundle::clean()
10521 Recursively runs the C<clean> method on all items contained in the bundle.
10523 =item CPAN::Bundle::contains()
10525 Returns a list of objects' IDs contained in a bundle. The associated
10526 objects may be bundles, modules or distributions.
10528 =item CPAN::Bundle::force($method,@args)
10530 Forces CPAN to perform a task that it normally would have refused to
10531 do. Force takes as arguments a method name to be called and any number
10532 of additional arguments that should be passed to the called method.
10533 The internals of the object get the needed changes so that CPAN.pm
10534 does not refuse to take the action. The C<force> is passed recursively
10535 to all contained objects. See also the section above on the C<force>
10536 and the C<fforce> pragma.
10538 =item CPAN::Bundle::get()
10540 Recursively runs the C<get> method on all items contained in the bundle
10542 =item CPAN::Bundle::inst_file()
10544 Returns the highest installed version of the bundle in either @INC or
10545 C<$CPAN::Config->{cpan_home}>. Note that this is different from
10546 CPAN::Module::inst_file.
10548 =item CPAN::Bundle::inst_version()
10550 Like CPAN::Bundle::inst_file, but returns the $VERSION
10552 =item CPAN::Bundle::uptodate()
10554 Returns 1 if the bundle itself and all its members are uptodate.
10556 =item CPAN::Bundle::install()
10558 Recursively runs the C<install> method on all items contained in the bundle
10560 =item CPAN::Bundle::make()
10562 Recursively runs the C<make> method on all items contained in the bundle
10564 =item CPAN::Bundle::readme()
10566 Recursively runs the C<readme> method on all items contained in the bundle
10568 =item CPAN::Bundle::test()
10570 Recursively runs the C<test> method on all items contained in the bundle
10572 =item CPAN::Distribution::as_glimpse()
10574 Returns a one-line description of the distribution
10576 =item CPAN::Distribution::as_string()
10578 Returns a multi-line description of the distribution
10580 =item CPAN::Distribution::author
10582 Returns the CPAN::Author object of the maintainer who uploaded this
10585 =item CPAN::Distribution::clean()
10587 Changes to the directory where the distribution has been unpacked and
10588 runs C<make clean> there.
10590 =item CPAN::Distribution::containsmods()
10592 Returns a list of IDs of modules contained in a distribution file.
10593 Only works for distributions listed in the 02packages.details.txt.gz
10594 file. This typically means that only the most recent version of a
10595 distribution is covered.
10597 =item CPAN::Distribution::cvs_import()
10599 Changes to the directory where the distribution has been unpacked and
10600 runs something like
10602 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
10606 =item CPAN::Distribution::dir()
10608 Returns the directory into which this distribution has been unpacked.
10610 =item CPAN::Distribution::force($method,@args)
10612 Forces CPAN to perform a task that it normally would have refused to
10613 do. Force takes as arguments a method name to be called and any number
10614 of additional arguments that should be passed to the called method.
10615 The internals of the object get the needed changes so that CPAN.pm
10616 does not refuse to take the action. See also the section above on the
10617 C<force> and the C<fforce> pragma.
10619 =item CPAN::Distribution::get()
10621 Downloads the distribution from CPAN and unpacks it. Does nothing if
10622 the distribution has already been downloaded and unpacked within the
10625 =item CPAN::Distribution::install()
10627 Changes to the directory where the distribution has been unpacked and
10628 runs the external command C<make install> there. If C<make> has not
10629 yet been run, it will be run first. A C<make test> will be issued in
10630 any case and if this fails, the install will be canceled. The
10631 cancellation can be avoided by letting C<force> run the C<install> for
10634 This install method has only the power to install the distribution if
10635 there are no dependencies in the way. To install an object and all of
10636 its dependencies, use CPAN::Shell->install.
10638 Note that install() gives no meaningful return value. See uptodate().
10640 =item CPAN::Distribution::install_tested()
10642 Install all the distributions that have been tested sucessfully but
10643 not yet installed. See also C<is_tested>.
10645 =item CPAN::Distribution::isa_perl()
10647 Returns 1 if this distribution file seems to be a perl distribution.
10648 Normally this is derived from the file name only, but the index from
10649 CPAN can contain a hint to achieve a return value of true for other
10652 =item CPAN::Distribution::is_tested()
10654 List all the distributions that have been tested sucessfully but not
10655 yet installed. See also C<install_tested>.
10657 =item CPAN::Distribution::look()
10659 Changes to the directory where the distribution has been unpacked and
10660 opens a subshell there. Exiting the subshell returns.
10662 =item CPAN::Distribution::make()
10664 First runs the C<get> method to make sure the distribution is
10665 downloaded and unpacked. Changes to the directory where the
10666 distribution has been unpacked and runs the external commands C<perl
10667 Makefile.PL> or C<perl Build.PL> and C<make> there.
10669 =item CPAN::Distribution::perldoc()
10671 Downloads the pod documentation of the file associated with a
10672 distribution (in html format) and runs it through the external
10673 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
10674 isn't available, it converts it to plain text with external
10675 command html2text and runs it through the pager specified
10676 in C<$CPAN::Config->{pager}>
10678 =item CPAN::Distribution::prefs()
10680 Returns the hash reference from the first matching YAML file that the
10681 user has deposited in the C<prefs_dir/> directory. The first
10682 succeeding match wins. The files in the C<prefs_dir/> are processed
10683 alphabetically and the canonical distroname (e.g.
10684 AUTHOR/Foo-Bar-3.14.tar.gz) is matched against the regular expressions
10685 stored in the $root->{match}{distribution} attribute value.
10686 Additionally all module names contained in a distribution are matched
10687 agains the regular expressions in the $root->{match}{module} attribute
10688 value. The two match values are ANDed together. Each of the two
10689 attributes are optional.
10691 =item CPAN::Distribution::prereq_pm()
10693 Returns the hash reference that has been announced by a distribution
10694 as the the C<requires> and C<build_requires> elements. These can be
10695 declared either by the C<META.yml> (if authoritative) or can be
10696 deposited after the run of C<Build.PL> in the file C<./_build/prereqs>
10697 or after the run of C<Makfile.PL> written as the C<PREREQ_PM> hash in
10698 a comment in the produced C<Makefile>. I<Note>: this method only works
10699 after an attempt has been made to C<make> the distribution. Returns
10702 =item CPAN::Distribution::readme()
10704 Downloads the README file associated with a distribution and runs it
10705 through the pager specified in C<$CPAN::Config->{pager}>.
10707 =item CPAN::Distribution::read_yaml()
10709 Returns the content of the META.yml of this distro as a hashref. Note:
10710 works only after an attempt has been made to C<make> the distribution.
10711 Returns undef otherwise. Also returns undef if the content of META.yml
10712 is not authoritative. (The rules about what exactly makes the content
10713 authoritative are still in flux.)
10715 =item CPAN::Distribution::test()
10717 Changes to the directory where the distribution has been unpacked and
10718 runs C<make test> there.
10720 =item CPAN::Distribution::uptodate()
10722 Returns 1 if all the modules contained in the distribution are
10723 uptodate. Relies on containsmods.
10725 =item CPAN::Index::force_reload()
10727 Forces a reload of all indices.
10729 =item CPAN::Index::reload()
10731 Reloads all indices if they have not been read for more than
10732 C<$CPAN::Config->{index_expire}> days.
10734 =item CPAN::InfoObj::dump()
10736 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
10737 inherit this method. It prints the data structure associated with an
10738 object. Useful for debugging. Note: the data structure is considered
10739 internal and thus subject to change without notice.
10741 =item CPAN::Module::as_glimpse()
10743 Returns a one-line description of the module in four columns: The
10744 first column contains the word C<Module>, the second column consists
10745 of one character: an equals sign if this module is already installed
10746 and uptodate, a less-than sign if this module is installed but can be
10747 upgraded, and a space if the module is not installed. The third column
10748 is the name of the module and the fourth column gives maintainer or
10749 distribution information.
10751 =item CPAN::Module::as_string()
10753 Returns a multi-line description of the module
10755 =item CPAN::Module::clean()
10757 Runs a clean on the distribution associated with this module.
10759 =item CPAN::Module::cpan_file()
10761 Returns the filename on CPAN that is associated with the module.
10763 =item CPAN::Module::cpan_version()
10765 Returns the latest version of this module available on CPAN.
10767 =item CPAN::Module::cvs_import()
10769 Runs a cvs_import on the distribution associated with this module.
10771 =item CPAN::Module::description()
10773 Returns a 44 character description of this module. Only available for
10774 modules listed in The Module List (CPAN/modules/00modlist.long.html
10775 or 00modlist.long.txt.gz)
10777 =item CPAN::Module::distribution()
10779 Returns the CPAN::Distribution object that contains the current
10780 version of this module.
10782 =item CPAN::Module::dslip_status()
10784 Returns a hash reference. The keys of the hash are the letters C<D>,
10785 C<S>, C<L>, C<I>, and <P>, for development status, support level,
10786 language, interface and public licence respectively. The data for the
10787 DSLIP status are collected by pause.perl.org when authors register
10788 their namespaces. The values of the 5 hash elements are one-character
10789 words whose meaning is described in the table below. There are also 5
10790 hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
10791 verbose value of the 5 status variables.
10793 Where the 'DSLIP' characters have the following meanings:
10795 D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
10796 i - Idea, listed to gain consensus or as a placeholder
10797 c - under construction but pre-alpha (not yet released)
10798 a/b - Alpha/Beta testing
10800 M - Mature (no rigorous definition)
10801 S - Standard, supplied with Perl 5
10806 u - Usenet newsgroup comp.lang.perl.modules
10807 n - None known, try comp.lang.perl.modules
10808 a - abandoned; volunteers welcome to take over maintainance
10811 p - Perl-only, no compiler needed, should be platform independent
10812 c - C and perl, a C compiler will be needed
10813 h - Hybrid, written in perl with optional C code, no compiler needed
10814 + - C++ and perl, a C++ compiler will be needed
10815 o - perl and another language other than C or C++
10817 I - Interface Style
10818 f - plain Functions, no references used
10819 h - hybrid, object and function interfaces available
10820 n - no interface at all (huh?)
10821 r - some use of unblessed References or ties
10822 O - Object oriented using blessed references and/or inheritance
10825 p - Standard-Perl: user may choose between GPL and Artistic
10826 g - GPL: GNU General Public License
10827 l - LGPL: "GNU Lesser General Public License" (previously known as
10828 "GNU Library General Public License")
10829 b - BSD: The BSD License
10830 a - Artistic license alone
10831 o - open source: appoved by www.opensource.org
10832 d - allows distribution without restrictions
10833 r - restricted distribtion
10834 n - no license at all
10836 =item CPAN::Module::force($method,@args)
10838 Forces CPAN to perform a task that it normally would have refused to
10839 do. Force takes as arguments a method name to be called and any number
10840 of additional arguments that should be passed to the called method.
10841 The internals of the object get the needed changes so that CPAN.pm
10842 does not refuse to take the action. See also the section above on the
10843 C<force> and the C<fforce> pragma.
10845 =item CPAN::Module::get()
10847 Runs a get on the distribution associated with this module.
10849 =item CPAN::Module::inst_file()
10851 Returns the filename of the module found in @INC. The first file found
10852 is reported just like perl itself stops searching @INC when it finds a
10855 =item CPAN::Module::available_file()
10857 Returns the filename of the module found in PERL5LIB or @INC. The
10858 first file found is reported. The advantage of this method over
10859 C<inst_file> is that modules that have been tested but not yet
10860 installed are included because PERL5LIB keeps track of tested modules.
10862 =item CPAN::Module::inst_version()
10864 Returns the version number of the installed module in readable format.
10866 =item CPAN::Module::available_version()
10868 Returns the version number of the available module in readable format.
10870 =item CPAN::Module::install()
10872 Runs an C<install> on the distribution associated with this module.
10874 =item CPAN::Module::look()
10876 Changes to the directory where the distribution associated with this
10877 module has been unpacked and opens a subshell there. Exiting the
10880 =item CPAN::Module::make()
10882 Runs a C<make> on the distribution associated with this module.
10884 =item CPAN::Module::manpage_headline()
10886 If module is installed, peeks into the module's manpage, reads the
10887 headline and returns it. Moreover, if the module has been downloaded
10888 within this session, does the equivalent on the downloaded module even
10889 if it is not installed.
10891 =item CPAN::Module::perldoc()
10893 Runs a C<perldoc> on this module.
10895 =item CPAN::Module::readme()
10897 Runs a C<readme> on the distribution associated with this module.
10899 =item CPAN::Module::test()
10901 Runs a C<test> on the distribution associated with this module.
10903 =item CPAN::Module::uptodate()
10905 Returns 1 if the module is installed and up-to-date.
10907 =item CPAN::Module::userid()
10909 Returns the author's ID of the module.
10913 =head2 Cache Manager
10915 Currently the cache manager only keeps track of the build directory
10916 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
10917 deletes complete directories below C<build_dir> as soon as the size of
10918 all directories there gets bigger than $CPAN::Config->{build_cache}
10919 (in MB). The contents of this cache may be used for later
10920 re-installations that you intend to do manually, but will never be
10921 trusted by CPAN itself. This is due to the fact that the user might
10922 use these directories for building modules on different architectures.
10924 There is another directory ($CPAN::Config->{keep_source_where}) where
10925 the original distribution files are kept. This directory is not
10926 covered by the cache manager and must be controlled by the user. If
10927 you choose to have the same directory as build_dir and as
10928 keep_source_where directory, then your sources will be deleted with
10929 the same fifo mechanism.
10933 A bundle is just a perl module in the namespace Bundle:: that does not
10934 define any functions or methods. It usually only contains documentation.
10936 It starts like a perl module with a package declaration and a $VERSION
10937 variable. After that the pod section looks like any other pod with the
10938 only difference being that I<one special pod section> exists starting with
10943 In this pod section each line obeys the format
10945 Module_Name [Version_String] [- optional text]
10947 The only required part is the first field, the name of a module
10948 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
10949 of the line is optional. The comment part is delimited by a dash just
10950 as in the man page header.
10952 The distribution of a bundle should follow the same convention as
10953 other distributions.
10955 Bundles are treated specially in the CPAN package. If you say 'install
10956 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
10957 the modules in the CONTENTS section of the pod. You can install your
10958 own Bundles locally by placing a conformant Bundle file somewhere into
10959 your @INC path. The autobundle() command which is available in the
10960 shell interface does that for you by including all currently installed
10961 modules in a snapshot bundle file.
10963 =head1 PREREQUISITES
10965 If you have a local mirror of CPAN and can access all files with
10966 "file:" URLs, then you only need a perl better than perl5.003 to run
10967 this module. Otherwise Net::FTP is strongly recommended. LWP may be
10968 required for non-UNIX systems or if your nearest CPAN site is
10969 associated with a URL that is not C<ftp:>.
10971 If you have neither Net::FTP nor LWP, there is a fallback mechanism
10972 implemented for an external ftp command or for an external lynx
10977 =head2 Finding packages and VERSION
10979 This module presumes that all packages on CPAN
10985 declare their $VERSION variable in an easy to parse manner. This
10986 prerequisite can hardly be relaxed because it consumes far too much
10987 memory to load all packages into the running program just to determine
10988 the $VERSION variable. Currently all programs that are dealing with
10989 version use something like this
10991 perl -MExtUtils::MakeMaker -le \
10992 'print MM->parse_version(shift)' filename
10994 If you are author of a package and wonder if your $VERSION can be
10995 parsed, please try the above method.
10999 come as compressed or gzipped tarfiles or as zip files and contain a
11000 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
11001 without much enthusiasm).
11007 The debugging of this module is a bit complex, because we have
11008 interferences of the software producing the indices on CPAN, of the
11009 mirroring process on CPAN, of packaging, of configuration, of
11010 synchronicity, and of bugs within CPAN.pm.
11012 For debugging the code of CPAN.pm itself in interactive mode some more
11013 or less useful debugging aid can be turned on for most packages within
11014 CPAN.pm with one of
11018 =item o debug package...
11020 sets debug mode for packages.
11022 =item o debug -package...
11024 unsets debug mode for packages.
11028 turns debugging on for all packages.
11030 =item o debug number
11034 which sets the debugging packages directly. Note that C<o debug 0>
11035 turns debugging off.
11037 What seems quite a successful strategy is the combination of C<reload
11038 cpan> and the debugging switches. Add a new debug statement while
11039 running in the shell and then issue a C<reload cpan> and see the new
11040 debugging messages immediately without losing the current context.
11042 C<o debug> without an argument lists the valid package names and the
11043 current set of packages in debugging mode. C<o debug> has built-in
11044 completion support.
11046 For debugging of CPAN data there is the C<dump> command which takes
11047 the same arguments as make/test/install and outputs each object's
11048 Data::Dumper dump. If an argument looks like a perl variable and
11049 contains one of C<$>, C<@> or C<%>, it is eval()ed and fed to
11050 Data::Dumper directly.
11052 =head2 Floppy, Zip, Offline Mode
11054 CPAN.pm works nicely without network too. If you maintain machines
11055 that are not networked at all, you should consider working with file:
11056 URLs. Of course, you have to collect your modules somewhere first. So
11057 you might use CPAN.pm to put together all you need on a networked
11058 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
11059 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
11060 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
11061 with this floppy. See also below the paragraph about CD-ROM support.
11063 =head2 Basic Utilities for Programmers
11067 =item has_inst($module)
11069 Returns true if the module is installed. Used to load all modules into
11070 the running CPAN.pm which are considered optional. The config variable
11071 C<dontload_list> can be used to intercept the C<has_inst()> call such
11072 that an optional module is not loaded despite being available. For
11073 example the following command will prevent that C<YAML.pm> is being
11076 cpan> o conf dontload_list push YAML
11078 See the source for details.
11080 =item has_usable($module)
11082 Returns true if the module is installed and is in a usable state. Only
11083 useful for a handful of modules that are used internally. See the
11084 source for details.
11086 =item instance($module)
11088 The constructor for all the singletons used to represent modules,
11089 distributions, authors and bundles. If the object already exists, this
11090 method returns the object, otherwise it calls the constructor.
11096 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
11097 install foreign, unmasked, unsigned code on your machine. We compare
11098 to a checksum that comes from the net just as the distribution file
11099 itself. But we try to make it easy to add security on demand:
11101 =head2 Cryptographically signed modules
11103 Since release 1.77 CPAN.pm has been able to verify cryptographically
11104 signed module distributions using Module::Signature. The CPAN modules
11105 can be signed by their authors, thus giving more security. The simple
11106 unsigned MD5 checksums that were used before by CPAN protect mainly
11107 against accidental file corruption.
11109 You will need to have Module::Signature installed, which in turn
11110 requires that you have at least one of Crypt::OpenPGP module or the
11111 command-line F<gpg> tool installed.
11113 You will also need to be able to connect over the Internet to the public
11114 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
11116 The configuration parameter check_sigs is there to turn signature
11117 checking on or off.
11121 Most functions in package CPAN are exported per default. The reason
11122 for this is that the primary use is intended for the cpan shell or for
11127 When the CPAN shell enters a subshell via the look command, it sets
11128 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
11131 When CPAN runs, it sets the environment variable PERL5_CPAN_IS_RUNNING.
11133 When the config variable ftp_passive is set, all downloads will be run
11134 with the environment variable FTP_PASSIVE set to this value. This is
11135 in general a good idea as it influences both Net::FTP and LWP based
11136 connections. The same effect can be achieved by starting the cpan
11137 shell with this environment variable set. For Net::FTP alone, one can
11138 also always set passive mode by running libnetcfg.
11140 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
11142 Populating a freshly installed perl with my favorite modules is pretty
11143 easy if you maintain a private bundle definition file. To get a useful
11144 blueprint of a bundle definition file, the command autobundle can be used
11145 on the CPAN shell command line. This command writes a bundle definition
11146 file for all modules that are installed for the currently running perl
11147 interpreter. It's recommended to run this command only once and from then
11148 on maintain the file manually under a private name, say
11149 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
11151 cpan> install Bundle::my_bundle
11153 then answer a few questions and then go out for a coffee.
11155 Maintaining a bundle definition file means keeping track of two
11156 things: dependencies and interactivity. CPAN.pm sometimes fails on
11157 calculating dependencies because not all modules define all MakeMaker
11158 attributes correctly, so a bundle definition file should specify
11159 prerequisites as early as possible. On the other hand, it's a bit
11160 annoying that many distributions need some interactive configuring. So
11161 what I try to accomplish in my private bundle file is to have the
11162 packages that need to be configured early in the file and the gentle
11163 ones later, so I can go out after a few minutes and leave CPAN.pm
11166 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
11168 Thanks to Graham Barr for contributing the following paragraphs about
11169 the interaction between perl, and various firewall configurations. For
11170 further information on firewalls, it is recommended to consult the
11171 documentation that comes with the ncftp program. If you are unable to
11172 go through the firewall with a simple Perl setup, it is very likely
11173 that you can configure ncftp so that it works for your firewall.
11175 =head2 Three basic types of firewalls
11177 Firewalls can be categorized into three basic types.
11181 =item http firewall
11183 This is where the firewall machine runs a web server and to access the
11184 outside world you must do it via the web server. If you set environment
11185 variables like http_proxy or ftp_proxy to a values beginning with http://
11186 or in your web browser you have to set proxy information then you know
11187 you are running an http firewall.
11189 To access servers outside these types of firewalls with perl (even for
11190 ftp) you will need to use LWP.
11194 This where the firewall machine runs an ftp server. This kind of
11195 firewall will only let you access ftp servers outside the firewall.
11196 This is usually done by connecting to the firewall with ftp, then
11197 entering a username like "user@outside.host.com"
11199 To access servers outside these type of firewalls with perl you
11200 will need to use Net::FTP.
11202 =item One way visibility
11204 I say one way visibility as these firewalls try to make themselves look
11205 invisible to the users inside the firewall. An FTP data connection is
11206 normally created by sending the remote server your IP address and then
11207 listening for the connection. But the remote server will not be able to
11208 connect to you because of the firewall. So for these types of firewall
11209 FTP connections need to be done in a passive mode.
11211 There are two that I can think off.
11217 If you are using a SOCKS firewall you will need to compile perl and link
11218 it with the SOCKS library, this is what is normally called a 'socksified'
11219 perl. With this executable you will be able to connect to servers outside
11220 the firewall as if it is not there.
11222 =item IP Masquerade
11224 This is the firewall implemented in the Linux kernel, it allows you to
11225 hide a complete network behind one IP address. With this firewall no
11226 special compiling is needed as you can access hosts directly.
11228 For accessing ftp servers behind such firewalls you usually need to
11229 set the environment variable C<FTP_PASSIVE> or the config variable
11230 ftp_passive to a true value.
11236 =head2 Configuring lynx or ncftp for going through a firewall
11238 If you can go through your firewall with e.g. lynx, presumably with a
11241 /usr/local/bin/lynx -pscott:tiger
11243 then you would configure CPAN.pm with the command
11245 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
11247 That's all. Similarly for ncftp or ftp, you would configure something
11250 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
11252 Your mileage may vary...
11260 I installed a new version of module X but CPAN keeps saying,
11261 I have the old version installed
11263 Most probably you B<do> have the old version installed. This can
11264 happen if a module installs itself into a different directory in the
11265 @INC path than it was previously installed. This is not really a
11266 CPAN.pm problem, you would have the same problem when installing the
11267 module manually. The easiest way to prevent this behaviour is to add
11268 the argument C<UNINST=1> to the C<make install> call, and that is why
11269 many people add this argument permanently by configuring
11271 o conf make_install_arg UNINST=1
11275 So why is UNINST=1 not the default?
11277 Because there are people who have their precise expectations about who
11278 may install where in the @INC path and who uses which @INC array. In
11279 fine tuned environments C<UNINST=1> can cause damage.
11283 I want to clean up my mess, and install a new perl along with
11284 all modules I have. How do I go about it?
11286 Run the autobundle command for your old perl and optionally rename the
11287 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
11288 with the Configure option prefix, e.g.
11290 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
11292 Install the bundle file you produced in the first step with something like
11294 cpan> install Bundle::mybundle
11300 When I install bundles or multiple modules with one command
11301 there is too much output to keep track of.
11303 You may want to configure something like
11305 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
11306 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
11308 so that STDOUT is captured in a file for later inspection.
11313 I am not root, how can I install a module in a personal directory?
11315 First of all, you will want to use your own configuration, not the one
11316 that your root user installed. If you do not have permission to write
11317 in the cpan directory that root has configured, you will be asked if
11318 you want to create your own config. Answering "yes" will bring you into
11319 CPAN's configuration stage, using the system config for all defaults except
11320 things that have to do with CPAN's work directory, saving your choices to
11321 your MyConfig.pm file.
11323 You can also manually initiate this process with the following command:
11325 % perl -MCPAN -e 'mkmyconfig'
11331 from the CPAN shell.
11333 You will most probably also want to configure something like this:
11335 o conf makepl_arg "LIB=~/myperl/lib \
11336 INSTALLMAN1DIR=~/myperl/man/man1 \
11337 INSTALLMAN3DIR=~/myperl/man/man3 \
11338 INSTALLSCRIPT=~/myperl/bin \
11339 INSTALLBIN=~/myperl/bin"
11341 and then (oh joy) the equivalent command for Module::Build.
11343 You can make this setting permanent like all C<o conf> settings with
11344 C<o conf commit> or by setting C<auto_commit> beforehand.
11346 You will have to add ~/myperl/man to the MANPATH environment variable
11347 and also tell your perl programs to look into ~/myperl/lib, e.g. by
11350 use lib "$ENV{HOME}/myperl/lib";
11352 or setting the PERL5LIB environment variable.
11354 While we're speaking about $ENV{HOME}, it might be worth mentioning,
11355 that for Windows we use the File::HomeDir module that provides an
11356 equivalent to the concept of the home directory on Unix.
11358 Another thing you should bear in mind is that the UNINST parameter can
11359 be dnagerous when you are installing into a private area because you
11360 might accidentally remove modules that other people depend on that are
11361 not using the private area.
11365 How to get a package, unwrap it, and make a change before building it?
11367 Have a look at the C<look> (!) command.
11371 I installed a Bundle and had a couple of fails. When I
11372 retried, everything resolved nicely. Can this be fixed to work
11375 The reason for this is that CPAN does not know the dependencies of all
11376 modules when it starts out. To decide about the additional items to
11377 install, it just uses data found in the META.yml file or the generated
11378 Makefile. An undetected missing piece breaks the process. But it may
11379 well be that your Bundle installs some prerequisite later than some
11380 depending item and thus your second try is able to resolve everything.
11381 Please note, CPAN.pm does not know the dependency tree in advance and
11382 cannot sort the queue of things to install in a topologically correct
11383 order. It resolves perfectly well IF all modules declare the
11384 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
11385 the C<requires> stanza of Module::Build. For bundles which fail and
11386 you need to install often, it is recommended to sort the Bundle
11387 definition file manually.
11391 In our intranet we have many modules for internal use. How
11392 can I integrate these modules with CPAN.pm but without uploading
11393 the modules to CPAN?
11395 Have a look at the CPAN::Site module.
11399 When I run CPAN's shell, I get an error message about things in my
11400 /etc/inputrc (or ~/.inputrc) file.
11402 These are readline issues and can only be fixed by studying readline
11403 configuration on your architecture and adjusting the referenced file
11404 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
11405 and edit them. Quite often harmless changes like uppercasing or
11406 lowercasing some arguments solves the problem.
11410 Some authors have strange characters in their names.
11412 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
11413 expecting ISO-8859-1 charset, a converter can be activated by setting
11414 term_is_latin to a true value in your config file. One way of doing so
11417 cpan> o conf term_is_latin 1
11419 If other charset support is needed, please file a bugreport against
11420 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
11421 the support or maybe UTF-8 terminals become widely available.
11425 When an install fails for some reason and then I correct the error
11426 condition and retry, CPAN.pm refuses to install the module, saying
11427 C<Already tried without success>.
11429 Use the force pragma like so
11431 force install Foo::Bar
11437 and then 'make install' directly in the subshell.
11441 How do I install a "DEVELOPER RELEASE" of a module?
11443 By default, CPAN will install the latest non-developer release of a
11444 module. If you want to install a dev release, you have to specify the
11445 partial path starting with the author id to the tarball you wish to
11448 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
11450 Note that you can use the C<ls> command to get this path listed.
11454 How do I install a module and all its dependencies from the commandline,
11455 without being prompted for anything, despite my CPAN configuration
11458 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
11459 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
11460 asked any questions at all (assuming the modules you are installing are
11461 nice about obeying that variable as well):
11463 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
11467 How do I create a Module::Build based Build.PL derived from an
11468 ExtUtils::MakeMaker focused Makefile.PL?
11470 http://search.cpan.org/search?query=Module::Build::Convert
11472 http://accognoscere.org/papers/perl-module-build-convert/module-build-convert.html
11476 What's the best CPAN site for me?
11478 The urllist config parameter is yours. You can add and remove sites at
11479 will. You should find out which sites have the best uptodateness,
11480 bandwidth, reliability, etc. and are topologically close to you. Some
11481 people prefer fast downloads, others uptodateness, others reliability.
11482 You decide which to try in which order.
11484 Henk P. Penning maintains a site that collects data about CPAN sites:
11486 http://www.cs.uu.nl/people/henkp/mirmon/cpan.html
11490 =head1 COMPATIBILITY
11492 =head2 OLD PERL VERSIONS
11494 CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
11495 newer versions. It is getting more and more difficult to get the
11496 minimal prerequisites working on older perls. It is close to
11497 impossible to get the whole Bundle::CPAN working there. If you're in
11498 the position to have only these old versions, be advised that CPAN is
11499 designed to work fine without the Bundle::CPAN installed.
11501 To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
11502 compatible with ancient perls and that File::Temp is listed as a
11503 prerequisite but CPAN has reasonable workarounds if it is missing.
11507 This module and its competitor, the CPANPLUS module, are both much
11508 cooler than the other. CPAN.pm is older. CPANPLUS was designed to be
11509 more modular but it was never tried to make it compatible with CPAN.pm.
11511 =head1 SECURITY ADVICE
11513 This software enables you to upgrade software on your computer and so
11514 is inherently dangerous because the newly installed software may
11515 contain bugs and may alter the way your computer works or even make it
11516 unusable. Please consider backing up your data before every upgrade.
11520 Please report bugs via http://rt.cpan.org/
11522 Before submitting a bug, please make sure that the traditional method
11523 of building a Perl module package from a shell by following the
11524 installation instructions of that package still works in your
11529 Andreas Koenig C<< <andk@cpan.org> >>
11533 This program is free software; you can redistribute it and/or
11534 modify it under the same terms as Perl itself.
11536 See L<http://www.perl.com/perl/misc/Artistic.html>
11538 =head1 TRANSLATIONS
11540 Kawai,Takanori provides a Japanese translation of this manpage at
11541 http://homepage3.nifty.com/hippo2000/perltips/CPAN.htm
11545 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)