1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 $CPAN::VERSION = '1.88_73';
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
3339 @{$fullstats->{history}} > 999
3340 || $time - $fullstats->{history}[0]{start} > 30*86400 # one month
3342 shift @{$fullstats->{history}}
3344 push @debug, scalar @{$fullstats->{history}} if $sdebug;
3345 push @debug, time if $sdebug;
3346 push @debug, scalar localtime($fullstats->{history}[0]{start}) if $sdebug;
3347 # need no eval because if this fails, it is serious
3348 my $sfile = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
3349 CPAN->_yaml_dumpfile("$sfile.$$",$fullstats);
3350 if ( $sdebug||$CPAN::DEBUG ) {
3351 local $CPAN::DEBUG = 512; # FTP
3353 CPAN->debug(sprintf("DEBUG history: before_read[%d]before[%d]at[%d]".
3354 "after[%d]at[%d]oldest[%s]dumped backat[%d]",
3358 # Win32 cannot rename a file to an existing filename
3359 unlink($sfile) if ($^O eq 'MSWin32');
3360 rename "$sfile.$$", $sfile
3361 or $CPAN::Frontend->mydie("Could not rename '$sfile.$$' to '$sfile': $!\n");
3365 # if file is CHECKSUMS, suggest the place where we got the file to be
3366 # checked from, maybe only for young files?
3367 #-> sub CPAN::FTP::_recommend_url_for
3368 sub _recommend_url_for {
3369 my($self, $file) = @_;
3370 my $urllist = $self->_get_urllist;
3371 if ($file =~ s|/CHECKSUMS(.gz)?$||) {
3372 my $fullstats = $self->_ftp_statistics();
3373 my $history = $fullstats->{history} || [];
3374 while (my $last = pop @$history) {
3375 last if $last->{end} - time > 3600; # only young results are interesting
3376 next unless $last->{file}; # dirname of nothing dies!
3377 next unless $file eq File::Basename::dirname($last->{file});
3378 return $last->{thesiteurl};
3381 if ($CPAN::Config->{randomize_urllist}
3383 rand(1) < $CPAN::Config->{randomize_urllist}
3385 $urllist->[int rand scalar @$urllist];
3391 #-> sub CPAN::FTP::_get_urllist
3394 $CPAN::Config->{urllist} ||= [];
3395 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
3396 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
3397 $CPAN::Config->{urllist} = [];
3399 my @urllist = grep { defined $_ and length $_ } @{$CPAN::Config->{urllist}};
3400 for my $u (@urllist) {
3401 CPAN->debug("u[$u]") if $CPAN::DEBUG;
3402 if (UNIVERSAL::can($u,"text")) {
3403 $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
3405 $u .= "/" unless substr($u,-1) eq "/";
3406 $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
3412 #-> sub CPAN::FTP::ftp_get ;
3414 my($class,$host,$dir,$file,$target) = @_;
3416 qq[Going to fetch file [$file] from dir [$dir]
3417 on host [$host] as local [$target]\n]
3419 my $ftp = Net::FTP->new($host);
3421 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
3424 return 0 unless defined $ftp;
3425 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
3426 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
3427 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
3428 my $msg = $ftp->message;
3429 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
3432 unless ( $ftp->cwd($dir) ){
3433 my $msg = $ftp->message;
3434 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
3438 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
3439 unless ( $ftp->get($file,$target) ){
3440 my $msg = $ftp->message;
3441 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
3444 $ftp->quit; # it's ok if this fails
3448 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
3450 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
3451 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
3453 # > *** 1562,1567 ****
3454 # > --- 1562,1580 ----
3455 # > return 1 if substr($url,0,4) eq "file";
3456 # > return 1 unless $url =~ m|://([^/]+)|;
3458 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
3460 # > + $proxy =~ m|://([^/:]+)|;
3462 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
3463 # > + if ($noproxy) {
3464 # > + if ($host !~ /$noproxy$/) {
3465 # > + $host = $proxy;
3468 # > + $host = $proxy;
3471 # > require Net::Ping;
3472 # > return 1 unless $Net::Ping::VERSION >= 2;
3476 #-> sub CPAN::FTP::localize ;
3478 my($self,$file,$aslocal,$force) = @_;
3480 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
3481 unless defined $aslocal;
3482 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
3485 if ($^O eq 'MacOS') {
3486 # Comment by AK on 2000-09-03: Uniq short filenames would be
3487 # available in CHECKSUMS file
3488 my($name, $path) = File::Basename::fileparse($aslocal, '');
3489 if (length($name) > 31) {
3500 my $size = 31 - length($suf);
3501 while (length($name) > $size) {
3505 $aslocal = File::Spec->catfile($path, $name);
3509 if (-f $aslocal && -r _ && !($force & 1)){
3511 if ($size = -s $aslocal) {
3512 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
3515 # empty file from a previous unsuccessful attempt to download it
3517 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
3518 "could not remove.");
3521 my($maybe_restore) = 0;
3523 rename $aslocal, "$aslocal.bak$$";
3527 my($aslocal_dir) = File::Basename::dirname($aslocal);
3528 File::Path::mkpath($aslocal_dir);
3529 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
3530 qq{directory "$aslocal_dir".
3531 I\'ll continue, but if you encounter problems, they may be due
3532 to insufficient permissions.\n}) unless -w $aslocal_dir;
3534 # Inheritance is not easier to manage than a few if/else branches
3535 if ($CPAN::META->has_usable('LWP::UserAgent')) {
3537 CPAN::LWP::UserAgent->config;
3538 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
3540 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
3544 $Ua->proxy('ftp', $var)
3545 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
3546 $Ua->proxy('http', $var)
3547 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
3550 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
3552 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
3553 # > use ones that require basic autorization.
3555 # > Example of when I use it manually in my own stuff:
3557 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
3558 # > $req->proxy_authorization_basic("username","password");
3559 # > $res = $ua->request($req);
3563 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
3567 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
3568 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
3571 # Try the list of urls for each single object. We keep a record
3572 # where we did get a file from
3573 my(@reordered,$last);
3574 my $ccurllist = $self->_get_urllist;
3575 $last = $#$ccurllist;
3576 if ($force & 2) { # local cpans probably out of date, don't reorder
3577 @reordered = (0..$last);
3581 (substr($ccurllist->[$b],0,4) eq "file")
3583 (substr($ccurllist->[$a],0,4) eq "file")
3585 defined($ThesiteURL)
3587 ($ccurllist->[$b] eq $ThesiteURL)
3589 ($ccurllist->[$a] eq $ThesiteURL)
3594 $self->debug("Themethod[$Themethod]reordered[@reordered]") if $CPAN::DEBUG;
3596 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
3598 @levels = qw/easy hard hardest/;
3600 @levels = qw/easy/ if $^O eq 'MacOS';
3602 local $ENV{FTP_PASSIVE} =
3603 exists $CPAN::Config->{ftp_passive} ?
3604 $CPAN::Config->{ftp_passive} : 1;
3606 my $stats = $self->_new_stats($file);
3607 LEVEL: for $levelno (0..$#levels) {
3608 my $level = $levels[$levelno];
3609 my $method = "host$level";
3610 my @host_seq = $level eq "easy" ?
3611 @reordered : 0..$last; # reordered has CDROM up front
3612 my @urllist = map { $ccurllist->[$_] } @host_seq;
3613 for my $u (@CPAN::Defaultsites) {
3614 push @urllist, $u unless grep { $_ eq $u } @urllist;
3616 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
3617 my $aslocal_tempfile = $aslocal . ".tmp" . $$;
3618 if (my $recommend = $self->_recommend_url_for($file)) {
3619 @urllist = grep { $_ ne $recommend } @urllist;
3620 unshift @urllist, $recommend;
3622 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
3623 $ret = $self->$method(\@urllist,$file,$aslocal_tempfile,$stats);
3625 CPAN->debug("ret[$ret]aslocal[$aslocal]") if $CPAN::DEBUG;
3626 if ($ret eq $aslocal_tempfile) {
3627 # if we got it exactly as we asked for, only then we
3629 rename $aslocal_tempfile, $aslocal
3630 or $CPAN::Frontend->mydie("Error while trying to rename ".
3631 "'$ret' to '$aslocal': $!");
3634 $Themethod = $level;
3636 # utime $now, $now, $aslocal; # too bad, if we do that, we
3637 # might alter a local mirror
3638 $self->debug("level[$level]") if $CPAN::DEBUG;
3641 unlink $aslocal_tempfile;
3642 last if $CPAN::Signal; # need to cleanup
3646 $stats->{filesize} = -s $ret;
3648 $self->debug("before _add_to_statistics") if $CPAN::DEBUG;
3649 $self->_add_to_statistics($stats);
3650 $self->debug("after _add_to_statistics") if $CPAN::DEBUG;
3652 unlink "$aslocal.bak$$";
3655 unless ($CPAN::Signal) {
3658 if (@{$CPAN::Config->{urllist}}) {
3660 qq{Please check, if the URLs I found in your configuration file \(}.
3661 join(", ", @{$CPAN::Config->{urllist}}).
3664 push @mess, qq{Your urllist is empty!};
3666 push @mess, qq{The urllist can be edited.},
3667 qq{E.g. with 'o conf urllist push ftp://myurl/'};
3668 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
3669 $CPAN::Frontend->mywarn("Could not fetch $file\n");
3670 $CPAN::Frontend->mysleep(2);
3672 if ($maybe_restore) {
3673 rename "$aslocal.bak$$", $aslocal;
3674 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
3675 $self->ls($aslocal));
3682 my($self,$stats,$method,$url) = @_;
3683 push @{$stats->{attempts}}, {
3690 # package CPAN::FTP;
3692 my($self,$host_seq,$file,$aslocal,$stats) = @_;
3694 HOSTEASY: for $ro_url (@$host_seq) {
3695 $self->_set_attempt($stats,"easy",$ro_url);
3696 my $url .= "$ro_url$file";
3697 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
3698 if ($url =~ /^file:/) {
3700 if ($CPAN::META->has_inst('URI::URL')) {
3701 my $u = URI::URL->new($url);
3703 } else { # works only on Unix, is poorly constructed, but
3704 # hopefully better than nothing.
3705 # RFC 1738 says fileurl BNF is
3706 # fileurl = "file://" [ host | "localhost" ] "/" fpath
3707 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
3709 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
3710 $l =~ s|^file:||; # assume they
3714 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
3716 $self->debug("local file[$l]") if $CPAN::DEBUG;
3717 if ( -f $l && -r _) {
3718 $ThesiteURL = $ro_url;
3721 if ($l =~ /(.+)\.gz$/) {
3723 if ( -f $ungz && -r _) {
3724 $ThesiteURL = $ro_url;
3728 # Maybe mirror has compressed it?
3730 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
3731 eval { CPAN::Tarzip->new("$l.gz")->gunzip($aslocal) };
3733 $ThesiteURL = $ro_url;
3738 $self->debug("it was not a file URL") if $CPAN::DEBUG;
3739 if ($CPAN::META->has_usable('LWP')) {
3740 $CPAN::Frontend->myprint("Fetching with LWP:
3744 CPAN::LWP::UserAgent->config;
3745 eval { $Ua = CPAN::LWP::UserAgent->new; };
3747 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
3750 my $res = $Ua->mirror($url, $aslocal);
3751 if ($res->is_success) {
3752 $ThesiteURL = $ro_url;
3754 utime $now, $now, $aslocal; # download time is more
3755 # important than upload
3758 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3759 my $gzurl = "$url.gz";
3760 $CPAN::Frontend->myprint("Fetching with LWP:
3763 $res = $Ua->mirror($gzurl, "$aslocal.gz");
3764 if ($res->is_success) {
3765 if (eval {CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)}) {
3766 $ThesiteURL = $ro_url;
3771 $CPAN::Frontend->myprint(sprintf(
3772 "LWP failed with code[%s] message[%s]\n",
3776 # Alan Burlison informed me that in firewall environments
3777 # Net::FTP can still succeed where LWP fails. So we do not
3778 # skip Net::FTP anymore when LWP is available.
3781 $CPAN::Frontend->mywarn(" LWP not available\n");
3783 return if $CPAN::Signal;
3784 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3785 # that's the nice and easy way thanks to Graham
3786 $self->debug("recognized ftp") if $CPAN::DEBUG;
3787 my($host,$dir,$getfile) = ($1,$2,$3);
3788 if ($CPAN::META->has_usable('Net::FTP')) {
3790 $CPAN::Frontend->myprint("Fetching with Net::FTP:
3793 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
3794 "aslocal[$aslocal]") if $CPAN::DEBUG;
3795 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
3796 $ThesiteURL = $ro_url;
3799 if ($aslocal !~ /\.gz(?!\n)\Z/) {
3800 my $gz = "$aslocal.gz";
3801 $CPAN::Frontend->myprint("Fetching with Net::FTP
3804 if (CPAN::FTP->ftp_get($host,
3808 eval{CPAN::Tarzip->new($gz)->gunzip($aslocal)}
3810 $ThesiteURL = $ro_url;
3816 CPAN->debug("Net::FTP does not count as usable atm") if $CPAN::DEBUG;
3820 UNIVERSAL::can($ro_url,"text")
3822 $ro_url->{FROM} eq "USER"
3824 ##address #17973: default URLs should not try to override
3825 ##user-defined URLs just because LWP is not available
3826 my $ret = $self->hosthard([$ro_url],$file,$aslocal,$stats);
3827 return $ret if $ret;
3829 return if $CPAN::Signal;
3833 # package CPAN::FTP;
3835 my($self,$host_seq,$file,$aslocal,$stats) = @_;
3837 # Came back if Net::FTP couldn't establish connection (or
3838 # failed otherwise) Maybe they are behind a firewall, but they
3839 # gave us a socksified (or other) ftp program...
3842 my($devnull) = $CPAN::Config->{devnull} || "";
3844 my($aslocal_dir) = File::Basename::dirname($aslocal);
3845 File::Path::mkpath($aslocal_dir);
3846 HOSTHARD: for $ro_url (@$host_seq) {
3847 $self->_set_attempt($stats,"hard",$ro_url);
3848 my $url = "$ro_url$file";
3849 my($proto,$host,$dir,$getfile);
3851 # Courtesy Mark Conty mark_conty@cargill.com change from
3852 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3854 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
3855 # proto not yet used
3856 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
3858 next HOSTHARD; # who said, we could ftp anything except ftp?
3860 next HOSTHARD if $proto eq "file"; # file URLs would have had
3861 # success above. Likely a bogus URL
3863 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
3865 # Try the most capable first and leave ncftp* for last as it only
3867 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
3868 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
3869 next unless defined $funkyftp;
3870 next if $funkyftp =~ /^\s*$/;
3872 my($asl_ungz, $asl_gz);
3873 ($asl_ungz = $aslocal) =~ s/\.gz//;
3874 $asl_gz = "$asl_ungz.gz";
3876 my($src_switch) = "";
3878 my($stdout_redir) = " > $asl_ungz";
3880 $src_switch = " -source";
3881 } elsif ($f eq "ncftp"){
3882 $src_switch = " -c";
3883 } elsif ($f eq "wget"){
3884 $src_switch = " -O $asl_ungz";
3886 } elsif ($f eq 'curl'){
3887 $src_switch = ' -L -f -s -S --netrc-optional';
3890 if ($f eq "ncftpget"){
3891 $chdir = "cd $aslocal_dir && ";
3894 $CPAN::Frontend->myprint(
3896 Trying with "$funkyftp$src_switch" to get
3900 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
3901 $self->debug("system[$system]") if $CPAN::DEBUG;
3902 my($wstatus) = system($system);
3904 # lynx returns 0 when it fails somewhere
3906 my $content = do { local *FH;
3907 open FH, $asl_ungz or die;
3910 if ($content =~ /^<.*(<title>[45]|Error [45])/si) {
3911 $CPAN::Frontend->mywarn(qq{
3912 No success, the file that lynx has has downloaded looks like an error message:
3915 $CPAN::Frontend->mysleep(1);
3919 $CPAN::Frontend->myprint(qq{
3920 No success, the file that lynx has has downloaded is an empty file.
3925 if ($wstatus == 0) {
3928 } elsif ($asl_ungz ne $aslocal) {
3929 # test gzip integrity
3930 if (eval{CPAN::Tarzip->new($asl_ungz)->gtest}) {
3931 # e.g. foo.tar is gzipped --> foo.tar.gz
3932 rename $asl_ungz, $aslocal;
3934 eval{CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz)};
3937 $ThesiteURL = $ro_url;
3939 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3941 -f $asl_ungz && -s _ == 0;
3942 my $gz = "$aslocal.gz";
3943 my $gzurl = "$url.gz";
3944 $CPAN::Frontend->myprint(
3946 Trying with "$funkyftp$src_switch" to get
3949 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
3950 $self->debug("system[$system]") if $CPAN::DEBUG;
3952 if (($wstatus = system($system)) == 0
3956 # test gzip integrity
3957 my $ct = eval{CPAN::Tarzip->new($asl_gz)};
3958 if ($ct && $ct->gtest) {
3959 $ct->gunzip($aslocal);
3961 # somebody uncompressed file for us?
3962 rename $asl_ungz, $aslocal;
3964 $ThesiteURL = $ro_url;
3967 unlink $asl_gz if -f $asl_gz;
3970 my $estatus = $wstatus >> 8;
3971 my $size = -f $aslocal ?
3972 ", left\n$aslocal with size ".-s _ :
3973 "\nWarning: expected file [$aslocal] doesn't exist";
3974 $CPAN::Frontend->myprint(qq{
3975 System call "$system"
3976 returned status $estatus (wstat $wstatus)$size
3979 return if $CPAN::Signal;
3980 } # transfer programs
3984 # package CPAN::FTP;
3986 my($self,$host_seq,$file,$aslocal,$stats) = @_;
3989 my($aslocal_dir) = File::Basename::dirname($aslocal);
3990 File::Path::mkpath($aslocal_dir);
3991 my $ftpbin = $CPAN::Config->{ftp};
3992 unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) {
3993 $CPAN::Frontend->myprint("No external ftp command available\n\n");
3996 $CPAN::Frontend->mywarn(qq{
3997 As a last ressort we now switch to the external ftp command '$ftpbin'
4000 Doing so often leads to problems that are hard to diagnose.
4002 If you're victim of such problems, please consider unsetting the ftp
4003 config variable with
4009 $CPAN::Frontend->mysleep(2);
4010 HOSTHARDEST: for $ro_url (@$host_seq) {
4011 $self->_set_attempt($stats,"hardest",$ro_url);
4012 my $url = "$ro_url$file";
4013 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
4014 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
4017 my($host,$dir,$getfile) = ($1,$2,$3);
4019 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
4020 $ctime,$blksize,$blocks) = stat($aslocal);
4021 $timestamp = $mtime ||= 0;
4022 my($netrc) = CPAN::FTP::netrc->new;
4023 my($netrcfile) = $netrc->netrc;
4024 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
4025 my $targetfile = File::Basename::basename($aslocal);
4031 map("cd $_", split /\//, $dir), # RFC 1738
4033 "get $getfile $targetfile",
4037 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
4038 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
4039 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
4041 $netrc->contains($host))) if $CPAN::DEBUG;
4042 if ($netrc->protected) {
4043 my $dialog = join "", map { " $_\n" } @dialog;
4045 if ($netrc->contains($host)) {
4046 $netrc_explain = "Relying that your .netrc entry for '$host' ".
4047 "manages the login";
4049 $netrc_explain = "Relying that your default .netrc entry ".
4050 "manages the login";
4052 $CPAN::Frontend->myprint(qq{
4053 Trying with external ftp to get
4056 Going to send the dialog
4060 $self->talk_ftp("$ftpbin$verbose $host",
4062 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4063 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
4065 if ($mtime > $timestamp) {
4066 $CPAN::Frontend->myprint("GOT $aslocal\n");
4067 $ThesiteURL = $ro_url;
4070 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
4072 return if $CPAN::Signal;
4074 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
4075 qq{correctly protected.\n});
4078 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
4079 nor does it have a default entry\n");
4082 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
4083 # then and login manually to host, using e-mail as
4085 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
4089 "user anonymous $Config::Config{'cf_email'}"
4091 my $dialog = join "", map { " $_\n" } @dialog;
4092 $CPAN::Frontend->myprint(qq{
4093 Trying with external ftp to get
4095 Going to send the dialog
4099 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
4100 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4101 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
4103 if ($mtime > $timestamp) {
4104 $CPAN::Frontend->myprint("GOT $aslocal\n");
4105 $ThesiteURL = $ro_url;
4108 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
4110 return if $CPAN::Signal;
4111 $CPAN::Frontend->mywarn("Can't access URL $url.\n\n");
4112 $CPAN::Frontend->mysleep(2);
4116 # package CPAN::FTP;
4118 my($self,$command,@dialog) = @_;
4119 my $fh = FileHandle->new;
4120 $fh->open("|$command") or die "Couldn't open ftp: $!";
4121 foreach (@dialog) { $fh->print("$_\n") }
4122 $fh->close; # Wait for process to complete
4124 my $estatus = $wstatus >> 8;
4125 $CPAN::Frontend->myprint(qq{
4126 Subprocess "|$command"
4127 returned status $estatus (wstat $wstatus)
4131 # find2perl needs modularization, too, all the following is stolen
4135 my($self,$name) = @_;
4136 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
4137 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
4139 my($perms,%user,%group);
4143 $blocks = int(($blocks + 1) / 2);
4146 $blocks = int(($sizemm + 1023) / 1024);
4149 if (-f _) { $perms = '-'; }
4150 elsif (-d _) { $perms = 'd'; }
4151 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
4152 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
4153 elsif (-p _) { $perms = 'p'; }
4154 elsif (-S _) { $perms = 's'; }
4155 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
4157 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
4158 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
4159 my $tmpmode = $mode;
4160 my $tmp = $rwx[$tmpmode & 7];
4162 $tmp = $rwx[$tmpmode & 7] . $tmp;
4164 $tmp = $rwx[$tmpmode & 7] . $tmp;
4165 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
4166 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
4167 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
4170 my $user = $user{$uid} || $uid; # too lazy to implement lookup
4171 my $group = $group{$gid} || $gid;
4173 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
4175 my($moname) = $moname[$mon];
4176 if (-M _ > 365.25 / 2) {
4177 $timeyear = $year + 1900;
4180 $timeyear = sprintf("%02d:%02d", $hour, $min);
4183 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
4197 package CPAN::FTP::netrc;
4200 # package CPAN::FTP::netrc;
4203 my $home = CPAN::HandleConfig::home;
4204 my $file = File::Spec->catfile($home,".netrc");
4206 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4207 $atime,$mtime,$ctime,$blksize,$blocks)
4212 my($fh,@machines,$hasdefault);
4214 $fh = FileHandle->new or die "Could not create a filehandle";
4216 if($fh->open($file)){
4217 $protected = ($mode & 077) == 0;
4219 NETRC: while (<$fh>) {
4220 my(@tokens) = split " ", $_;
4221 TOKEN: while (@tokens) {
4222 my($t) = shift @tokens;
4223 if ($t eq "default"){
4227 last TOKEN if $t eq "macdef";
4228 if ($t eq "machine") {
4229 push @machines, shift @tokens;
4234 $file = $hasdefault = $protected = "";
4238 'mach' => [@machines],
4240 'hasdefault' => $hasdefault,
4241 'protected' => $protected,
4245 # CPAN::FTP::netrc::hasdefault;
4246 sub hasdefault { shift->{'hasdefault'} }
4247 sub netrc { shift->{'netrc'} }
4248 sub protected { shift->{'protected'} }
4250 my($self,$mach) = @_;
4251 for ( @{$self->{'mach'}} ) {
4252 return 1 if $_ eq $mach;
4257 package CPAN::Complete;
4261 my($text, $line, $start, $end) = @_;
4262 my(@perlret) = cpl($text, $line, $start);
4263 # find longest common match. Can anybody show me how to peruse
4264 # T::R::Gnu to have this done automatically? Seems expensive.
4265 return () unless @perlret;
4266 my($newtext) = $text;
4267 for (my $i = length($text)+1;;$i++) {
4268 last unless length($perlret[0]) && length($perlret[0]) >= $i;
4269 my $try = substr($perlret[0],0,$i);
4270 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
4271 # warn "try[$try]tries[@tries]";
4272 if (@tries == @perlret) {
4278 ($newtext,@perlret);
4281 #-> sub CPAN::Complete::cpl ;
4283 my($word,$line,$pos) = @_;
4287 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4289 if ($line =~ s/^((?:notest|f?force)\s*)//) {
4294 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
4295 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
4297 } elsif ($line =~ /^(a|ls)\s/) {
4298 @return = cplx('CPAN::Author',uc($word));
4299 } elsif ($line =~ /^b\s/) {
4300 CPAN::Shell->local_bundles;
4301 @return = cplx('CPAN::Bundle',$word);
4302 } elsif ($line =~ /^d\s/) {
4303 @return = cplx('CPAN::Distribution',$word);
4304 } elsif ($line =~ m/^(
4305 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
4307 if ($word =~ /^Bundle::/) {
4308 CPAN::Shell->local_bundles;
4310 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
4311 } elsif ($line =~ /^i\s/) {
4312 @return = cpl_any($word);
4313 } elsif ($line =~ /^reload\s/) {
4314 @return = cpl_reload($word,$line,$pos);
4315 } elsif ($line =~ /^o\s/) {
4316 @return = cpl_option($word,$line,$pos);
4317 } elsif ($line =~ m/^\S+\s/ ) {
4318 # fallback for future commands and what we have forgotten above
4319 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
4326 #-> sub CPAN::Complete::cplx ;
4328 my($class, $word) = @_;
4329 if (CPAN::_sqlite_running) {
4330 $CPAN::SQLite->search($class, "^\Q$word\E");
4332 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
4335 #-> sub CPAN::Complete::cpl_any ;
4339 cplx('CPAN::Author',$word),
4340 cplx('CPAN::Bundle',$word),
4341 cplx('CPAN::Distribution',$word),
4342 cplx('CPAN::Module',$word),
4346 #-> sub CPAN::Complete::cpl_reload ;
4348 my($word,$line,$pos) = @_;
4350 my(@words) = split " ", $line;
4351 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4352 my(@ok) = qw(cpan index);
4353 return @ok if @words == 1;
4354 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
4357 #-> sub CPAN::Complete::cpl_option ;
4359 my($word,$line,$pos) = @_;
4361 my(@words) = split " ", $line;
4362 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4363 my(@ok) = qw(conf debug);
4364 return @ok if @words == 1;
4365 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
4367 } elsif ($words[1] eq 'index') {
4369 } elsif ($words[1] eq 'conf') {
4370 return CPAN::HandleConfig::cpl(@_);
4371 } elsif ($words[1] eq 'debug') {
4372 return sort grep /^\Q$word\E/i,
4373 sort keys %CPAN::DEBUG, 'all';
4377 package CPAN::Index;
4380 #-> sub CPAN::Index::force_reload ;
4383 $CPAN::Index::LAST_TIME = 0;
4387 #-> sub CPAN::Index::reload ;
4389 my($self,$force) = @_;
4392 # XXX check if a newer one is available. (We currently read it
4393 # from time to time)
4394 for ($CPAN::Config->{index_expire}) {
4395 $_ = 0.001 unless $_ && $_ > 0.001;
4397 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
4398 # debug here when CPAN doesn't seem to read the Metadata
4400 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
4402 unless ($CPAN::META->{PROTOCOL}) {
4403 $self->read_metadata_cache;
4404 $CPAN::META->{PROTOCOL} ||= "1.0";
4406 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
4407 # warn "Setting last_time to 0";
4408 $LAST_TIME = 0; # No warning necessary
4410 if ($LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
4413 # CPAN->debug("LAST_TIME[$LAST_TIME]index_expire[$CPAN::Config->{index_expire}]time[$time]");
4415 # IFF we are developing, it helps to wipe out the memory
4416 # between reloads, otherwise it is not what a user expects.
4417 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
4418 $CPAN::META = CPAN->new;
4421 local $LAST_TIME = $time;
4422 local $CPAN::META->{PROTOCOL} = PROTOCOL;
4424 my $needshort = $^O eq "dos";
4426 $self->rd_authindex($self
4428 "authors/01mailrc.txt.gz",
4430 File::Spec->catfile('authors', '01mailrc.gz') :
4431 File::Spec->catfile('authors', '01mailrc.txt.gz'),
4434 $debug = "timing reading 01[".($t2 - $time)."]";
4436 return if $CPAN::Signal; # this is sometimes lengthy
4437 $self->rd_modpacks($self
4439 "modules/02packages.details.txt.gz",
4441 File::Spec->catfile('modules', '02packag.gz') :
4442 File::Spec->catfile('modules', '02packages.details.txt.gz'),
4445 $debug .= "02[".($t2 - $time)."]";
4447 return if $CPAN::Signal; # this is sometimes lengthy
4448 $self->rd_modlist($self
4450 "modules/03modlist.data.gz",
4452 File::Spec->catfile('modules', '03mlist.gz') :
4453 File::Spec->catfile('modules', '03modlist.data.gz'),
4455 $self->write_metadata_cache;
4457 $debug .= "03[".($t2 - $time)."]";
4459 CPAN->debug($debug) if $CPAN::DEBUG;
4461 if ($CPAN::Config->{build_dir_reuse}) {
4462 $self->reanimate_build_dir;
4464 if (CPAN::_sqlite_running) {
4465 $CPAN::SQLite->reload(time => $time, force => $force)
4469 $CPAN::META->{PROTOCOL} = PROTOCOL;
4472 #-> sub CPAN::Index::reanimate_build_dir ;
4473 sub reanimate_build_dir {
4475 unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module}||"YAML")) {
4478 return if $HAVE_REANIMATED++;
4479 my $d = $CPAN::Config->{build_dir};
4480 my $dh = DirHandle->new;
4481 opendir $dh, $d or return; # does not exist
4486 $CPAN::Frontend->myprint("Going to read $CPAN::Config->{build_dir}/\n");
4487 my @candidates = map { $_->[0] }
4488 sort { $b->[1] <=> $a->[1] }
4489 map { [ $_, -M File::Spec->catfile($d,$_) ] }
4490 grep {/\.yml$/} readdir $dh;
4491 DISTRO: for $dirent (@candidates) {
4492 my $y = eval {CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))};
4495 if ($c && CPAN->_perl_fingerprint($c->{perl})) {
4496 my $key = $c->{distribution}{ID};
4497 for my $k (keys %{$c->{distribution}}) {
4498 if ($c->{distribution}{$k}
4499 && ref $c->{distribution}{$k}
4500 && UNIVERSAL::isa($c->{distribution}{$k},"CPAN::Distrostatus")) {
4501 $c->{distribution}{$k}{COMMANDID} = $i - @candidates;
4505 #we tried to restore only if element already
4506 #exists; but then we do not work with metadata
4509 = $CPAN::META->{readwrite}{'CPAN::Distribution'}{$key}
4510 = $c->{distribution};
4511 delete $do->{badtestcnt};
4513 if ($do->{make_test}
4515 && !$do->{make_test}->failed
4519 $do->{install}->failed
4522 $CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME});
4527 while (($painted/76) < ($i/@candidates)) {
4528 $CPAN::Frontend->myprint(".");
4532 $CPAN::Frontend->myprint(sprintf(
4533 "DONE\nFound %s old builds, restored the state of %s\n",
4534 @candidates ? sprintf("%d",scalar @candidates) : "no",
4535 $restored || "none",
4540 #-> sub CPAN::Index::reload_x ;
4542 my($cl,$wanted,$localname,$force) = @_;
4543 $force |= 2; # means we're dealing with an index here
4544 CPAN::HandleConfig->load; # we should guarantee loading wherever
4545 # we rely on Config XXX
4546 $localname ||= $wanted;
4547 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
4551 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
4554 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
4555 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
4556 qq{day$s. I\'ll use that.});
4559 $force |= 1; # means we're quite serious about it.
4561 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
4564 #-> sub CPAN::Index::rd_authindex ;
4566 my($cl, $index_target) = @_;
4567 return unless defined $index_target;
4568 return if CPAN::_sqlite_running;
4570 $CPAN::Frontend->myprint("Going to read $index_target\n");
4572 tie *FH, 'CPAN::Tarzip', $index_target;
4575 push @lines, split /\012/ while <FH>;
4579 my($userid,$fullname,$email) =
4580 m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/;
4581 $fullname ||= $email;
4582 if ($userid && $fullname && $email){
4583 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
4584 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
4586 CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG;
4589 while (($painted/76) < ($i/@lines)) {
4590 $CPAN::Frontend->myprint(".");
4593 return if $CPAN::Signal;
4595 $CPAN::Frontend->myprint("DONE\n");
4599 my($self,$dist) = @_;
4600 $dist = $self->{'id'} unless defined $dist;
4601 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
4605 #-> sub CPAN::Index::rd_modpacks ;
4607 my($self, $index_target) = @_;
4608 return unless defined $index_target;
4609 return if CPAN::_sqlite_running;
4610 $CPAN::Frontend->myprint("Going to read $index_target\n");
4611 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
4613 CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
4616 while (my $bytes = $fh->READ(\$chunk,8192)) {
4619 my @lines = split /\012/, $slurp;
4620 CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG;
4623 my($line_count,$last_updated);
4625 my $shift = shift(@lines);
4626 last if $shift =~ /^\s*$/;
4627 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
4628 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
4630 CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
4631 if (not defined $line_count) {
4633 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
4634 Please check the validity of the index file by comparing it to more
4635 than one CPAN mirror. I'll continue but problems seem likely to
4639 $CPAN::Frontend->mysleep(5);
4640 } elsif ($line_count != scalar @lines) {
4642 $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
4643 contains a Line-Count header of %d but I see %d lines there. Please
4644 check the validity of the index file by comparing it to more than one
4645 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
4646 $index_target, $line_count, scalar(@lines));
4649 if (not defined $last_updated) {
4651 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
4652 Please check the validity of the index file by comparing it to more
4653 than one CPAN mirror. I'll continue but problems seem likely to
4657 $CPAN::Frontend->mysleep(5);
4661 ->myprint(sprintf qq{ Database was generated on %s\n},
4663 $DATE_OF_02 = $last_updated;
4666 if ($CPAN::META->has_inst('HTTP::Date')) {
4668 $age -= HTTP::Date::str2time($last_updated);
4670 $CPAN::Frontend->mywarn(" HTTP::Date not available\n");
4671 require Time::Local;
4672 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
4673 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
4674 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
4681 qq{Warning: This index file is %d days old.
4682 Please check the host you chose as your CPAN mirror for staleness.
4683 I'll continue but problems seem likely to happen.\a\n},
4686 } elsif ($age < -1) {
4690 qq{Warning: Your system date is %d days behind this index file!
4692 Timestamp index file: %s
4693 Please fix your system time, problems with the make command expected.\n},
4703 # A necessity since we have metadata_cache: delete what isn't
4705 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
4706 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
4711 # before 1.56 we split into 3 and discarded the rest. From
4712 # 1.57 we assign remaining text to $comment thus allowing to
4713 # influence isa_perl
4714 my($mod,$version,$dist,$comment) = split " ", $_, 4;
4715 my($bundle,$id,$userid);
4717 if ($mod eq 'CPAN' &&
4719 CPAN::Queue->exists('Bundle::CPAN') ||
4720 CPAN::Queue->exists('CPAN')
4724 if ($version > $CPAN::VERSION){
4725 $CPAN::Frontend->mywarn(qq{
4726 New CPAN.pm version (v$version) available.
4727 [Currently running version is v$CPAN::VERSION]
4728 You might want to try
4731 to both upgrade CPAN.pm and run the new version without leaving
4732 the current session.
4735 $CPAN::Frontend->mysleep(2);
4736 $CPAN::Frontend->myprint(qq{\n});
4738 last if $CPAN::Signal;
4739 } elsif ($mod =~ /^Bundle::(.*)/) {
4744 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
4745 # Let's make it a module too, because bundles have so much
4746 # in common with modules.
4748 # Changed in 1.57_63: seems like memory bloat now without
4749 # any value, so commented out
4751 # $CPAN::META->instance('CPAN::Module',$mod);
4755 # instantiate a module object
4756 $id = $CPAN::META->instance('CPAN::Module',$mod);
4760 # Although CPAN prohibits same name with different version the
4761 # indexer may have changed the version for the same distro
4762 # since the last time ("Force Reindexing" feature)
4763 if ($id->cpan_file ne $dist
4765 $id->cpan_version ne $version
4767 $userid = $id->userid || $self->userid($dist);
4769 'CPAN_USERID' => $userid,
4770 'CPAN_VERSION' => $version,
4771 'CPAN_FILE' => $dist,
4775 # instantiate a distribution object
4776 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
4777 # we do not need CONTAINSMODS unless we do something with
4778 # this dist, so we better produce it on demand.
4780 ## my $obj = $CPAN::META->instance(
4781 ## 'CPAN::Distribution' => $dist
4783 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
4785 $CPAN::META->instance(
4786 'CPAN::Distribution' => $dist
4788 'CPAN_USERID' => $userid,
4789 'CPAN_COMMENT' => $comment,
4793 for my $name ($mod,$dist) {
4794 # $self->debug("exists name[$name]") if $CPAN::DEBUG;
4795 $exists{$name} = undef;
4799 while (($painted/76) < ($i/@lines)) {
4800 $CPAN::Frontend->myprint(".");
4803 return if $CPAN::Signal;
4805 $CPAN::Frontend->myprint("DONE\n");
4807 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
4808 for my $o ($CPAN::META->all_objects($class)) {
4809 next if exists $exists{$o->{ID}};
4810 $CPAN::META->delete($class,$o->{ID});
4811 # CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
4818 #-> sub CPAN::Index::rd_modlist ;
4820 my($cl,$index_target) = @_;
4821 return unless defined $index_target;
4822 return if CPAN::_sqlite_running;
4823 $CPAN::Frontend->myprint("Going to read $index_target\n");
4824 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
4828 while (my $bytes = $fh->READ(\$chunk,8192)) {
4831 my @eval2 = split /\012/, $slurp;
4834 my $shift = shift(@eval2);
4835 if ($shift =~ /^Date:\s+(.*)/){
4836 if ($DATE_OF_03 eq $1){
4837 $CPAN::Frontend->myprint("Unchanged.\n");
4842 last if $shift =~ /^\s*$/;
4844 push @eval2, q{CPAN::Modulelist->data;};
4846 my($comp) = Safe->new("CPAN::Safe1");
4847 my($eval2) = join("\n", @eval2);
4848 CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
4849 my $ret = $comp->reval($eval2);
4850 Carp::confess($@) if $@;
4851 return if $CPAN::Signal;
4853 my $until = keys(%$ret);
4855 CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
4857 my $obj = $CPAN::META->instance("CPAN::Module",$_);
4858 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
4859 $obj->set(%{$ret->{$_}});
4861 while (($painted/76) < ($i/$until)) {
4862 $CPAN::Frontend->myprint(".");
4865 return if $CPAN::Signal;
4867 $CPAN::Frontend->myprint("DONE\n");
4870 #-> sub CPAN::Index::write_metadata_cache ;
4871 sub write_metadata_cache {
4873 return unless $CPAN::Config->{'cache_metadata'};
4874 return if CPAN::_sqlite_running;
4875 return unless $CPAN::META->has_usable("Storable");
4877 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
4878 CPAN::Distribution)) {
4879 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
4881 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4882 $cache->{last_time} = $LAST_TIME;
4883 $cache->{DATE_OF_02} = $DATE_OF_02;
4884 $cache->{PROTOCOL} = PROTOCOL;
4885 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
4886 eval { Storable::nstore($cache, $metadata_file) };
4887 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4890 #-> sub CPAN::Index::read_metadata_cache ;
4891 sub read_metadata_cache {
4893 return unless $CPAN::Config->{'cache_metadata'};
4894 return if CPAN::_sqlite_running;
4895 return unless $CPAN::META->has_usable("Storable");
4896 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4897 return unless -r $metadata_file and -f $metadata_file;
4898 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
4900 eval { $cache = Storable::retrieve($metadata_file) };
4901 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4902 if (!$cache || !UNIVERSAL::isa($cache, 'HASH')){
4906 if (exists $cache->{PROTOCOL}) {
4907 if (PROTOCOL > $cache->{PROTOCOL}) {
4908 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
4909 "with protocol v%s, requiring v%s\n",
4916 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
4917 "with protocol v1.0\n");
4922 while(my($class,$v) = each %$cache) {
4923 next unless $class =~ /^CPAN::/;
4924 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
4925 while (my($id,$ro) = each %$v) {
4926 $CPAN::META->{readwrite}{$class}{$id} ||=
4927 $class->new(ID=>$id, RO=>$ro);
4932 unless ($clcnt) { # sanity check
4933 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
4936 if ($idcnt < 1000) {
4937 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
4938 "in $metadata_file\n");
4941 $CPAN::META->{PROTOCOL} ||=
4942 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
4943 # does initialize to some protocol
4944 $LAST_TIME = $cache->{last_time};
4945 $DATE_OF_02 = $cache->{DATE_OF_02};
4946 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
4947 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
4951 package CPAN::InfoObj;
4956 exists $self->{RO} and return $self->{RO};
4959 #-> sub CPAN::InfoObj::cpan_userid
4964 return $ro->{CPAN_USERID} || "N/A";
4966 $self->debug("ID[$self->{ID}]");
4967 # N/A for bundles found locally
4972 sub id { shift->{ID}; }
4974 #-> sub CPAN::InfoObj::new ;
4976 my $this = bless {}, shift;
4981 # The set method may only be used by code that reads index data or
4982 # otherwise "objective" data from the outside world. All session
4983 # related material may do anything else with instance variables but
4984 # must not touch the hash under the RO attribute. The reason is that
4985 # the RO hash gets written to Metadata file and is thus persistent.
4987 #-> sub CPAN::InfoObj::safe_chdir ;
4989 my($self,$todir) = @_;
4990 # we die if we cannot chdir and we are debuggable
4991 Carp::confess("safe_chdir called without todir argument")
4992 unless defined $todir and length $todir;
4994 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4998 unless (-x $todir) {
4999 unless (chmod 0755, $todir) {
5000 my $cwd = CPAN::anycwd();
5001 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
5002 "permission to change the permission; cannot ".
5003 "chdir to '$todir'\n");
5004 $CPAN::Frontend->mysleep(5);
5005 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
5006 qq{to todir[$todir]: $!});
5010 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
5013 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
5016 my $cwd = CPAN::anycwd();
5017 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
5018 qq{to todir[$todir] (a chmod has been issued): $!});
5023 #-> sub CPAN::InfoObj::set ;
5025 my($self,%att) = @_;
5026 my $class = ref $self;
5028 # This must be ||=, not ||, because only if we write an empty
5029 # reference, only then the set method will write into the readonly
5030 # area. But for Distributions that spring into existence, maybe
5031 # because of a typo, we do not like it that they are written into
5032 # the readonly area and made permanent (at least for a while) and
5033 # that is why we do not "allow" other places to call ->set.
5034 unless ($self->id) {
5035 CPAN->debug("Bug? Empty ID, rejecting");
5038 my $ro = $self->{RO} =
5039 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
5041 while (my($k,$v) = each %att) {
5046 #-> sub CPAN::InfoObj::as_glimpse ;
5050 my $class = ref($self);
5051 $class =~ s/^CPAN:://;
5052 my $id = $self->can("pretty_id") ? $self->pretty_id : $self->{ID};
5053 push @m, sprintf "%-15s %s\n", $class, $id;
5057 #-> sub CPAN::InfoObj::as_string ;
5061 my $class = ref($self);
5062 $class =~ s/^CPAN:://;
5063 push @m, $class, " id = $self->{ID}\n";
5065 unless ($ro = $self->ro) {
5066 if (substr($self->{ID},-1,1) eq ".") { # directory
5069 $CPAN::Frontend->mydie("Unknown object $self->{ID}");
5072 for (sort keys %$ro) {
5073 # next if m/^(ID|RO)$/;
5075 if ($_ eq "CPAN_USERID") {
5077 $extra .= $self->fullname;
5078 my $email; # old perls!
5079 if ($email = $CPAN::META->instance("CPAN::Author",
5082 $extra .= " <$email>";
5084 $extra .= " <no email>";
5087 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
5088 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
5091 next unless defined $ro->{$_};
5092 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
5094 KEY: for (sort keys %$self) {
5095 next if m/^(ID|RO)$/;
5096 unless (defined $self->{$_}) {
5100 if (ref($self->{$_}) eq "ARRAY") {
5101 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
5102 } elsif (ref($self->{$_}) eq "HASH") {
5104 if (/^CONTAINSMODS$/) {
5105 $value = join(" ",sort keys %{$self->{$_}});
5106 } elsif (/^prereq_pm$/) {
5108 my $v = $self->{$_};
5109 for my $x (sort keys %$v) {
5111 for my $y (sort keys %{$v->{$x}}) {
5112 push @svalue, "$y=>$v->{$x}{$y}";
5114 push @value, "$x\:" . join ",", @svalue if @svalue;
5116 $value = join ";", @value;
5118 $value = $self->{$_};
5126 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
5132 #-> sub CPAN::InfoObj::fullname ;
5135 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
5138 #-> sub CPAN::InfoObj::dump ;
5140 my($self, $what) = @_;
5141 unless ($CPAN::META->has_inst("Data::Dumper")) {
5142 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
5144 local $Data::Dumper::Sortkeys;
5145 $Data::Dumper::Sortkeys = 1;
5146 my $out = Data::Dumper::Dumper($what ? eval $what : $self);
5147 if (length $out > 100000) {
5148 my $fh_pager = FileHandle->new;
5149 local($SIG{PIPE}) = "IGNORE";
5150 my $pager = $CPAN::Config->{'pager'} || "cat";
5151 $fh_pager->open("|$pager")
5152 or die "Could not open pager $pager\: $!";
5153 $fh_pager->print($out);
5156 $CPAN::Frontend->myprint($out);
5160 package CPAN::Author;
5163 #-> sub CPAN::Author::force
5169 #-> sub CPAN::Author::force
5172 delete $self->{force};
5175 #-> sub CPAN::Author::id
5178 my $id = $self->{ID};
5179 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
5183 #-> sub CPAN::Author::as_glimpse ;
5187 my $class = ref($self);
5188 $class =~ s/^CPAN:://;
5189 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
5197 #-> sub CPAN::Author::fullname ;
5199 shift->ro->{FULLNAME};
5203 #-> sub CPAN::Author::email ;
5204 sub email { shift->ro->{EMAIL}; }
5206 #-> sub CPAN::Author::ls ;
5209 my $glob = shift || "";
5210 my $silent = shift || 0;
5213 # adapted from CPAN::Distribution::verifyCHECKSUM ;
5214 my(@csf); # chksumfile
5215 @csf = $self->id =~ /(.)(.)(.*)/;
5216 $csf[1] = join "", @csf[0,1];
5217 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
5219 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
5220 unless (grep {$_->[2] eq $csf[1]} @dl) {
5221 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
5224 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
5225 unless (grep {$_->[2] eq $csf[2]} @dl) {
5226 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
5229 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
5231 if ($CPAN::META->has_inst("Text::Glob")) {
5232 my $rglob = Text::Glob::glob_to_regex($glob);
5233 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
5235 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
5238 $CPAN::Frontend->myprint(join "", map {
5239 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
5240 } sort { $a->[2] cmp $b->[2] } @dl);
5244 # returns an array of arrays, the latter contain (size,mtime,filename)
5245 #-> sub CPAN::Author::dir_listing ;
5248 my $chksumfile = shift;
5249 my $recursive = shift;
5250 my $may_ftp = shift;
5253 File::Spec->catfile($CPAN::Config->{keep_source_where},
5254 "authors", "id", @$chksumfile);
5258 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
5259 # hazard. (Without GPG installed they are not that much better,
5261 $fh = FileHandle->new;
5262 if (open($fh, $lc_want)) {
5263 my $line = <$fh>; close $fh;
5264 unlink($lc_want) unless $line =~ /PGP/;
5268 # connect "force" argument with "index_expire".
5269 my $force = $self->{force};
5270 if (my @stat = stat $lc_want) {
5271 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
5275 $lc_file = CPAN::FTP->localize(
5276 "authors/id/@$chksumfile",
5281 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
5282 $chksumfile->[-1] .= ".gz";
5283 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
5286 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
5287 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
5293 $lc_file = $lc_want;
5294 # we *could* second-guess and if the user has a file: URL,
5295 # then we could look there. But on the other hand, if they do
5296 # have a file: URL, wy did they choose to set
5297 # $CPAN::Config->{show_upload_date} to false?
5300 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
5301 $fh = FileHandle->new;
5303 if (open $fh, $lc_file){
5306 $eval =~ s/\015?\012/\n/g;
5308 my($comp) = Safe->new();
5309 $cksum = $comp->reval($eval);
5311 rename $lc_file, "$lc_file.bad";
5312 Carp::confess($@) if $@;
5314 } elsif ($may_ftp) {
5315 Carp::carp "Could not open '$lc_file' for reading.";
5317 # Maybe should warn: "You may want to set show_upload_date to a true value"
5321 for $f (sort keys %$cksum) {
5322 if (exists $cksum->{$f}{isdir}) {
5324 my(@dir) = @$chksumfile;
5326 push @dir, $f, "CHECKSUMS";
5328 [$_->[0], $_->[1], "$f/$_->[2]"]
5329 } $self->dir_listing(\@dir,1,$may_ftp);
5331 push @result, [ 0, "-", $f ];
5335 ($cksum->{$f}{"size"}||0),
5336 $cksum->{$f}{"mtime"}||"---",
5344 package CPAN::Distribution;
5350 my $ro = $self->ro or return;
5354 # CPAN::Distribution::undelay
5357 delete $self->{later};
5360 # add the A/AN/ stuff
5361 # CPAN::Distribution::normalize
5364 $s = $self->id unless defined $s;
5365 if (substr($s,-1,1) eq ".") {
5366 # using a global because we are sometimes called as static method
5367 if (!$CPAN::META->{LOCK}
5368 && !$CPAN::Have_warned->{"$s is unlocked"}++
5370 $CPAN::Frontend->mywarn("You are visiting the local directory
5372 without lock, take care that concurrent processes do not do likewise.\n");
5373 $CPAN::Frontend->mysleep(1);
5376 $s = "$CPAN::iCwd/.";
5377 } elsif (File::Spec->file_name_is_absolute($s)) {
5378 } elsif (File::Spec->can("rel2abs")) {
5379 $s = File::Spec->rel2abs($s);
5381 $CPAN::Frontend->mydie("Your File::Spec is too old, please upgrade File::Spec");
5383 CPAN->debug("s[$s]") if $CPAN::DEBUG;
5384 unless ($CPAN::META->exists("CPAN::Distribution", $s)) {
5385 for ($CPAN::META->instance("CPAN::Distribution", $s)) {
5386 $_->{build_dir} = $s;
5387 $_->{archived} = "local_directory";
5388 $_->{unwrapped} = CPAN::Distrostatus->new("YES -- local_directory");
5394 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
5396 return $s if $s =~ m:^N/A|^Contact Author: ;
5397 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
5398 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
5399 CPAN->debug("s[$s]") if $CPAN::DEBUG;
5404 #-> sub CPAN::Distribution::author ;
5408 if (substr($self->id,-1,1) eq ".") {
5409 $authorid = "LOCAL";
5411 ($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
5413 CPAN::Shell->expand("Author",$authorid);
5416 # tries to get the yaml from CPAN instead of the distro itself:
5417 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
5420 my $meta = $self->pretty_id;
5421 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
5422 my(@ls) = CPAN::Shell->globls($meta);
5423 my $norm = $self->normalize($meta);
5427 File::Spec->catfile(
5428 $CPAN::Config->{keep_source_where},
5433 $self->debug("Doing localize") if $CPAN::DEBUG;
5434 unless ($local_file =
5435 CPAN::FTP->localize("authors/id/$norm",
5437 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
5439 my $yaml = CPAN->_yaml_loadfile($local_file)->[0];
5442 #-> sub CPAN::Distribution::cpan_userid
5445 if ($self->{ID} =~ m{[A-Z]/[A-Z\-]{2}/([A-Z\-]+)/}) {
5448 return $self->SUPER::cpan_userid;
5451 #-> sub CPAN::Distribution::pretty_id
5455 return $id unless $id =~ m|^./../|;
5459 # mark as dirty/clean for the sake of recursion detection. $color=1
5460 # means "in use", $color=0 means "not in use anymore". $color=2 means
5461 # we have determined prereqs now and thus insist on passing this
5462 # through (at least) once again.
5464 #-> sub CPAN::Distribution::color_cmd_tmps ;
5465 sub color_cmd_tmps {
5467 my($depth) = shift || 0;
5468 my($color) = shift || 0;
5469 my($ancestors) = shift || [];
5470 # a distribution needs to recurse into its prereq_pms
5472 return if exists $self->{incommandcolor}
5474 && $self->{incommandcolor}==$color;
5475 if ($depth>=$CPAN::MAX_RECURSION){
5476 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
5478 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
5479 my $prereq_pm = $self->prereq_pm;
5480 if (defined $prereq_pm) {
5481 PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
5482 keys %{$prereq_pm->{build_requires}||{}}) {
5483 next PREREQ if $pre eq "perl";
5485 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
5486 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
5487 $CPAN::Frontend->mysleep(2);
5490 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
5494 delete $self->{sponsored_mods};
5496 # as we are at the end of a command, we'll give up this
5497 # reminder of a broken test. Other commands may test this guy
5498 # again. Maybe 'badtestcnt' should be renamed to
5499 # 'make_test_failed_within_command'?
5500 delete $self->{badtestcnt};
5502 $self->{incommandcolor} = $color;
5505 #-> sub CPAN::Distribution::as_string ;
5508 $self->containsmods;
5510 $self->SUPER::as_string(@_);
5513 #-> sub CPAN::Distribution::containsmods ;
5516 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
5517 my $dist_id = $self->{ID};
5518 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
5519 my $mod_file = $mod->cpan_file or next;
5520 my $mod_id = $mod->{ID} or next;
5521 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
5523 if ($CPAN::Signal) {
5524 delete $self->{CONTAINSMODS};
5527 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
5529 keys %{$self->{CONTAINSMODS}||{}};
5532 #-> sub CPAN::Distribution::upload_date ;
5535 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
5536 my(@local_wanted) = split(/\//,$self->id);
5537 my $filename = pop @local_wanted;
5538 push @local_wanted, "CHECKSUMS";
5539 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
5540 return unless $author;
5541 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
5543 my($dirent) = grep { $_->[2] eq $filename } @dl;
5544 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
5545 return unless $dirent->[1];
5546 return $self->{UPLOAD_DATE} = $dirent->[1];
5549 #-> sub CPAN::Distribution::uptodate ;
5553 foreach $c ($self->containsmods) {
5554 my $obj = CPAN::Shell->expandany($c);
5555 unless ($obj->uptodate){
5556 my $id = $self->pretty_id;
5557 $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG;
5564 #-> sub CPAN::Distribution::called_for ;
5567 $self->{CALLED_FOR} = $id if defined $id;
5568 return $self->{CALLED_FOR};
5571 #-> sub CPAN::Distribution::get ;
5574 $self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
5575 if (my $goto = $self->prefs->{goto}) {
5576 $CPAN::Frontend->mywarn
5578 "delegating to '%s' as specified in prefs file '%s' doc %d\n",
5580 $self->{prefs_file},
5581 $self->{prefs_file_doc},
5583 return $self->goto($goto);
5585 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
5587 : ($ENV{PERLLIB} || "");
5589 $CPAN::META->set_perl5lib;
5590 local $ENV{MAKEFLAGS}; # protect us from outer make calls
5594 $self->debug("checking disabled id[$self->{ID}]") if $CPAN::DEBUG;
5595 if ($self->prefs->{disabled}) {
5597 "Disabled via prefs file '%s' doc %d",
5598 $self->{prefs_file},
5599 $self->{prefs_file_doc},
5602 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $why");
5603 # note: not intended to be persistent but at least visible
5604 # during this session
5606 if (exists $self->{build_dir}) {
5607 # this deserves print, not warn:
5608 $CPAN::Frontend->myprint(" Has already been unwrapped into directory ".
5609 "$self->{build_dir}\n"
5614 # although we talk about 'force' we shall not test on
5615 # force directly. New model of force tries to refrain from
5616 # direct checking of force.
5617 exists $self->{unwrapped} and (
5618 UNIVERSAL::can($self->{unwrapped},"failed") ?
5619 $self->{unwrapped}->failed :
5620 $self->{unwrapped} =~ /^NO/
5622 and push @e, "Unwrapping had some problem, won't try again without force";
5625 $CPAN::Frontend->mywarn(join "", map {"$_\n"} @e) and return if @e;
5627 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
5630 # Get the file on local disk
5635 File::Spec->catfile(
5636 $CPAN::Config->{keep_source_where},
5639 split(/\//,$self->id)
5642 $self->debug("Doing localize") if $CPAN::DEBUG;
5643 unless ($local_file =
5644 CPAN::FTP->localize("authors/id/$self->{ID}",
5647 if ($CPAN::Index::DATE_OF_02) {
5648 $note = "Note: Current database in memory was generated ".
5649 "on $CPAN::Index::DATE_OF_02\n";
5651 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
5654 $self->debug("local_wanted[$local_wanted]local_file[$local_file]") if $CPAN::DEBUG;
5655 $self->{localfile} = $local_file;
5656 return if $CPAN::Signal;
5661 if ($CPAN::META->has_inst("Digest::SHA")) {
5662 $self->debug("Digest::SHA is installed, verifying");
5663 $self->verifyCHECKSUM;
5665 $self->debug("Digest::SHA is NOT installed");
5667 return if $CPAN::Signal;
5670 # Create a clean room and go there
5672 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
5673 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
5674 $self->safe_chdir($builddir);
5675 $self->debug("Removing tmp-$$") if $CPAN::DEBUG;
5676 File::Path::rmtree("tmp-$$");
5677 unless (mkdir "tmp-$$", 0755) {
5678 $CPAN::Frontend->unrecoverable_error(<<EOF);
5679 Couldn't mkdir '$builddir/tmp-$$': $!
5681 Cannot continue: Please find the reason why I cannot make the
5684 and fix the problem, then retry.
5689 $self->safe_chdir($sub_wd);
5692 $self->safe_chdir("tmp-$$");
5697 my $ct = eval{CPAN::Tarzip->new($local_file)};
5699 $self->{unwrapped} = CPAN::Distrostatus->new("NO");
5700 delete $self->{build_dir};
5703 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
5704 $self->{was_uncompressed}++ unless eval{$ct->gtest()};
5705 $self->untar_me($ct);
5706 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
5707 $self->unzip_me($ct);
5709 $self->{was_uncompressed}++ unless $ct->gtest();
5710 $local_file = $self->handle_singlefile($local_file);
5712 # $self->{archived} = "NO";
5713 # $self->safe_chdir($sub_wd);
5717 # we are still in the tmp directory!
5718 # Let's check if the package has its own directory.
5719 my $dh = DirHandle->new(File::Spec->curdir)
5720 or Carp::croak("Couldn't opendir .: $!");
5721 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
5724 # XXX here we want in each branch File::Temp to protect all build_dir directories
5725 if (CPAN->has_inst("File::Temp")) {
5729 if (@readdir == 1 && -d $readdir[0]) {
5730 $tdir_base = $readdir[0];
5731 $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]);
5732 my $dh2 = DirHandle->new($from_dir)
5733 or Carp::croak("Couldn't opendir $from_dir: $!");
5734 @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC??
5736 my $userid = $self->cpan_userid;
5737 CPAN->debug("userid[$userid]");
5738 if (!$userid or $userid eq "N/A") {
5741 $tdir_base = $userid;
5742 $from_dir = File::Spec->curdir;
5743 @dirents = @readdir;
5745 $packagedir = File::Temp::tempdir(
5746 "$tdir_base-XXXXXX",
5751 for $f (@dirents) { # is already without "." and ".."
5752 my $from = File::Spec->catdir($from_dir,$f);
5753 my $to = File::Spec->catdir($packagedir,$f);
5754 unless (File::Copy::move($from,$to)) {
5756 $from = File::Spec->rel2abs($from);
5757 Carp::confess("Couldn't move $from to $to: $err");
5760 } else { # older code below, still better than nothing when there is no File::Temp
5762 if (@readdir == 1 && -d $readdir[0]) {
5763 $distdir = $readdir[0];
5764 $packagedir = File::Spec->catdir($builddir,$distdir);
5765 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
5767 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
5769 File::Path::rmtree($packagedir);
5770 unless (File::Copy::move($distdir,$packagedir)) {
5771 $CPAN::Frontend->unrecoverable_error(<<EOF);
5772 Couldn't move '$distdir' to '$packagedir': $!
5774 Cannot continue: Please find the reason why I cannot move
5775 $builddir/tmp-$$/$distdir
5778 and fix the problem, then retry
5782 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
5789 my $userid = $self->cpan_userid;
5790 CPAN->debug("userid[$userid]") if $CPAN::DEBUG;
5791 if (!$userid or $userid eq "N/A") {
5794 my $pragmatic_dir = $userid . '000';
5795 $pragmatic_dir =~ s/\W_//g;
5796 $pragmatic_dir++ while -d "../$pragmatic_dir";
5797 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
5798 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
5799 File::Path::mkpath($packagedir);
5801 for $f (@readdir) { # is already without "." and ".."
5802 my $to = File::Spec->catdir($packagedir,$f);
5803 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
5808 $self->safe_chdir($sub_wd);
5812 $self->{build_dir} = $packagedir;
5813 $self->safe_chdir($builddir);
5814 File::Path::rmtree("tmp-$$");
5816 $self->safe_chdir($packagedir);
5817 $self->_signature_business();
5818 $self->safe_chdir($builddir);
5819 return if $CPAN::Signal;
5822 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
5823 my($mpl_exists) = -f $mpl;
5824 unless ($mpl_exists) {
5825 # NFS has been reported to have racing problems after the
5826 # renaming of a directory in some environments.
5828 $CPAN::Frontend->mysleep(1);
5829 my $mpldh = DirHandle->new($packagedir)
5830 or Carp::croak("Couldn't opendir $packagedir: $!");
5831 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
5834 my $prefer_installer = "eumm"; # eumm|mb
5835 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
5836 if ($mpl_exists) { # they *can* choose
5837 if ($CPAN::META->has_inst("Module::Build")) {
5838 $prefer_installer = CPAN::HandleConfig->prefs_lookup($self,
5839 q{prefer_installer});
5842 $prefer_installer = "mb";
5845 return unless $self->patch;
5846 if (lc($prefer_installer) eq "mb") {
5847 $self->{modulebuild} = 1;
5848 } elsif (! $mpl_exists) {
5849 $self->_edge_cases($mpl,$packagedir,$local_file);
5851 if ($self->{build_dir}
5853 $CPAN::Config->{build_dir_reuse}
5855 $self->store_persistent_state;
5861 #-> CPAN::Distribution::store_persistent_state
5862 sub store_persistent_state {
5864 my $dir = $self->{build_dir};
5865 unless (File::Spec->canonpath(File::Basename::dirname($dir))
5866 eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
5867 $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
5868 "will not store persistent state\n");
5871 my $file = sprintf "%s.yml", $dir;
5872 my $yaml_module = CPAN::_yaml_module;
5873 if ($CPAN::META->has_inst($yaml_module)) {
5874 CPAN->_yaml_dumpfile(
5878 perl => CPAN::_perl_fingerprint,
5879 distribution => $self,
5883 $CPAN::Frontend->myprint("Warning (usually harmless): '$yaml_module' not installed, ".
5884 "will not store persistent state\n");
5888 #-> CPAN::Distribution::patch
5890 my($self,$patch) = @_;
5891 my $norm = $self->normalize($patch);
5893 File::Spec->catfile(
5894 $CPAN::Config->{keep_source_where},
5899 $self->debug("Doing localize") if $CPAN::DEBUG;
5900 return CPAN::FTP->localize("authors/id/$norm",
5904 #-> CPAN::Distribution::patch
5907 $self->debug("checking patches id[$self->{ID}]") if $CPAN::DEBUG;
5908 my $patches = $self->prefs->{patches};
5910 $self->debug("patches[$patches]") if $CPAN::DEBUG;
5912 return unless @$patches;
5913 $self->safe_chdir($self->{build_dir});
5914 CPAN->debug("patches[$patches]") if $CPAN::DEBUG;
5915 my $patchbin = $CPAN::Config->{patch};
5916 unless ($patchbin && length $patchbin) {
5917 $CPAN::Frontend->mydie("No external patch command configured\n\n".
5918 "Please run 'o conf init /patch/'\n\n");
5920 unless (MM->maybe_command($patchbin)) {
5921 $CPAN::Frontend->mydie("No external patch command available\n\n".
5922 "Please run 'o conf init /patch/'\n\n");
5924 $patchbin = CPAN::HandleConfig->safe_quote($patchbin);
5925 local $ENV{PATCH_GET} = 0; # shall replace -g0 which is not
5926 # supported everywhere (and then,
5927 # not ever necessary there)
5928 my $stdpatchargs = "-N --fuzz=3";
5929 my $countedpatches = @$patches == 1 ? "1 patch" : (scalar @$patches . " patches");
5930 $CPAN::Frontend->myprint("Going to apply $countedpatches:\n");
5931 for my $patch (@$patches) {
5932 unless (-f $patch) {
5933 if (my $trydl = $self->try_download($patch)) {
5936 my $fail = "Could not find patch '$patch'";
5937 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5938 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5939 delete $self->{build_dir};
5943 $CPAN::Frontend->myprint(" $patch\n");
5944 my $readfh = CPAN::Tarzip->TIEHANDLE($patch);
5947 my $ppp = $self->_patch_p_parameter($readfh);
5948 if ($ppp eq "applypatch") {
5949 $pcommand = "$CPAN::Config->{applypatch} -verbose";
5951 my $thispatchargs = join " ", $stdpatchargs, $ppp;
5952 $pcommand = "$patchbin $thispatchargs";
5955 $readfh = CPAN::Tarzip->TIEHANDLE($patch); # open again
5956 my $writefh = FileHandle->new;
5957 $CPAN::Frontend->myprint(" $pcommand\n");
5958 unless (open $writefh, "|$pcommand") {
5959 my $fail = "Could not fork '$pcommand'";
5960 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5961 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5962 delete $self->{build_dir};
5965 while (my $x = $readfh->READLINE) {
5968 unless (close $writefh) {
5969 my $fail = "Could not apply patch '$patch'";
5970 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5971 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5972 delete $self->{build_dir};
5981 sub _patch_p_parameter {
5984 my $cnt_p0files = 0;
5986 while ($_ = $fh->READLINE) {
5988 $CPAN::Config->{applypatch}
5990 /\#\#\#\# ApplyPatch data follows \#\#\#\#/
5994 next unless /^[\*\+]{3}\s(\S+)/;
5997 $cnt_p0files++ if -f $file;
5998 CPAN->debug("file[$file]cnt_files[$cnt_files]cnt_p0files[$cnt_p0files]")
6001 return "-p1" unless $cnt_files;
6002 return $cnt_files==$cnt_p0files ? "-p0" : "-p1";
6005 #-> sub CPAN::Distribution::_edge_cases
6006 # with "configure" or "Makefile" or single file scripts
6008 my($self,$mpl,$packagedir,$local_file) = @_;
6009 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
6013 my($configure) = File::Spec->catfile($packagedir,"Configure");
6014 if (-f $configure) {
6015 # do we have anything to do?
6016 $self->{configure} = $configure;
6017 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
6018 $CPAN::Frontend->mywarn(qq{
6019 Package comes with a Makefile and without a Makefile.PL.
6020 We\'ll try to build it with that Makefile then.
6022 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
6023 $CPAN::Frontend->mysleep(2);
6025 my $cf = $self->called_for || "unknown";
6030 $cf =~ s|[/\\:]||g; # risk of filesystem damage
6031 $cf = "unknown" unless length($cf);
6032 $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
6033 (The test -f "$mpl" returned false.)
6034 Writing one on our own (setting NAME to $cf)\a\n});
6035 $self->{had_no_makefile_pl}++;
6036 $CPAN::Frontend->mysleep(3);
6038 # Writing our own Makefile.PL
6041 if ($self->{archived} eq "maybe_pl") {
6042 my $fh = FileHandle->new;
6043 my $script_file = File::Spec->catfile($packagedir,$local_file);
6044 $fh->open($script_file)
6045 or Carp::croak("Could not open $script_file: $!");
6047 # name parsen und prereq
6048 my($state) = "poddir";
6049 my($name, $prereq) = ("", "");
6051 if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
6054 } elsif ($1 eq 'PREREQUISITES') {
6057 } elsif ($state =~ m{^(name|prereq)$}) {
6062 } elsif ($state eq "name") {
6067 } elsif ($state eq "prereq") {
6070 } elsif (/^=cut\b/) {
6077 s{.*<}{}; # strip X<...>
6081 $prereq = join " ", split /\s+/, $prereq;
6082 my($PREREQ_PM) = join("\n", map {
6083 s{.*<}{}; # strip X<...>
6085 if (/[\s\'\"]/) { # prose?
6087 s/[^\w:]$//; # period?
6088 " "x28 . "'$_' => 0,";
6090 } split /\s*,\s*/, $prereq);
6093 EXE_FILES => ['$name'],
6099 my $to_file = File::Spec->catfile($packagedir, $name);
6100 rename $script_file, $to_file
6101 or die "Can't rename $script_file to $to_file: $!";
6105 my $fh = FileHandle->new;
6107 or Carp::croak("Could not open >$mpl: $!");
6109 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
6110 # because there was no Makefile.PL supplied.
6111 # Autogenerated on: }.scalar localtime().qq{
6113 use ExtUtils::MakeMaker;
6115 NAME => q[$cf],$script
6122 #-> CPAN::Distribution::_signature_business
6123 sub _signature_business {
6125 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
6128 if ($CPAN::META->has_inst("Module::Signature")) {
6129 if (-f "SIGNATURE") {
6130 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
6131 my $rv = Module::Signature::verify();
6132 if ($rv != Module::Signature::SIGNATURE_OK() and
6133 $rv != Module::Signature::SIGNATURE_MISSING()) {
6134 $CPAN::Frontend->mywarn(
6135 qq{\nSignature invalid for }.
6136 qq{distribution file. }.
6137 qq{Please investigate.\n\n}
6141 sprintf(qq{I'd recommend removing %s. Its signature
6142 is invalid. Maybe you have configured your 'urllist' with
6143 a bad URL. Please check this array with 'o conf urllist', and
6144 retry. For more information, try opening a subshell with
6152 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
6153 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
6154 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
6156 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
6157 $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
6160 $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n});
6163 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
6168 #-> CPAN::Distribution::untar_me ;
6171 $self->{archived} = "tar";
6173 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6175 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- untar failed");
6179 # CPAN::Distribution::unzip_me ;
6182 $self->{archived} = "zip";
6184 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6186 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- unzip failed");
6191 sub handle_singlefile {
6192 my($self,$local_file) = @_;
6194 if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ){
6195 $self->{archived} = "pm";
6197 $self->{archived} = "maybe_pl";
6200 my $to = File::Basename::basename($local_file);
6201 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
6202 if (eval{CPAN::Tarzip->new($local_file)->gunzip($to)}) {
6203 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6205 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- uncompressing failed");
6208 File::Copy::cp($local_file,".");
6209 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- copying failed");
6214 #-> sub CPAN::Distribution::new ;
6216 my($class,%att) = @_;
6218 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
6220 my $this = { %att };
6221 return bless $this, $class;
6224 #-> sub CPAN::Distribution::look ;
6228 if ($^O eq 'MacOS') {
6229 $self->Mac::BuildTools::look;
6233 if ( $CPAN::Config->{'shell'} ) {
6234 $CPAN::Frontend->myprint(qq{
6235 Trying to open a subshell in the build directory...
6238 $CPAN::Frontend->myprint(qq{
6239 Your configuration does not define a value for subshells.
6240 Please define it with "o conf shell <your shell>"
6244 my $dist = $self->id;
6246 unless ($dir = $self->dir) {
6249 unless ($dir ||= $self->dir) {
6250 $CPAN::Frontend->mywarn(qq{
6251 Could not determine which directory to use for looking at $dist.
6255 my $pwd = CPAN::anycwd();
6256 $self->safe_chdir($dir);
6257 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
6259 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
6260 $ENV{CPAN_SHELL_LEVEL} += 1;
6261 my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
6262 unless (system($shell) == 0) {
6264 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
6267 $self->safe_chdir($pwd);
6270 # CPAN::Distribution::cvs_import ;
6274 my $dir = $self->dir;
6276 my $package = $self->called_for;
6277 my $module = $CPAN::META->instance('CPAN::Module', $package);
6278 my $version = $module->cpan_version;
6280 my $userid = $self->cpan_userid;
6282 my $cvs_dir = (split /\//, $dir)[-1];
6283 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
6285 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
6287 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
6288 if ($cvs_site_perl) {
6289 $cvs_dir = "$cvs_site_perl/$cvs_dir";
6291 my $cvs_log = qq{"imported $package $version sources"};
6292 $version =~ s/\./_/g;
6293 # XXX cvs: undocumented and unclear how it was meant to work
6294 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
6295 "$cvs_dir", $userid, "v$version");
6297 my $pwd = CPAN::anycwd();
6298 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
6300 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
6302 $CPAN::Frontend->myprint(qq{@cmd\n});
6303 system(@cmd) == 0 or
6305 $CPAN::Frontend->mydie("cvs import failed");
6306 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
6309 #-> sub CPAN::Distribution::readme ;
6312 my($dist) = $self->id;
6313 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
6314 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
6317 File::Spec->catfile(
6318 $CPAN::Config->{keep_source_where},
6321 split(/\//,"$sans.readme"),
6323 $self->debug("Doing localize") if $CPAN::DEBUG;
6324 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
6326 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
6328 if ($^O eq 'MacOS') {
6329 Mac::BuildTools::launch_file($local_file);
6333 my $fh_pager = FileHandle->new;
6334 local($SIG{PIPE}) = "IGNORE";
6335 my $pager = $CPAN::Config->{'pager'} || "cat";
6336 $fh_pager->open("|$pager")
6337 or die "Could not open pager $pager\: $!";
6338 my $fh_readme = FileHandle->new;
6339 $fh_readme->open($local_file)
6340 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
6341 $CPAN::Frontend->myprint(qq{
6346 $fh_pager->print(<$fh_readme>);
6350 #-> sub CPAN::Distribution::verifyCHECKSUM ;
6351 sub verifyCHECKSUM {
6355 $self->{CHECKSUM_STATUS} ||= "";
6356 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
6357 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6359 my($lc_want,$lc_file,@local,$basename);
6360 @local = split(/\//,$self->id);
6362 push @local, "CHECKSUMS";
6364 File::Spec->catfile($CPAN::Config->{keep_source_where},
6365 "authors", "id", @local);
6367 if (my $size = -s $lc_want) {
6368 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
6369 if ($self->CHECKSUM_check_file($lc_want,1)) {
6370 return $self->{CHECKSUM_STATUS} = "OK";
6373 $lc_file = CPAN::FTP->localize("authors/id/@local",
6376 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
6377 $local[-1] .= ".gz";
6378 $lc_file = CPAN::FTP->localize("authors/id/@local",
6381 $lc_file =~ s/\.gz(?!\n)\Z//;
6382 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
6387 if ($self->CHECKSUM_check_file($lc_file)) {
6388 return $self->{CHECKSUM_STATUS} = "OK";
6392 #-> sub CPAN::Distribution::SIG_check_file ;
6393 sub SIG_check_file {
6394 my($self,$chk_file) = @_;
6395 my $rv = eval { Module::Signature::_verify($chk_file) };
6397 if ($rv == Module::Signature::SIGNATURE_OK()) {
6398 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
6399 return $self->{SIG_STATUS} = "OK";
6401 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
6402 qq{distribution file. }.
6403 qq{Please investigate.\n\n}.
6405 $CPAN::META->instance(
6410 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
6411 is invalid. Maybe you have configured your 'urllist' with
6412 a bad URL. Please check this array with 'o conf urllist', and
6415 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
6419 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
6421 # sloppy is 1 when we have an old checksums file that maybe is good
6424 sub CHECKSUM_check_file {
6425 my($self,$chk_file,$sloppy) = @_;
6426 my($cksum,$file,$basename);
6429 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
6430 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
6433 if ($CPAN::META->has_inst("Module::Signature")) {
6434 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
6435 $self->SIG_check_file($chk_file);
6437 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
6441 $file = $self->{localfile};
6442 $basename = File::Basename::basename($file);
6443 my $fh = FileHandle->new;
6444 if (open $fh, $chk_file){
6447 $eval =~ s/\015?\012/\n/g;
6449 my($comp) = Safe->new();
6450 $cksum = $comp->reval($eval);
6452 rename $chk_file, "$chk_file.bad";
6453 Carp::confess($@) if $@;
6456 Carp::carp "Could not open $chk_file for reading";
6459 if (! ref $cksum or ref $cksum ne "HASH") {
6460 $CPAN::Frontend->mywarn(qq{
6461 Warning: checksum file '$chk_file' broken.
6463 When trying to read that file I expected to get a hash reference
6464 for further processing, but got garbage instead.
6466 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
6467 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
6468 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
6470 } elsif (exists $cksum->{$basename}{sha256}) {
6471 $self->debug("Found checksum for $basename:" .
6472 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
6476 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
6478 $fh = CPAN::Tarzip->TIEHANDLE($file);
6481 my $dg = Digest::SHA->new(256);
6484 while ($fh->READ($ref, 4096) > 0){
6487 my $hexdigest = $dg->hexdigest;
6488 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
6492 $CPAN::Frontend->myprint("Checksum for $file ok\n");
6493 return $self->{CHECKSUM_STATUS} = "OK";
6495 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
6496 qq{distribution file. }.
6497 qq{Please investigate.\n\n}.
6499 $CPAN::META->instance(
6504 my $wrap = qq{I\'d recommend removing $file. Its
6505 checksum is incorrect. Maybe you have configured your 'urllist' with
6506 a bad URL. Please check this array with 'o conf urllist', and
6509 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
6511 # former versions just returned here but this seems a
6512 # serious threat that deserves a die
6514 # $CPAN::Frontend->myprint("\n\n");
6518 # close $fh if fileno($fh);
6521 unless ($self->{CHECKSUM_STATUS}) {
6522 $CPAN::Frontend->mywarn(qq{
6523 Warning: No checksum for $basename in $chk_file.
6525 The cause for this may be that the file is very new and the checksum
6526 has not yet been calculated, but it may also be that something is
6527 going awry right now.
6529 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes");
6530 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
6532 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
6537 #-> sub CPAN::Distribution::eq_CHECKSUM ;
6539 my($self,$fh,$expect) = @_;
6540 if ($CPAN::META->has_inst("Digest::SHA")) {
6541 my $dg = Digest::SHA->new(256);
6543 while (read($fh, $data, 4096)){
6546 my $hexdigest = $dg->hexdigest;
6547 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
6548 return $hexdigest eq $expect;
6553 #-> sub CPAN::Distribution::force ;
6555 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
6556 # effect by autoinspection, not by inspecting a global variable. One
6557 # of the reason why this was chosen to work that way was the treatment
6558 # of dependencies. They should not automatically inherit the force
6559 # status. But this has the downside that ^C and die() will return to
6560 # the prompt but will not be able to reset the force_update
6561 # attributes. We try to correct for it currently in the read_metadata
6562 # routine, and immediately before we check for a Signal. I hope this
6563 # works out in one of v1.57_53ff
6565 # "Force get forgets previous error conditions"
6567 #-> sub CPAN::Distribution::fforce ;
6569 my($self, $method) = @_;
6570 $self->force($method,1);
6573 #-> sub CPAN::Distribution::force ;
6575 my($self, $method,$fforce) = @_;
6593 "prereq_pm_detected",
6607 my $methodmatch = 0;
6609 PHASE: for my $phase (qw(unknown get make test install)) { # order matters
6610 $methodmatch = 1 if $fforce || $phase eq $method;
6611 next unless $methodmatch;
6612 ATTRIBUTE: for my $att (@{$phase_map{$phase}}) {
6613 if ($phase eq "get") {
6614 if (substr($self->id,-1,1) eq "."
6615 && $att =~ /(unwrapped|build_dir|archived)/ ) {
6616 # cannot be undone for local distros
6619 if ($att eq "build_dir"
6620 && $self->{build_dir}
6621 && $CPAN::META->{is_tested}
6623 delete $CPAN::META->{is_tested}{$self->{build_dir}};
6625 } elsif ($phase eq "test") {
6626 if ($att eq "make_test"
6627 && $self->{make_test}
6628 && $self->{make_test}{COMMANDID}
6629 && $self->{make_test}{COMMANDID} == $CPAN::CurrentCommandId
6631 # endless loop too likely
6635 delete $self->{$att};
6636 if ($ldebug || $CPAN::DEBUG) {
6637 # local $CPAN::DEBUG = 16; # Distribution
6638 CPAN->debug(sprintf "id[%s]phase[%s]att[%s]", $self->id, $phase, $att);
6642 if ($method && $method =~ /make|test|install/) {
6643 $self->{force_update} = 1; # name should probably have been force_install
6647 #-> sub CPAN::Distribution::notest ;
6649 my($self, $method) = @_;
6650 # warn "XDEBUG: set notest for $self $method";
6651 $self->{"notest"}++; # name should probably have been force_install
6654 #-> sub CPAN::Distribution::unnotest ;
6657 # warn "XDEBUG: deleting notest";
6658 delete $self->{'notest'};
6661 #-> sub CPAN::Distribution::unforce ;
6664 delete $self->{force_update};
6667 #-> sub CPAN::Distribution::isa_perl ;
6670 my $file = File::Basename::basename($self->id);
6671 if ($file =~ m{ ^ perl
6680 \.tar[._-](?:gz|bz2)
6684 } elsif ($self->cpan_comment
6686 $self->cpan_comment =~ /isa_perl\(.+?\)/){
6692 #-> sub CPAN::Distribution::perl ;
6697 carp __PACKAGE__ . "::perl was called without parameters.";
6699 return CPAN::HandleConfig->safe_quote($CPAN::Perl);
6703 #-> sub CPAN::Distribution::make ;
6706 if (my $goto = $self->prefs->{goto}) {
6707 return $self->goto($goto);
6709 my $make = $self->{modulebuild} ? "Build" : "make";
6710 # Emergency brake if they said install Pippi and get newest perl
6711 if ($self->isa_perl) {
6713 $self->called_for ne $self->id &&
6714 ! $self->{force_update}
6716 # if we die here, we break bundles
6719 qq{The most recent version "%s" of the module "%s"
6720 is part of the perl-%s distribution. To install that, you need to run
6721 force install %s --or--
6724 $CPAN::META->instance(
6733 $self->{make} = CPAN::Distrostatus->new("NO isa perl");
6734 $CPAN::Frontend->mysleep(1);
6738 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
6740 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
6742 : ($ENV{PERLLIB} || "");
6743 $CPAN::META->set_perl5lib;
6744 local $ENV{MAKEFLAGS}; # protect us from outer make calls
6747 delete $self->{force_update};
6754 if (!$self->{archived} || $self->{archived} eq "NO") {
6755 push @e, "Is neither a tar nor a zip archive.";
6758 if (!$self->{unwrapped}
6760 UNIVERSAL::can($self->{unwrapped},"failed") ?
6761 $self->{unwrapped}->failed :
6762 $self->{unwrapped} =~ /^NO/
6764 push @e, "Had problems unarchiving. Please build manually";
6767 unless ($self->{force_update}) {
6768 exists $self->{signature_verify} and
6770 UNIVERSAL::can($self->{signature_verify},"failed") ?
6771 $self->{signature_verify}->failed :
6772 $self->{signature_verify} =~ /^NO/
6774 and push @e, "Did not pass the signature test.";
6777 if (exists $self->{writemakefile} &&
6779 UNIVERSAL::can($self->{writemakefile},"failed") ?
6780 $self->{writemakefile}->failed :
6781 $self->{writemakefile} =~ /^NO/
6783 # XXX maybe a retry would be in order?
6784 my $err = UNIVERSAL::can($self->{writemakefile},"text") ?
6785 $self->{writemakefile}->text :
6786 $self->{writemakefile};
6788 $err ||= "Had some problem writing Makefile";
6789 $err .= ", won't make";
6793 defined $self->{make} and push @e,
6794 "Has already been made";
6796 if (exists $self->{later} and length($self->{later})) {
6797 if ($self->unsat_prereq) {
6798 push @e, $self->{later};
6799 # RT ticket 18438 raises doubts if the deletion of {later} is valid.
6800 # YAML-0.53 triggered the later hodge-podge here, but my margin notes
6801 # are not sufficient to be sure if we really must/may do the delete
6802 # here. SO I accept the suggested patch for now. If we trigger a bug
6803 # again, I must go into deep contemplation about the {later} flag.
6806 # delete $self->{later};
6810 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6811 $builddir = $self->dir or
6812 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
6813 unless (chdir $builddir) {
6814 push @e, "Couldn't chdir to '$builddir': $!";
6816 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
6819 delete $self->{force_update};
6822 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
6823 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
6825 if ($^O eq 'MacOS') {
6826 Mac::BuildTools::make($self);
6831 while (my($k,$v) = each %ENV) {
6832 next unless defined $v;
6837 if (my $commandline = $self->prefs->{pl}{commandline}) {
6838 $system = $commandline;
6840 } elsif ($self->{'configure'}) {
6841 $system = $self->{'configure'};
6842 } elsif ($self->{modulebuild}) {
6843 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
6844 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
6846 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
6848 # This needs a handler that can be turned on or off:
6849 # $switch = "-MExtUtils::MakeMaker ".
6850 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
6852 my $makepl_arg = $self->make_x_arg("pl");
6853 $system = sprintf("%s%s Makefile.PL%s",
6855 $switch ? " $switch" : "",
6856 $makepl_arg ? " $makepl_arg" : "",
6859 if (my $env = $self->prefs->{pl}{env}) {
6860 for my $e (keys %$env) {
6861 $ENV{$e} = $env->{$e};
6864 if (exists $self->{writemakefile}) {
6866 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
6870 if ($CPAN::Config->{inactivity_timeout}) {
6872 if ($Config::Config{d_alarm}
6874 $Config::Config{d_alarm} eq "define"
6878 $CPAN::Frontend->mywarn("Warning: you have configured the config ".
6879 "variable 'inactivity_timeout' to ".
6880 "'$CPAN::Config->{inactivity_timeout}'. But ".
6881 "on this machine the system call 'alarm' ".
6882 "isn't available. This means that we cannot ".
6883 "provide the feature of intercepting long ".
6884 "waiting code and will turn this feature off.\n"
6886 $CPAN::Config->{inactivity_timeout} = 0;
6889 if ($go_via_alarm) {
6891 alarm $CPAN::Config->{inactivity_timeout};
6892 local $SIG{CHLD}; # = sub { wait };
6893 if (defined($pid = fork)) {
6898 # note, this exec isn't necessary if
6899 # inactivity_timeout is 0. On the Mac I'd
6900 # suggest, we set it always to 0.
6904 $CPAN::Frontend->myprint("Cannot fork: $!");
6913 $CPAN::Frontend->myprint($err);
6914 $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
6919 if (my $expect_model = $self->_prefs_with_expect("pl")) {
6920 $ret = $self->_run_via_expect($system,$expect_model);
6922 && $self->{writemakefile}
6923 && $self->{writemakefile}->failed) {
6928 $ret = system($system);
6931 $self->{writemakefile} = CPAN::Distrostatus
6932 ->new("NO '$system' returned status $ret");
6933 $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
6934 $self->store_persistent_state;
6935 $self->store_persistent_state;
6939 if (-f "Makefile" || -f "Build") {
6940 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
6941 delete $self->{make_clean}; # if cleaned before, enable next
6943 $self->{writemakefile} = CPAN::Distrostatus
6944 ->new(qq{NO -- Unknown reason});
6948 delete $self->{force_update};
6951 if (my @prereq = $self->unsat_prereq){
6952 if ($prereq[0][0] eq "perl") {
6953 my $need = "requires perl '$prereq[0][1]'";
6954 my $id = $self->pretty_id;
6955 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
6956 $self->{make} = CPAN::Distrostatus->new("NO $need");
6957 $self->store_persistent_state;
6960 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
6964 delete $self->{force_update};
6967 if (my $commandline = $self->prefs->{make}{commandline}) {
6968 $system = $commandline;
6971 if ($self->{modulebuild}) {
6972 unless (-f "Build") {
6973 my $cwd = CPAN::anycwd();
6974 $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'".
6975 " in cwd[$cwd]. Danger, Will Robinson!");
6976 $CPAN::Frontend->mysleep(5);
6978 $system = join " ", $self->_build_command(), $CPAN::Config->{mbuild_arg};
6980 $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
6982 $system =~ s/\s+$//;
6983 my $make_arg = $self->make_x_arg("make");
6984 $system = sprintf("%s%s",
6986 $make_arg ? " $make_arg" : "",
6989 if (my $env = $self->prefs->{make}{env}) { # overriding the local
6990 # ENV of PL, not the
6992 # unlikely to be a risk
6993 for my $e (keys %$env) {
6994 $ENV{$e} = $env->{$e};
6997 my $expect_model = $self->_prefs_with_expect("make");
6998 my $want_expect = 0;
6999 if ( $expect_model && @{$expect_model->{talk}} ) {
7000 my $can_expect = $CPAN::META->has_inst("Expect");
7004 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
7010 $system_ok = $self->_run_via_expect($system,$expect_model) == 0;
7012 $system_ok = system($system) == 0;
7014 $self->introduce_myself;
7016 $CPAN::Frontend->myprint(" $system -- OK\n");
7017 $self->{make} = CPAN::Distrostatus->new("YES");
7019 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
7020 $self->{make} = CPAN::Distrostatus->new("NO");
7021 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
7023 $self->store_persistent_state;
7026 # CPAN::Distribution::_run_via_expect
7027 sub _run_via_expect {
7028 my($self,$system,$expect_model) = @_;
7029 CPAN->debug("system[$system]expect_model[$expect_model]") if $CPAN::DEBUG;
7030 if ($CPAN::META->has_inst("Expect")) {
7031 my $expo = Expect->new; # expo Expect object;
7032 $expo->spawn($system);
7033 $expect_model->{mode} ||= "deterministic";
7034 if ($expect_model->{mode} eq "deterministic") {
7035 return $self->_run_via_expect_deterministic($expo,$expect_model);
7036 } elsif ($expect_model->{mode} eq "anyorder") {
7037 return $self->_run_via_expect_anyorder($expo,$expect_model);
7039 die "Panic: Illegal expect mode: $expect_model->{mode}";
7042 $CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n");
7043 return system($system);
7047 sub _run_via_expect_anyorder {
7048 my($self,$expo,$expect_model) = @_;
7049 my $timeout = $expect_model->{timeout} || 5;
7050 my @expectacopy = @{$expect_model->{talk}}; # we trash it!
7053 my($eof,$ran_into_timeout);
7054 my @match = $expo->expect($timeout,
7059 $ran_into_timeout++;
7066 $but .= $expo->clear_accum;
7069 return $expo->exitstatus();
7070 } elsif ($ran_into_timeout) {
7071 # warn "DEBUG: they are asking a question, but[$but]";
7072 for (my $i = 0; $i <= $#expectacopy; $i+=2) {
7073 my($next,$send) = @expectacopy[$i,$i+1];
7074 my $regex = eval "qr{$next}";
7075 # warn "DEBUG: will compare with regex[$regex].";
7076 if ($but =~ /$regex/) {
7077 # warn "DEBUG: will send send[$send]";
7079 splice @expectacopy, $i, 2; # never allow reusing an QA pair
7083 my $why = "could not answer a question during the dialog";
7084 $CPAN::Frontend->mywarn("Failing: $why\n");
7085 $self->{writemakefile} =
7086 CPAN::Distrostatus->new("NO $why");
7092 sub _run_via_expect_deterministic {
7093 my($self,$expo,$expect_model) = @_;
7094 my $ran_into_timeout;
7095 my $timeout = $expect_model->{timeout} || 15; # currently unsettable
7096 my $expecta = $expect_model->{talk};
7097 EXPECT: for (my $i = 0; $i <= $#$expecta; $i+=2) {
7098 my($re,$send) = @$expecta[$i,$i+1];
7099 CPAN->debug("timeout[$timeout]re[$re]") if $CPAN::DEBUG;
7100 my $regex = eval "qr{$re}";
7101 $expo->expect($timeout,
7103 my $but = $expo->clear_accum;
7104 $CPAN::Frontend->mywarn("EOF (maybe harmless)
7105 expected[$regex]\nbut[$but]\n\n");
7109 my $but = $expo->clear_accum;
7110 $CPAN::Frontend->mywarn("TIMEOUT
7111 expected[$regex]\nbut[$but]\n\n");
7112 $ran_into_timeout++;
7115 if ($ran_into_timeout){
7116 # note that the caller expects 0 for success
7117 $self->{writemakefile} =
7118 CPAN::Distrostatus->new("NO timeout during expect dialog");
7124 return $expo->exitstatus();
7127 #-> CPAN::Distribution::_validate_distropref
7128 sub _validate_distropref {
7129 my($self,@args) = @_;
7131 $CPAN::META->has_inst("CPAN::Kwalify")
7133 $CPAN::META->has_inst("Kwalify")
7135 eval {CPAN::Kwalify::_validate("distroprefs",@args);};
7137 $CPAN::Frontend->mywarn($@);
7140 CPAN->debug("not validating '@args'") if $CPAN::DEBUG;
7144 #-> CPAN::Distribution::_find_prefs
7147 my $distroid = $self->pretty_id;
7148 #CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
7149 my $prefs_dir = $CPAN::Config->{prefs_dir};
7150 eval { File::Path::mkpath($prefs_dir); };
7152 $CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
7154 my $yaml_module = CPAN::_yaml_module;
7156 if ($CPAN::META->has_inst($yaml_module)) {
7157 push @extensions, "yml";
7160 if ($CPAN::META->has_inst("Data::Dumper")) {
7161 push @extensions, "dd";
7162 push @fallbacks, "Data::Dumper";
7164 if ($CPAN::META->has_inst("Storable")) {
7165 push @extensions, "st";
7166 push @fallbacks, "Storable";
7170 unless ($self->{have_complained_about_missing_yaml}++) {
7171 $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back ".
7172 "to @fallbacks to read prefs '$prefs_dir'\n");
7175 unless ($self->{have_complained_about_missing_yaml}++) {
7176 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot ".
7177 "read prefs '$prefs_dir'\n");
7182 my $dh = DirHandle->new($prefs_dir)
7183 or die Carp::croak("Couldn't open '$prefs_dir': $!");
7184 DIRENT: for (sort $dh->read) {
7185 next if $_ eq "." || $_ eq "..";
7186 my $exte = join "|", @extensions;
7187 next unless /\.($exte)$/;
7189 my $abs = File::Spec->catfile($prefs_dir, $_);
7191 #CPAN->debug(sprintf "abs[%s]", $abs) if $CPAN::DEBUG;
7193 if ($thisexte eq "yml") {
7194 # need no eval because if we have no YAML we do not try to read *.yml
7195 #CPAN->debug(sprintf "before yaml load abs[%s]", $abs) if $CPAN::DEBUG;
7196 @distropref = @{CPAN->_yaml_loadfile($abs)};
7197 #CPAN->debug(sprintf "after yaml load abs[%s]", $abs) if $CPAN::DEBUG;
7198 } elsif ($thisexte eq "dd") {
7201 open FH, "<$abs" or $CPAN::Frontend->mydie("Could not open '$abs': $!");
7207 $CPAN::Frontend->mydie("Error in distroprefs file $_\: $@");
7210 while (${"VAR".$i}) {
7211 push @distropref, ${"VAR".$i};
7214 } elsif ($thisexte eq "st") {
7215 # eval because Storable is never forward compatible
7216 eval { @distropref = @{scalar Storable::retrieve($abs)}; };
7218 $CPAN::Frontend->mywarn("Error reading distroprefs file ".
7219 "$_, skipping\: $@");
7220 $CPAN::Frontend->mysleep(4);
7225 #CPAN->debug(sprintf "#distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
7226 ELEMENT: for my $y (0..$#distropref) {
7227 my $distropref = $distropref[$y];
7228 $self->_validate_distropref($distropref,$abs,$y);
7229 my $match = $distropref->{match};
7231 #CPAN->debug("no 'match' in abs[$abs], skipping") if $CPAN::DEBUG;
7235 # do not take the order of C<keys %$match> because
7236 # "module" is by far the slowest
7237 for my $sub_attribute (qw(distribution perl module)) {
7238 next unless exists $match->{$sub_attribute};
7239 my $qr = eval "qr{$distropref->{match}{$sub_attribute}}";
7240 if ($sub_attribute eq "module") {
7242 #CPAN->debug(sprintf "distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
7243 my @modules = $self->containsmods;
7244 #CPAN->debug(sprintf "modules[%s]", join(",",@modules)) if $CPAN::DEBUG;
7245 MODULE: for my $module (@modules) {
7246 $okm ||= $module =~ /$qr/;
7247 last MODULE if $okm;
7250 } elsif ($sub_attribute eq "distribution") {
7251 my $okd = $distroid =~ /$qr/;
7253 } elsif ($sub_attribute eq "perl") {
7254 my $okp = $^X =~ /$qr/;
7257 $CPAN::Frontend->mydie("Nonconforming .$thisexte file '$abs': ".
7258 "unknown sub_attribut '$sub_attribute'. ".
7260 "remove, cannot continue.");
7262 last if $ok == 0; # short circuit
7264 #CPAN->debug(sprintf "ok[%d]", $ok) if $CPAN::DEBUG;
7267 prefs => $distropref,
7269 prefs_file_doc => $y,
7281 # CPAN::Distribution::prefs
7284 if (exists $self->{negative_prefs_cache}
7286 $self->{negative_prefs_cache} != $CPAN::CurrentCommandId
7288 delete $self->{negative_prefs_cache};
7289 delete $self->{prefs};
7291 if (exists $self->{prefs}) {
7292 return $self->{prefs}; # XXX comment out during debugging
7294 if ($CPAN::Config->{prefs_dir}) {
7295 CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG;
7296 my $prefs = $self->_find_prefs();
7297 $prefs ||= ""; # avoid warning next line
7298 CPAN->debug("prefs[$prefs]") if $CPAN::DEBUG;
7300 for my $x (qw(prefs prefs_file prefs_file_doc)) {
7301 $self->{$x} = $prefs->{$x};
7305 File::Basename::basename($self->{prefs_file}),
7306 $self->{prefs_file_doc},
7308 my $filler1 = "_" x 22;
7309 my $filler2 = int(66 - length($bs))/2;
7310 $filler2 = 0 if $filler2 < 0;
7311 $filler2 = " " x $filler2;
7312 $CPAN::Frontend->myprint("
7313 $filler1 D i s t r o P r e f s $filler1
7314 $filler2 $bs $filler2
7316 $CPAN::Frontend->mysleep(1);
7317 return $self->{prefs};
7320 $self->{negative_prefs_cache} = $CPAN::CurrentCommandId;
7321 return $self->{prefs} = +{};
7324 # CPAN::Distribution::make_x_arg
7326 my($self, $whixh) = @_;
7328 my $prefs = $self->prefs;
7331 && exists $prefs->{$whixh}
7332 && exists $prefs->{$whixh}{args}
7333 && $prefs->{$whixh}{args}
7335 $make_x_arg = join(" ",
7336 map {CPAN::HandleConfig
7337 ->safe_quote($_)} @{$prefs->{$whixh}{args}},
7340 my $what = sprintf "make%s_arg", $whixh eq "make" ? "" : $whixh;
7341 $make_x_arg ||= $CPAN::Config->{$what};
7345 # CPAN::Distribution::_make_command
7352 CPAN::HandleConfig->prefs_lookup($self,
7354 || $Config::Config{make}
7358 # Old style call, without object. Deprecated
7359 Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
7362 CPAN::HandleConfig->prefs_lookup($self,q{make})
7363 || $CPAN::Config->{make}
7364 || $Config::Config{make}
7369 #-> sub CPAN::Distribution::follow_prereqs ;
7370 sub follow_prereqs {
7372 my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_;
7373 return unless @prereq_tuples;
7374 my @prereq = map { $_->[0] } @prereq_tuples;
7375 my $pretty_id = $self->pretty_id;
7377 b => "build_requires",
7381 my($filler1,$filler2,$filler3,$filler4);
7383 my $unsat = "Unsatisfied dependencies detected during";
7384 my $w = length($unsat) > length($pretty_id) ? length($unsat) : length($pretty_id);
7386 my $r = int(($w - length($unsat))/2);
7387 my $l = $w - length($unsat) - $r;
7388 $filler1 = "-"x4 . " "x$l;
7389 $filler2 = " "x$r . "-"x4 . "\n";
7392 my $r = int(($w - length($pretty_id))/2);
7393 my $l = $w - length($pretty_id) - $r;
7394 $filler3 = "-"x4 . " "x$l;
7395 $filler4 = " "x$r . "-"x4 . "\n";
7398 myprint("$filler1 $unsat $filler2".
7399 "$filler3 $pretty_id $filler4".
7400 join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @prereq_tuples),
7403 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
7405 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
7406 my $answer = CPAN::Shell::colorable_makemaker_prompt(
7407 "Shall I follow them and prepend them to the queue
7408 of modules we are processing right now?", "yes");
7409 $follow = $answer =~ /^\s*y/i;
7413 myprint(" Ignoring dependencies on modules @prereq\n");
7417 # color them as dirty
7418 for my $p (@prereq) {
7419 # warn "calling color_cmd_tmps(0,1)";
7420 my $any = CPAN::Shell->expandany($p);
7422 $any->color_cmd_tmps(0,2);
7424 $CPAN::Frontend->mywarn("Warning (maybe a bug): Cannot expand prereq '$p'\n");
7425 $CPAN::Frontend->mysleep(2);
7428 # queue them and re-queue yourself
7429 CPAN::Queue->jumpqueue([$id,$self->{reqtype}],
7430 reverse @prereq_tuples);
7431 $self->{later} = "Delayed until after prerequisites";
7432 return 1; # signal success to the queuerunner
7436 #-> sub CPAN::Distribution::unsat_prereq ;
7437 # return ([Foo=>1],[Bar=>1.2]) for normal modules
7438 # return ([perl=>5.008]) if we need a newer perl than we are running under
7441 my $prereq_pm = $self->prereq_pm or return;
7443 my %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
7444 my @merged = %merged;
7445 CPAN->debug("all merged_prereqs[@merged]") if $CPAN::DEBUG;
7446 NEED: while (my($need_module, $need_version) = each %merged) {
7447 my($available_version,$available_file,$nmo);
7448 if ($need_module eq "perl") {
7449 $available_version = $];
7450 $available_file = $^X;
7452 $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
7453 next if $nmo->uptodate;
7454 $available_file = $nmo->available_file;
7456 # if they have not specified a version, we accept any installed one
7457 if (not defined $need_version or
7458 $need_version == 0 or
7459 $need_version eq "undef") {
7460 next if defined $available_file;
7463 $available_version = $nmo->available_version;
7466 # We only want to install prereqs if either they're not installed
7467 # or if the installed version is too old. We cannot omit this
7468 # check, because if 'force' is in effect, nobody else will check.
7469 if (defined $available_file) {
7470 my(@all_requirements) = split /\s*,\s*/, $need_version;
7473 RQ: for my $rq (@all_requirements) {
7474 if ($rq =~ s|>=\s*||) {
7475 } elsif ($rq =~ s|>\s*||) {
7477 if (CPAN::Version->vgt($available_version,$rq)){
7481 } elsif ($rq =~ s|!=\s*||) {
7483 if (CPAN::Version->vcmp($available_version,$rq)){
7489 } elsif ($rq =~ m|<=?\s*|) {
7491 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])\n");
7495 if (! CPAN::Version->vgt($rq, $available_version)){
7498 CPAN->debug(sprintf("need_module[%s]available_file[%s]".
7499 "available_version[%s]rq[%s]ok[%d]",
7503 CPAN::Version->readable($rq),
7507 next NEED if $ok == @all_requirements;
7510 if ($need_module eq "perl") {
7511 return ["perl", $need_version];
7513 if ($self->{sponsored_mods}{$need_module}++){
7514 # We have already sponsored it and for some reason it's still
7515 # not available. So we do ... what??
7517 # if we push it again, we have a potential infinite loop
7519 # The following "next" was a very problematic construct.
7520 # It helped a lot but broke some day and must be replaced.
7522 # We must be able to deal with modules that come again and
7523 # again as a prereq and have themselves prereqs and the
7524 # queue becomes long but finally we would find the correct
7525 # order. The RecursiveDependency check should trigger a
7526 # die when it's becoming too weird. Unfortunately removing
7527 # this next breaks many other things.
7529 # The bug that brought this up is described in Todo under
7530 # "5.8.9 cannot install Compress::Zlib"
7532 # next; # this is the next that must go away
7534 # The following "next NEED" are fine and the error message
7535 # explains well what is going on. For example when the DBI
7536 # fails and consequently DBD::SQLite fails and now we are
7537 # processing CPAN::SQLite. Then we must have a "next" for
7538 # DBD::SQLite. How can we get it and how can we identify
7539 # all other cases we must identify?
7541 my $do = $nmo->distribution;
7542 next NEED unless $do; # not on CPAN
7543 NOSAYER: for my $nosayer (
7554 &&(UNIVERSAL::can($do->{$nosayer},"failed") ?
7555 $do->{$nosayer}->failed :
7556 $do->{$nosayer} =~ /^NO/)
7558 if ($nosayer eq "make_test"
7560 $do->{make_test}{COMMANDID} != $CPAN::CurrentCommandId
7564 $CPAN::Frontend->mywarn("Warning: Prerequisite ".
7565 "'$need_module => $need_version' ".
7566 "for '$self->{ID}' failed when ".
7567 "processing '$do->{ID}' with ".
7568 "'$nosayer => $do->{$nosayer}'. Continuing, ".
7569 "but chances to succeed are limited.\n"
7575 my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
7576 push @need, [$need_module,$needed_as];
7578 my @unfolded = map { "[".join(",",@$_)."]" } @need;
7579 CPAN->debug("returning from unsat_prereq[@unfolded]") if $CPAN::DEBUG;
7583 #-> sub CPAN::Distribution::read_yaml ;
7586 return $self->{yaml_content} if exists $self->{yaml_content};
7587 my $build_dir = $self->{build_dir};
7588 my $yaml = File::Spec->catfile($build_dir,"META.yml");
7589 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
7590 return unless -f $yaml;
7591 eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml)->[0]; };
7593 $CPAN::Frontend->mywarn("Could not read ".
7594 "'$yaml'. Falling back to other ".
7595 "methods to determine prerequisites\n");
7596 return $self->{yaml_content} = undef; # if we die, then we
7597 # cannot read YAML's own
7600 # not "authoritative"
7601 if (not exists $self->{yaml_content}{dynamic_config}
7602 or $self->{yaml_content}{dynamic_config}
7604 $self->{yaml_content} = undef;
7606 $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
7608 return $self->{yaml_content};
7611 #-> sub CPAN::Distribution::prereq_pm ;
7614 $self->{prereq_pm_detected} ||= 0;
7615 CPAN->debug("ID[$self->{ID}]prereq_pm_detected[$self->{prereq_pm_detected}]") if $CPAN::DEBUG;
7616 return $self->{prereq_pm} if $self->{prereq_pm_detected};
7617 return unless $self->{writemakefile} # no need to have succeeded
7618 # but we must have run it
7619 || $self->{modulebuild};
7620 CPAN->debug(sprintf "writemakefile[%s]modulebuild[%s]",
7621 $self->{writemakefile}||"",
7622 $self->{modulebuild}||"",
7625 if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
7626 $req = $yaml->{requires} || {};
7627 $breq = $yaml->{build_requires} || {};
7628 undef $req unless ref $req eq "HASH" && %$req;
7630 if ($yaml->{generated_by} &&
7631 $yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
7632 my $eummv = do { local $^W = 0; $1+0; };
7633 if ($eummv < 6.2501) {
7634 # thanks to Slaven for digging that out: MM before
7635 # that could be wrong because it could reflect a
7642 while (my($k,$v) = each %{$req||{}}) {
7645 } elsif ($k =~ /[A-Za-z]/ &&
7647 $CPAN::META->exists("Module",$v)
7649 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
7650 "requires hash: $k => $v; I'll take both ".
7651 "key and value as a module name\n");
7652 $CPAN::Frontend->mysleep(1);
7658 $req = $areq if $do_replace;
7661 unless ($req || $breq) {
7662 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
7663 my $makefile = File::Spec->catfile($build_dir,"Makefile");
7667 $fh = FileHandle->new("<$makefile\0")) {
7668 CPAN->debug("Getting prereq from Makefile") if $CPAN::DEBUG;
7671 last if /MakeMaker post_initialize section/;
7673 \s+PREREQ_PM\s+=>\s+(.+)
7676 # warn "Found prereq expr[$p]";
7678 # Regexp modified by A.Speer to remember actual version of file
7679 # PREREQ_PM hash key wants, then add to
7680 while ( $p =~ m/(?:\s)([\w\:]+)=>(q\[.*?\]|undef),?/g ){
7681 # In case a prereq is mentioned twice, complain.
7682 if ( defined $req->{$1} ) {
7683 warn "Warning: PREREQ_PM mentions $1 more than once, ".
7684 "last mention wins";
7686 my($m,$n) = ($1,$2);
7687 if ($n =~ /^q\[(.*?)\]$/) {
7696 unless ($req || $breq) {
7697 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
7698 my $buildfile = File::Spec->catfile($build_dir,"Build");
7699 if (-f $buildfile) {
7700 CPAN->debug("Found '$buildfile'") if $CPAN::DEBUG;
7701 my $build_prereqs = File::Spec->catfile($build_dir,"_build","prereqs");
7702 if (-f $build_prereqs) {
7703 CPAN->debug("Getting prerequisites from '$build_prereqs'") if $CPAN::DEBUG;
7704 my $content = do { local *FH;
7705 open FH, $build_prereqs
7706 or $CPAN::Frontend->mydie("Could not open ".
7707 "'$build_prereqs': $!");
7711 my $bphash = eval $content;
7714 $req = $bphash->{requires} || +{};
7715 $breq = $bphash->{build_requires} || +{};
7721 && ! -f "Makefile.PL"
7722 && ! exists $req->{"Module::Build"}
7723 && ! $CPAN::META->has_inst("Module::Build")) {
7724 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
7725 "undeclared prerequisite.\n".
7726 " Adding it now as such.\n"
7728 $CPAN::Frontend->mysleep(5);
7729 $req->{"Module::Build"} = 0;
7730 delete $self->{writemakefile};
7732 if ($req || $breq) {
7733 $self->{prereq_pm_detected}++;
7734 return $self->{prereq_pm} = { requires => $req, build_requires => $breq };
7738 #-> sub CPAN::Distribution::test ;
7741 if (my $goto = $self->prefs->{goto}) {
7742 return $self->goto($goto);
7746 delete $self->{force_update};
7749 # warn "XDEBUG: checking for notest: $self->{notest} $self";
7750 if ($self->{notest}) {
7751 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
7755 my $make = $self->{modulebuild} ? "Build" : "make";
7757 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
7759 : ($ENV{PERLLIB} || "");
7761 $CPAN::META->set_perl5lib;
7762 local $ENV{MAKEFLAGS}; # protect us from outer make calls
7764 $CPAN::Frontend->myprint("Running $make test\n");
7766 # if (my @prereq = $self->unsat_prereq){
7767 # if ( $CPAN::DEBUG ) {
7768 # require Data::Dumper;
7769 # CPAN->debug(sprintf "unsat_prereq[%s]", Data::Dumper::Dumper(\@prereq));
7771 # unless ($prereq[0][0] eq "perl") {
7772 # return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
7778 unless (exists $self->{make} or exists $self->{later}) {
7780 "Make had some problems, won't test";
7783 exists $self->{make} and
7785 UNIVERSAL::can($self->{make},"failed") ?
7786 $self->{make}->failed :
7787 $self->{make} =~ /^NO/
7788 ) and push @e, "Can't test without successful make";
7790 $self->{badtestcnt} ||= 0;
7791 if ($self->{badtestcnt} > 0) {
7792 require Data::Dumper;
7793 CPAN->debug(sprintf "NOREPEAT[%s]", Data::Dumper::Dumper($self)) if $CPAN::DEBUG;
7794 push @e, "Won't repeat unsuccessful test during this command";
7797 exists $self->{later} and length($self->{later}) and
7798 push @e, $self->{later};
7800 if (exists $self->{build_dir}) {
7801 if ($CPAN::META->{is_tested}{$self->{build_dir}}
7803 exists $self->{make_test}
7806 UNIVERSAL::can($self->{make_test},"failed") ?
7807 $self->{make_test}->failed :
7808 $self->{make_test} =~ /^NO/
7811 push @e, "Has already been tested successfully";
7814 push @e, "Has no own directory";
7816 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
7817 unless (chdir $self->{build_dir}) {
7818 push @e, "Couldn't chdir to '$self->{build_dir}': $!";
7820 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
7822 $self->debug("Changed directory to $self->{build_dir}")
7825 if ($^O eq 'MacOS') {
7826 Mac::BuildTools::make_test($self);
7830 if ($self->{modulebuild}) {
7831 my $v = CPAN::Shell->expand("Module","Test::Harness")->inst_version;
7832 if (CPAN::Version->vlt($v,2.62)) {
7833 $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only
7834 '$v', you need at least '2.62'. Please upgrade your Test::Harness.\n});
7835 $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old");
7841 if (my $commandline = $self->prefs->{test}{commandline}) {
7842 $system = $commandline;
7844 } elsif ($self->{modulebuild}) {
7845 $system = sprintf "%s test", $self->_build_command();
7847 $system = join " ", $self->_make_command(), "test";
7849 my $make_test_arg = $self->make_x_arg("test");
7850 $system = sprintf("%s%s",
7852 $make_test_arg ? " $make_test_arg" : "",
7856 while (my($k,$v) = each %ENV) {
7857 next unless defined $v;
7861 if (my $env = $self->prefs->{test}{env}) {
7862 for my $e (keys %$env) {
7863 $ENV{$e} = $env->{$e};
7866 my $expect_model = $self->_prefs_with_expect("test");
7867 my $want_expect = 0;
7868 if ( $expect_model && @{$expect_model->{talk}} ) {
7869 my $can_expect = $CPAN::META->has_inst("Expect");
7873 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
7874 "testing without\n");
7877 my $test_report = CPAN::HandleConfig->prefs_lookup($self,
7881 my $can_report = $CPAN::META->has_inst("CPAN::Reporter");
7885 $CPAN::Frontend->mywarn("CPAN::Reporter not installed, falling back to ".
7886 "testing without\n");
7889 my $ready_to_report = $want_report;
7890 if ($ready_to_report
7892 substr($self->id,-1,1) eq "."
7894 $self->author->id eq "LOCAL"
7897 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
7898 "for local directories\n");
7899 $ready_to_report = 0;
7901 if ($ready_to_report
7903 $self->prefs->{patches}
7905 @{$self->prefs->{patches}}
7909 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
7910 "when the source has been patched\n");
7911 $ready_to_report = 0;
7914 if ($ready_to_report) {
7915 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is currently ".
7916 "not supported when distroprefs specify ".
7917 "an interactive test\n");
7919 $tests_ok = $self->_run_via_expect($system,$expect_model) == 0;
7920 } elsif ( $ready_to_report ) {
7921 $tests_ok = CPAN::Reporter::test($self, $system);
7923 $tests_ok = system($system) == 0;
7925 $self->introduce_myself;
7930 # local $CPAN::DEBUG = 16; # Distribution
7931 for my $m (keys %{$self->{sponsored_mods}}) {
7932 my $m_obj = CPAN::Shell->expand("Module",$m) or next;
7933 # XXX we need available_version which reflects
7934 # $ENV{PERL5LIB} so that already tested but not yet
7935 # installed modules are counted.
7936 my $available_version = $m_obj->available_version;
7937 my $available_file = $m_obj->available_file;
7938 if ($available_version &&
7939 !CPAN::Version->vlt($available_version,$self->{prereq_pm}{$m})
7941 CPAN->debug("m[$m] good enough available_version[$available_version]")
7943 } elsif ($available_file
7945 !$self->{prereq_pm}{$m}
7947 $self->{prereq_pm}{$m} == 0
7950 # lex Class::Accessor::Chained::Fast which has no $VERSION
7951 CPAN->debug("m[$m] have available_file[$available_file]")
7959 my $which = join ",", @prereq;
7960 my $but = $cnt == 1 ? "one dependency not OK ($which)" :
7961 "$cnt dependencies missing ($which)";
7962 $CPAN::Frontend->mywarn("Tests succeeded but $but\n");
7963 $self->{make_test} = CPAN::Distrostatus->new("NO $but");
7964 $self->store_persistent_state;
7969 $CPAN::Frontend->myprint(" $system -- OK\n");
7970 $self->{make_test} = CPAN::Distrostatus->new("YES");
7971 $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
7972 # probably impossible to need the next line because badtestcnt
7973 # has a lifespan of one command
7974 delete $self->{badtestcnt};
7976 $self->{make_test} = CPAN::Distrostatus->new("NO");
7977 $self->{badtestcnt}++;
7978 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
7980 $self->store_persistent_state;
7983 sub _prefs_with_expect {
7984 my($self,$where) = @_;
7985 return unless my $prefs = $self->prefs;
7986 return unless my $where_prefs = $prefs->{$where};
7987 if ($where_prefs->{expect}) {
7989 mode => "deterministic",
7991 talk => $where_prefs->{expect},
7993 } elsif ($where_prefs->{"eexpect"}) {
7994 return $where_prefs->{"eexpect"};
7999 #-> sub CPAN::Distribution::clean ;
8002 my $make = $self->{modulebuild} ? "Build" : "make";
8003 $CPAN::Frontend->myprint("Running $make clean\n");
8004 unless (exists $self->{archived}) {
8005 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
8006 "/untarred, nothing done\n");
8009 unless (exists $self->{build_dir}) {
8010 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
8015 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
8016 push @e, "make clean already called once";
8017 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
8019 chdir $self->{build_dir} or
8020 Carp::confess("Couldn't chdir to $self->{build_dir}: $!");
8021 $self->debug("Changed directory to $self->{build_dir}") if $CPAN::DEBUG;
8023 if ($^O eq 'MacOS') {
8024 Mac::BuildTools::make_clean($self);
8029 if ($self->{modulebuild}) {
8030 unless (-f "Build") {
8031 my $cwd = CPAN::anycwd();
8032 $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}".
8033 " in cwd[$cwd]. Danger, Will Robinson!");
8034 $CPAN::Frontend->mysleep(5);
8036 $system = sprintf "%s clean", $self->_build_command();
8038 $system = join " ", $self->_make_command(), "clean";
8040 my $system_ok = system($system) == 0;
8041 $self->introduce_myself;
8043 $CPAN::Frontend->myprint(" $system -- OK\n");
8047 # Jost Krieger pointed out that this "force" was wrong because
8048 # it has the effect that the next "install" on this distribution
8049 # will untar everything again. Instead we should bring the
8050 # object's state back to where it is after untarring.
8061 $self->{make_clean} = CPAN::Distrostatus->new("YES");
8064 # Hmmm, what to do if make clean failed?
8066 $self->{make_clean} = CPAN::Distrostatus->new("NO");
8067 $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n});
8069 # 2006-02-27: seems silly to me to force a make now
8070 # $self->force("make"); # so that this directory won't be used again
8073 $self->store_persistent_state;
8076 #-> sub CPAN::Distribution::goto ;
8078 my($self,$goto) = @_;
8079 $goto = $self->normalize($goto);
8081 # inject into the queue
8083 CPAN::Queue->delete($self->id);
8084 CPAN::Queue->jumpqueue([$goto,$self->{reqtype}]);
8086 # and run where we left off
8088 my($method) = (caller(1))[3];
8089 CPAN->instance("CPAN::Distribution",$goto)->$method;
8090 CPAN::Queue->delete_first($goto);
8093 #-> sub CPAN::Distribution::install ;
8096 if (my $goto = $self->prefs->{goto}) {
8097 return $self->goto($goto);
8100 unless ($self->{badtestcnt}) {
8104 delete $self->{force_update};
8107 my $make = $self->{modulebuild} ? "Build" : "make";
8108 $CPAN::Frontend->myprint("Running $make install\n");
8111 unless (exists $self->{make} or exists $self->{later}) {
8113 "Make had some problems, won't install";
8116 exists $self->{make} and
8118 UNIVERSAL::can($self->{make},"failed") ?
8119 $self->{make}->failed :
8120 $self->{make} =~ /^NO/
8122 push @e, "Make had returned bad status, install seems impossible";
8124 if (exists $self->{build_dir}) {
8126 push @e, "Has no own directory";
8129 if (exists $self->{make_test} and
8131 UNIVERSAL::can($self->{make_test},"failed") ?
8132 $self->{make_test}->failed :
8133 $self->{make_test} =~ /^NO/
8135 if ($self->{force_update}) {
8136 $self->{make_test}->text("FAILED but failure ignored because ".
8137 "'force' in effect");
8139 push @e, "make test had returned bad status, ".
8140 "won't install without force"
8143 if (exists $self->{install}) {
8144 if (UNIVERSAL::can($self->{install},"text") ?
8145 $self->{install}->text eq "YES" :
8146 $self->{install} =~ /^YES/
8148 push @e, "Already done";
8150 # comment in Todo on 2006-02-11; maybe retry?
8151 push @e, "Already tried without success";
8155 exists $self->{later} and length($self->{later}) and
8156 push @e, $self->{later};
8158 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
8159 unless (chdir $self->{build_dir}) {
8160 push @e, "Couldn't chdir to '$self->{build_dir}': $!";
8162 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
8164 $self->debug("Changed directory to $self->{build_dir}")
8167 if ($^O eq 'MacOS') {
8168 Mac::BuildTools::make_install($self);
8173 if (my $commandline = $self->prefs->{install}{commandline}) {
8174 $system = $commandline;
8176 } elsif ($self->{modulebuild}) {
8177 my($mbuild_install_build_command) =
8178 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
8179 $CPAN::Config->{mbuild_install_build_command} ?
8180 $CPAN::Config->{mbuild_install_build_command} :
8181 $self->_build_command();
8182 $system = sprintf("%s install %s",
8183 $mbuild_install_build_command,
8184 $CPAN::Config->{mbuild_install_arg},
8187 my($make_install_make_command) =
8188 CPAN::HandleConfig->prefs_lookup($self,
8189 q{make_install_make_command})
8190 || $self->_make_command();
8191 $system = sprintf("%s install %s",
8192 $make_install_make_command,
8193 $CPAN::Config->{make_install_arg},
8197 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
8198 my $brip = CPAN::HandleConfig->prefs_lookup($self,
8199 q{build_requires_install_policy});
8202 my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command
8203 my $want_install = "yes";
8204 if ($reqtype eq "b") {
8205 if ($brip eq "no") {
8206 $want_install = "no";
8207 } elsif ($brip =~ m|^ask/(.+)|) {
8209 $default = "yes" unless $default =~ /^(y|n)/i;
8211 CPAN::Shell::colorable_makemaker_prompt
8212 ("$id is just needed temporarily during building or testing. ".
8213 "Do you want to install it permanently? (Y/n)",
8217 unless ($want_install =~ /^y/i) {
8218 my $is_only = "is only 'build_requires'";
8219 $CPAN::Frontend->mywarn("Not installing because $is_only\n");
8220 $self->{install} = CPAN::Distrostatus->new("NO -- $is_only");
8221 delete $self->{force_update};
8224 my($pipe) = FileHandle->new("$system $stderr |");
8227 print $_; # intentionally NOT use Frontend->myprint because it
8228 # looks irritating when we markup in color what we
8229 # just pass through from an external program
8233 my $close_ok = $? == 0;
8234 $self->introduce_myself;
8236 $CPAN::Frontend->myprint(" $system -- OK\n");
8237 $CPAN::META->is_installed($self->{build_dir});
8238 $self->{install} = CPAN::Distrostatus->new("YES");
8240 $self->{install} = CPAN::Distrostatus->new("NO");
8241 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
8243 CPAN::HandleConfig->prefs_lookup($self,
8244 q{make_install_make_command});
8246 $makeout =~ /permission/s
8250 || $mimc eq (CPAN::HandleConfig->prefs_lookup($self,
8254 $CPAN::Frontend->myprint(
8256 qq{ You may have to su }.
8257 qq{to root to install the package\n}.
8258 qq{ (Or you may want to run something like\n}.
8259 qq{ o conf make_install_make_command 'sudo make'\n}.
8260 qq{ to raise your permissions.}
8264 delete $self->{force_update};
8266 $self->store_persistent_state;
8269 sub introduce_myself {
8271 $CPAN::Frontend->myprint(sprintf(" %s\n",$self->pretty_id));
8274 #-> sub CPAN::Distribution::dir ;
8279 #-> sub CPAN::Distribution::perldoc ;
8283 my($dist) = $self->id;
8284 my $package = $self->called_for;
8286 $self->_display_url( $CPAN::Defaultdocs . $package );
8289 #-> sub CPAN::Distribution::_check_binary ;
8291 my ($dist,$shell,$binary) = @_;
8294 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
8297 if ($CPAN::META->has_inst("File::Which")) {
8298 return File::Which::which($binary);
8301 $pid = open README, "which $binary|"
8302 or $CPAN::Frontend->mywarn(qq{Could not fork 'which $binary': $!\n});
8308 or $CPAN::Frontend->mywarn("Could not run 'which $binary': $!\n")
8312 $CPAN::Frontend->myprint(qq{ + $out \n})
8313 if $CPAN::DEBUG && $out;
8318 #-> sub CPAN::Distribution::_display_url ;
8320 my($self,$url) = @_;
8321 my($res,$saved_file,$pid,$out);
8323 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
8326 # should we define it in the config instead?
8327 my $html_converter = "html2text";
8329 my $web_browser = $CPAN::Config->{'lynx'} || undef;
8330 my $web_browser_out = $web_browser
8331 ? CPAN::Distribution->_check_binary($self,$web_browser)
8334 if ($web_browser_out) {
8335 # web browser found, run the action
8336 my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
8337 $CPAN::Frontend->myprint(qq{system[$browser $url]})
8339 $CPAN::Frontend->myprint(qq{
8342 with browser $browser
8344 $CPAN::Frontend->mysleep(1);
8345 system("$browser $url");
8346 if ($saved_file) { 1 while unlink($saved_file) }
8348 # web browser not found, let's try text only
8349 my $html_converter_out =
8350 CPAN::Distribution->_check_binary($self,$html_converter);
8351 $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
8353 if ($html_converter_out ) {
8354 # html2text found, run it
8355 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
8356 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
8357 unless defined($saved_file);
8360 $pid = open README, "$html_converter $saved_file |"
8361 or $CPAN::Frontend->mydie(qq{
8362 Could not fork '$html_converter $saved_file': $!});
8364 if ($CPAN::META->has_inst("File::Temp")) {
8365 $fh = File::Temp->new(
8366 template => 'cpan_htmlconvert_XXXX',
8370 $filename = $fh->filename;
8372 $filename = "cpan_htmlconvert_$$.txt";
8373 $fh = FileHandle->new();
8374 open $fh, ">$filename" or die;
8380 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
8381 my $tmpin = $fh->filename;
8382 $CPAN::Frontend->myprint(sprintf(qq{
8384 saved output to %s\n},
8392 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
8393 my $fh_pager = FileHandle->new;
8394 local($SIG{PIPE}) = "IGNORE";
8395 my $pager = $CPAN::Config->{'pager'} || "cat";
8396 $fh_pager->open("|$pager")
8397 or $CPAN::Frontend->mydie(qq{
8398 Could not open pager '$pager': $!});
8399 $CPAN::Frontend->myprint(qq{
8404 $CPAN::Frontend->mysleep(1);
8405 $fh_pager->print(<FH>);
8408 # coldn't find the web browser or html converter
8409 $CPAN::Frontend->myprint(qq{
8410 You need to install lynx or $html_converter to use this feature.});
8415 #-> sub CPAN::Distribution::_getsave_url ;
8417 my($dist, $shell, $url) = @_;
8419 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
8423 if ($CPAN::META->has_inst("File::Temp")) {
8424 $fh = File::Temp->new(
8425 template => "cpan_getsave_url_XXXX",
8429 $filename = $fh->filename;
8431 $fh = FileHandle->new;
8432 $filename = "cpan_getsave_url_$$.html";
8434 my $tmpin = $filename;
8435 if ($CPAN::META->has_usable('LWP')) {
8436 $CPAN::Frontend->myprint("Fetching with LWP:
8440 CPAN::LWP::UserAgent->config;
8441 eval { $Ua = CPAN::LWP::UserAgent->new; };
8443 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
8447 $Ua->proxy('http', $var)
8448 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
8450 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
8453 my $req = HTTP::Request->new(GET => $url);
8454 $req->header('Accept' => 'text/html');
8455 my $res = $Ua->request($req);
8456 if ($res->is_success) {
8457 $CPAN::Frontend->myprint(" + request successful.\n")
8459 print $fh $res->content;
8461 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
8465 $CPAN::Frontend->myprint(sprintf(
8466 "LWP failed with code[%s], message[%s]\n",
8473 $CPAN::Frontend->mywarn(" LWP not available\n");
8478 # sub CPAN::Distribution::_build_command
8479 sub _build_command {
8481 if ($^O eq "MSWin32") { # special code needed at least up to
8482 # Module::Build 0.2611 and 0.2706; a fix
8483 # in M:B has been promised 2006-01-30
8484 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
8485 return "$perl ./Build";
8490 package CPAN::Bundle;
8495 $CPAN::Frontend->myprint($self->as_string);
8500 delete $self->{later};
8501 for my $c ( $self->contains ) {
8502 my $obj = CPAN::Shell->expandany($c) or next;
8507 # mark as dirty/clean
8508 #-> sub CPAN::Bundle::color_cmd_tmps ;
8509 sub color_cmd_tmps {
8511 my($depth) = shift || 0;
8512 my($color) = shift || 0;
8513 my($ancestors) = shift || [];
8514 # a module needs to recurse to its cpan_file, a distribution needs
8515 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
8517 return if exists $self->{incommandcolor}
8519 && $self->{incommandcolor}==$color;
8520 if ($depth>=$CPAN::MAX_RECURSION){
8521 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
8523 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
8525 for my $c ( $self->contains ) {
8526 my $obj = CPAN::Shell->expandany($c) or next;
8527 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
8528 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
8530 # never reached code?
8532 #delete $self->{badtestcnt};
8534 $self->{incommandcolor} = $color;
8537 #-> sub CPAN::Bundle::as_string ;
8541 # following line must be "=", not "||=" because we have a moving target
8542 $self->{INST_VERSION} = $self->inst_version;
8543 return $self->SUPER::as_string;
8546 #-> sub CPAN::Bundle::contains ;
8549 my($inst_file) = $self->inst_file || "";
8550 my($id) = $self->id;
8551 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
8552 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
8555 unless ($inst_file) {
8556 # Try to get at it in the cpan directory
8557 $self->debug("no inst_file") if $CPAN::DEBUG;
8559 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
8560 $cpan_file = $self->cpan_file;
8561 if ($cpan_file eq "N/A") {
8562 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
8563 Maybe stale symlink? Maybe removed during session? Giving up.\n");
8565 my $dist = $CPAN::META->instance('CPAN::Distribution',
8567 $self->debug("before get id[$dist->{ID}]") if $CPAN::DEBUG;
8569 $self->debug("after get id[$dist->{ID}]") if $CPAN::DEBUG;
8570 my($todir) = $CPAN::Config->{'cpan_home'};
8571 my(@me,$from,$to,$me);
8572 @me = split /::/, $self->id;
8574 $me = File::Spec->catfile(@me);
8575 $from = $self->find_bundle_file($dist->{build_dir},join('/',@me));
8576 $to = File::Spec->catfile($todir,$me);
8577 File::Path::mkpath(File::Basename::dirname($to));
8578 File::Copy::copy($from, $to)
8579 or Carp::confess("Couldn't copy $from to $to: $!");
8583 my $fh = FileHandle->new;
8585 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
8587 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
8589 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
8590 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
8591 next unless $in_cont;
8596 push @result, (split " ", $_, 2)[0];
8599 delete $self->{STATUS};
8600 $self->{CONTAINS} = \@result;
8601 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
8603 $CPAN::Frontend->mywarn(qq{
8604 The bundle file "$inst_file" may be a broken
8605 bundlefile. It seems not to contain any bundle definition.
8606 Please check the file and if it is bogus, please delete it.
8607 Sorry for the inconvenience.
8613 #-> sub CPAN::Bundle::find_bundle_file
8614 # $where is in local format, $what is in unix format
8615 sub find_bundle_file {
8616 my($self,$where,$what) = @_;
8617 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
8618 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
8619 ### my $bu = File::Spec->catfile($where,$what);
8620 ### return $bu if -f $bu;
8621 my $manifest = File::Spec->catfile($where,"MANIFEST");
8622 unless (-f $manifest) {
8623 require ExtUtils::Manifest;
8624 my $cwd = CPAN::anycwd();
8625 $self->safe_chdir($where);
8626 ExtUtils::Manifest::mkmanifest();
8627 $self->safe_chdir($cwd);
8629 my $fh = FileHandle->new($manifest)
8630 or Carp::croak("Couldn't open $manifest: $!");
8632 my $bundle_filename = $what;
8633 $bundle_filename =~ s|Bundle.*/||;
8634 my $bundle_unixpath;
8637 my($file) = /(\S+)/;
8638 if ($file =~ m|\Q$what\E$|) {
8639 $bundle_unixpath = $file;
8640 # return File::Spec->catfile($where,$bundle_unixpath); # bad
8643 # retry if she managed to have no Bundle directory
8644 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
8646 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
8647 if $bundle_unixpath;
8648 Carp::croak("Couldn't find a Bundle file in $where");
8651 # needs to work quite differently from Module::inst_file because of
8652 # cpan_home/Bundle/ directory and the possibility that we have
8653 # shadowing effect. As it makes no sense to take the first in @INC for
8654 # Bundles, we parse them all for $VERSION and take the newest.
8656 #-> sub CPAN::Bundle::inst_file ;
8661 @me = split /::/, $self->id;
8664 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
8665 my $bfile = File::Spec->catfile($incdir, @me);
8666 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
8667 next unless -f $bfile;
8668 my $foundv = MM->parse_version($bfile);
8669 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
8670 $self->{INST_FILE} = $bfile;
8671 $self->{INST_VERSION} = $bestv = $foundv;
8677 #-> sub CPAN::Bundle::inst_version ;
8680 $self->inst_file; # finds INST_VERSION as side effect
8681 $self->{INST_VERSION};
8684 #-> sub CPAN::Bundle::rematein ;
8686 my($self,$meth) = @_;
8687 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
8688 my($id) = $self->id;
8689 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
8690 unless $self->inst_file || $self->cpan_file;
8692 for $s ($self->contains) {
8693 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
8694 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
8695 if ($type eq 'CPAN::Distribution') {
8696 $CPAN::Frontend->mywarn(qq{
8697 The Bundle }.$self->id.qq{ contains
8698 explicitly a file '$s'.
8699 Going to $meth that.
8701 $CPAN::Frontend->mysleep(5);
8703 # possibly noisy action:
8704 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
8705 my $obj = $CPAN::META->instance($type,$s);
8706 $obj->{reqtype} = $self->{reqtype};
8711 # If a bundle contains another that contains an xs_file we have here,
8712 # we just don't bother I suppose
8713 #-> sub CPAN::Bundle::xs_file
8718 #-> sub CPAN::Bundle::force ;
8719 sub fforce { shift->rematein('fforce',@_); }
8720 #-> sub CPAN::Bundle::force ;
8721 sub force { shift->rematein('force',@_); }
8722 #-> sub CPAN::Bundle::notest ;
8723 sub notest { shift->rematein('notest',@_); }
8724 #-> sub CPAN::Bundle::get ;
8725 sub get { shift->rematein('get',@_); }
8726 #-> sub CPAN::Bundle::make ;
8727 sub make { shift->rematein('make',@_); }
8728 #-> sub CPAN::Bundle::test ;
8731 # $self->{badtestcnt} ||= 0;
8732 $self->rematein('test',@_);
8734 #-> sub CPAN::Bundle::install ;
8737 $self->rematein('install',@_);
8739 #-> sub CPAN::Bundle::clean ;
8740 sub clean { shift->rematein('clean',@_); }
8742 #-> sub CPAN::Bundle::uptodate ;
8745 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
8747 foreach $c ($self->contains) {
8748 my $obj = CPAN::Shell->expandany($c);
8749 return 0 unless $obj->uptodate;
8754 #-> sub CPAN::Bundle::readme ;
8757 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
8758 No File found for bundle } . $self->id . qq{\n}), return;
8759 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
8760 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
8763 package CPAN::Module;
8767 # sub CPAN::Module::userid
8772 return $ro->{userid} || $ro->{CPAN_USERID};
8774 # sub CPAN::Module::description
8777 my $ro = $self->ro or return "";
8783 CPAN::Shell->expand("Distribution",$self->cpan_file);
8786 # sub CPAN::Module::undelay
8789 delete $self->{later};
8790 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
8795 # mark as dirty/clean
8796 #-> sub CPAN::Module::color_cmd_tmps ;
8797 sub color_cmd_tmps {
8799 my($depth) = shift || 0;
8800 my($color) = shift || 0;
8801 my($ancestors) = shift || [];
8802 # a module needs to recurse to its cpan_file
8804 return if exists $self->{incommandcolor}
8806 && $self->{incommandcolor}==$color;
8807 return if $color==0 && !$self->{incommandcolor};
8809 if ( $self->uptodate ) {
8810 $self->{incommandcolor} = $color;
8812 } elsif (my $have_version = $self->available_version) {
8813 # maybe what we have is good enough
8815 my $who_asked_for_me = $ancestors->[-1];
8816 my $obj = CPAN::Shell->expandany($who_asked_for_me);
8818 } elsif ($obj->isa("CPAN::Bundle")) {
8819 # bundles cannot specify a minimum version
8821 } elsif ($obj->isa("CPAN::Distribution")) {
8822 if (my $prereq_pm = $obj->prereq_pm) {
8823 for my $k (keys %$prereq_pm) {
8824 if (my $want_version = $prereq_pm->{$k}{$self->id}) {
8825 if (CPAN::Version->vcmp($have_version,$want_version) >= 0) {
8826 $self->{incommandcolor} = $color;
8836 $self->{incommandcolor} = $color; # set me before recursion,
8837 # so we can break it
8839 if ($depth>=$CPAN::MAX_RECURSION){
8840 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
8842 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
8844 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
8845 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
8849 # delete $self->{badtestcnt};
8851 $self->{incommandcolor} = $color;
8854 #-> sub CPAN::Module::as_glimpse ;
8858 my $class = ref($self);
8859 $class =~ s/^CPAN:://;
8863 $CPAN::Shell::COLOR_REGISTERED
8865 $CPAN::META->has_inst("Term::ANSIColor")
8869 $color_on = Term::ANSIColor::color("green");
8870 $color_off = Term::ANSIColor::color("reset");
8872 my $uptodateness = " ";
8873 if ($class eq "Bundle") {
8874 } elsif ($self->uptodate) {
8875 $uptodateness = "=";
8876 } elsif ($self->inst_version) {
8877 $uptodateness = "<";
8879 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
8885 ($self->distribution ?
8886 $self->distribution->pretty_id :
8893 #-> sub CPAN::Module::dslip_status
8897 # development status
8898 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
8899 pre-alpha alpha beta released
8902 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
8903 developer comp.lang.perl.*
8906 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
8908 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
8910 object-oriented pragma
8913 @{$stat->{P}}{qw,p g l b a o d r n,} = qw,Standard-Perl
8917 distribution_allowed
8918 restricted_distribution
8920 for my $x (qw(d s l i p)) {
8921 $stat->{$x}{' '} = 'unknown';
8922 $stat->{$x}{'?'} = 'unknown';
8925 return +{} unless $ro && $ro->{statd};
8932 DV => $stat->{D}{$ro->{statd}},
8933 SV => $stat->{S}{$ro->{stats}},
8934 LV => $stat->{L}{$ro->{statl}},
8935 IV => $stat->{I}{$ro->{stati}},
8936 PV => $stat->{P}{$ro->{statp}},
8940 #-> sub CPAN::Module::as_string ;
8944 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
8945 my $class = ref($self);
8946 $class =~ s/^CPAN:://;
8948 push @m, $class, " id = $self->{ID}\n";
8949 my $sprintf = " %-12s %s\n";
8950 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
8951 if $self->description;
8952 my $sprintf2 = " %-12s %s (%s)\n";
8954 $userid = $self->userid;
8957 if ($author = CPAN::Shell->expand('Author',$userid)) {
8960 if ($m = $author->email) {
8967 $author->fullname . $email
8971 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
8972 if $self->cpan_version;
8973 if (my $cpan_file = $self->cpan_file){
8974 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
8975 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
8976 my $upload_date = $dist->upload_date;
8978 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
8982 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
8983 my $dslip = $self->dslip_status;
8987 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
8989 my $local_file = $self->inst_file;
8990 unless ($self->{MANPAGE}) {
8993 $manpage = $self->manpage_headline($local_file);
8995 # If we have already untarred it, we should look there
8996 my $dist = $CPAN::META->instance('CPAN::Distribution',
8998 # warn "dist[$dist]";
8999 # mff=manifest file; mfh=manifest handle
9004 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
9006 $mfh = FileHandle->new($mff)
9008 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
9009 my $lfre = $self->id; # local file RE
9012 my($lfl); # local file file
9014 my(@mflines) = <$mfh>;
9019 while (length($lfre)>5 and !$lfl) {
9020 ($lfl) = grep /$lfre/, @mflines;
9021 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
9024 $lfl =~ s/\s.*//; # remove comments
9025 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
9026 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
9027 # warn "lfl_abs[$lfl_abs]";
9029 $manpage = $self->manpage_headline($lfl_abs);
9033 $self->{MANPAGE} = $manpage if $manpage;
9036 for $item (qw/MANPAGE/) {
9037 push @m, sprintf($sprintf, $item, $self->{$item})
9038 if exists $self->{$item};
9040 for $item (qw/CONTAINS/) {
9041 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
9042 if exists $self->{$item} && @{$self->{$item}};
9044 push @m, sprintf($sprintf, 'INST_FILE',
9045 $local_file || "(not installed)");
9046 push @m, sprintf($sprintf, 'INST_VERSION',
9047 $self->inst_version) if $local_file;
9051 sub manpage_headline {
9052 my($self,$local_file) = @_;
9053 my(@local_file) = $local_file;
9054 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
9055 push @local_file, $local_file;
9057 for $locf (@local_file) {
9058 next unless -f $locf;
9059 my $fh = FileHandle->new($locf)
9060 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
9064 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
9065 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
9082 #-> sub CPAN::Module::cpan_file ;
9083 # Note: also inherited by CPAN::Bundle
9086 # CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
9087 unless ($self->ro) {
9088 CPAN::Index->reload;
9091 if ($ro && defined $ro->{CPAN_FILE}){
9092 return $ro->{CPAN_FILE};
9094 my $userid = $self->userid;
9096 if ($CPAN::META->exists("CPAN::Author",$userid)) {
9097 my $author = $CPAN::META->instance("CPAN::Author",
9099 my $fullname = $author->fullname;
9100 my $email = $author->email;
9101 unless (defined $fullname && defined $email) {
9102 return sprintf("Contact Author %s",
9106 return "Contact Author $fullname <$email>";
9108 return "Contact Author $userid (Email address not available)";
9116 #-> sub CPAN::Module::cpan_version ;
9122 # Can happen with modules that are not on CPAN
9125 $ro->{CPAN_VERSION} = 'undef'
9126 unless defined $ro->{CPAN_VERSION};
9127 $ro->{CPAN_VERSION};
9130 #-> sub CPAN::Module::force ;
9133 $self->{force_update} = 1;
9136 #-> sub CPAN::Module::fforce ;
9139 $self->{force_update} = 2;
9144 # warn "XDEBUG: set notest for Module";
9145 $self->{'notest'}++;
9148 #-> sub CPAN::Module::rematein ;
9150 my($self,$meth) = @_;
9151 $CPAN::Frontend->myprint(sprintf("Running %s for module '%s'\n",
9154 my $cpan_file = $self->cpan_file;
9155 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
9156 $CPAN::Frontend->mywarn(sprintf qq{
9157 The module %s isn\'t available on CPAN.
9159 Either the module has not yet been uploaded to CPAN, or it is
9160 temporary unavailable. Please contact the author to find out
9161 more about the status. Try 'i %s'.
9168 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
9169 $pack->called_for($self->id);
9170 if (exists $self->{force_update}){
9171 if ($self->{force_update} == 2) {
9172 $pack->fforce($meth);
9174 $pack->force($meth);
9177 $pack->notest($meth) if exists $self->{'notest'};
9179 $pack->{reqtype} ||= "";
9180 CPAN->debug("dist-reqtype[$pack->{reqtype}]".
9181 "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG;
9182 if ($pack->{reqtype}) {
9183 if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) {
9184 $pack->{reqtype} = $self->{reqtype};
9186 exists $pack->{install}
9189 UNIVERSAL::can($pack->{install},"failed") ?
9190 $pack->{install}->failed :
9191 $pack->{install} =~ /^NO/
9194 delete $pack->{install};
9195 $CPAN::Frontend->mywarn
9196 ("Promoting $pack->{ID} from 'build_requires' to 'requires'");
9200 $pack->{reqtype} = $self->{reqtype};
9207 $pack->unforce if $pack->can("unforce") && exists $self->{force_update};
9208 $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
9209 delete $self->{force_update};
9210 delete $self->{'notest'};
9216 #-> sub CPAN::Module::perldoc ;
9217 sub perldoc { shift->rematein('perldoc') }
9218 #-> sub CPAN::Module::readme ;
9219 sub readme { shift->rematein('readme') }
9220 #-> sub CPAN::Module::look ;
9221 sub look { shift->rematein('look') }
9222 #-> sub CPAN::Module::cvs_import ;
9223 sub cvs_import { shift->rematein('cvs_import') }
9224 #-> sub CPAN::Module::get ;
9225 sub get { shift->rematein('get',@_) }
9226 #-> sub CPAN::Module::make ;
9227 sub make { shift->rematein('make') }
9228 #-> sub CPAN::Module::test ;
9231 # $self->{badtestcnt} ||= 0;
9232 $self->rematein('test',@_);
9234 #-> sub CPAN::Module::uptodate ;
9237 local($_); # protect against a bug in MakeMaker 6.17
9238 my($latest) = $self->cpan_version;
9240 my($inst_file) = $self->inst_file;
9242 if (defined $inst_file) {
9243 $have = $self->inst_version;
9248 ! CPAN::Version->vgt($latest, $have)
9250 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
9251 "latest[$latest] have[$have]") if $CPAN::DEBUG;
9256 #-> sub CPAN::Module::install ;
9262 not exists $self->{force_update}
9264 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
9266 $self->inst_version,
9272 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
9273 $CPAN::Frontend->mywarn(qq{
9274 \n\n\n ***WARNING***
9275 The module $self->{ID} has no active maintainer.\n\n\n
9277 $CPAN::Frontend->mysleep(5);
9279 $self->rematein('install') if $doit;
9281 #-> sub CPAN::Module::clean ;
9282 sub clean { shift->rematein('clean') }
9284 #-> sub CPAN::Module::inst_file ;
9287 $self->_file_in_path([@INC]);
9290 #-> sub CPAN::Module::available_file ;
9291 sub available_file {
9293 my $sep = $Config::Config{path_sep};
9294 my $perllib = $ENV{PERL5LIB};
9295 $perllib = $ENV{PERLLIB} unless defined $perllib;
9296 my @perllib = split(/$sep/,$perllib) if defined $perllib;
9297 $self->_file_in_path([@perllib,@INC]);
9300 #-> sub CPAN::Module::file_in_path ;
9302 my($self,$path) = @_;
9304 @packpath = split /::/, $self->{ID};
9305 $packpath[-1] .= ".pm";
9306 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
9307 unshift @packpath, "Term", "ReadLine"; # historical reasons
9309 foreach $dir (@$path) {
9310 my $pmfile = File::Spec->catfile($dir,@packpath);
9318 #-> sub CPAN::Module::xs_file ;
9322 @packpath = split /::/, $self->{ID};
9323 push @packpath, $packpath[-1];
9324 $packpath[-1] .= "." . $Config::Config{'dlext'};
9325 foreach $dir (@INC) {
9326 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
9334 #-> sub CPAN::Module::inst_version ;
9337 my $parsefile = $self->inst_file or return;
9338 my $have = $self->parse_version($parsefile);
9342 #-> sub CPAN::Module::inst_version ;
9343 sub available_version {
9345 my $parsefile = $self->available_file or return;
9346 my $have = $self->parse_version($parsefile);
9350 #-> sub CPAN::Module::parse_version ;
9352 my($self,$parsefile) = @_;
9353 my $have = MM->parse_version($parsefile);
9354 $have = "undef" unless defined $have && length $have;
9355 $have =~ s/^ //; # since the %vd hack these two lines here are needed
9356 $have =~ s/ $//; # trailing whitespace happens all the time
9358 $have = CPAN::Version->readable($have);
9360 $have =~ s/\s*//g; # stringify to float around floating point issues
9361 $have; # no stringify needed, \s* above matches always
9374 CPAN - query, download and build perl modules from CPAN sites
9380 perl -MCPAN -e shell
9390 cpan> install Acme::Meta # in the shell
9392 CPAN::Shell->install("Acme::Meta"); # in perl
9396 cpan> install NWCLARK/Acme-Meta-0.02.tar.gz # in the shell
9399 install("NWCLARK/Acme-Meta-0.02.tar.gz"); # in perl
9403 $mo = CPAN::Shell->expandany($mod);
9404 $mo = CPAN::Shell->expand("Module",$mod); # same thing
9406 # distribution objects:
9408 $do = CPAN::Shell->expand("Module",$mod)->distribution;
9409 $do = CPAN::Shell->expandany($distro); # same thing
9410 $do = CPAN::Shell->expand("Distribution",
9411 $distro); # same thing
9415 The CPAN module automates or at least simplifies the make and install
9416 of perl modules and extensions. It includes some primitive searching
9417 capabilities and knows how to use Net::FTP or LWP or some external
9418 download clients to fetch the distributions from the net.
9420 These are fetched from one or more of the mirrored CPAN (Comprehensive
9421 Perl Archive Network) sites and unpacked in a dedicated directory.
9423 The CPAN module also supports the concept of named and versioned
9424 I<bundles> of modules. Bundles simplify the handling of sets of
9425 related modules. See Bundles below.
9427 The package contains a session manager and a cache manager. The
9428 session manager keeps track of what has been fetched, built and
9429 installed in the current session. The cache manager keeps track of the
9430 disk space occupied by the make processes and deletes excess space
9431 according to a simple FIFO mechanism.
9433 All methods provided are accessible in a programmer style and in an
9434 interactive shell style.
9436 =head2 CPAN::shell([$prompt, $command]) Starting Interactive Mode
9438 The interactive mode is entered by running
9440 perl -MCPAN -e shell
9446 which puts you into a readline interface. If C<Term::ReadKey> and
9447 either C<Term::ReadLine::Perl> or C<Term::ReadLine::Gnu> are installed
9448 it supports both history and command completion.
9450 Once you are on the command line, type C<h> to get a one page help
9451 screen and the rest should be self-explanatory.
9453 The function call C<shell> takes two optional arguments, one is the
9454 prompt, the second is the default initial command line (the latter
9455 only works if a real ReadLine interface module is installed).
9457 The most common uses of the interactive modes are
9461 =item Searching for authors, bundles, distribution files and modules
9463 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
9464 for each of the four categories and another, C<i> for any of the
9465 mentioned four. Each of the four entities is implemented as a class
9466 with slightly differing methods for displaying an object.
9468 Arguments you pass to these commands are either strings exactly matching
9469 the identification string of an object or regular expressions that are
9470 then matched case-insensitively against various attributes of the
9471 objects. The parser recognizes a regular expression only if you
9472 enclose it between two slashes.
9474 The principle is that the number of found objects influences how an
9475 item is displayed. If the search finds one item, the result is
9476 displayed with the rather verbose method C<as_string>, but if we find
9477 more than one, we display each object with the terse method
9480 =item C<get>, C<make>, C<test>, C<install>, C<clean> modules or distributions
9482 These commands take any number of arguments and investigate what is
9483 necessary to perform the action. If the argument is a distribution
9484 file name (recognized by embedded slashes), it is processed. If it is
9485 a module, CPAN determines the distribution file in which this module
9486 is included and processes that, following any dependencies named in
9487 the module's META.yml or Makefile.PL (this behavior is controlled by
9488 the configuration parameter C<prerequisites_policy>.)
9490 C<get> downloads a distribution file and untars or unzips it, C<make>
9491 builds it, C<test> runs the test suite, and C<install> installs it.
9493 Any C<make> or C<test> are run unconditionally. An
9495 install <distribution_file>
9497 also is run unconditionally. But for
9501 CPAN checks if an install is actually needed for it and prints
9502 I<module up to date> in the case that the distribution file containing
9503 the module doesn't need to be updated.
9505 CPAN also keeps track of what it has done within the current session
9506 and doesn't try to build a package a second time regardless if it
9507 succeeded or not. It does not repeat a test run if the test
9508 has been run successfully before. Same for install runs.
9510 The C<force> pragma may precede another command (currently: C<get>,
9511 C<make>, C<test>, or C<install>) and executes the command from scratch
9512 and tries to continue in case of some errors. See the section below on
9513 the C<force> and the C<fforce> pragma.
9515 The C<notest> pragma may be used to skip the test part in the build
9520 cpan> notest install Tk
9522 A C<clean> command results in a
9526 being executed within the distribution file's working directory.
9528 =item C<readme>, C<perldoc>, C<look> module or distribution
9530 C<readme> displays the README file of the associated distribution.
9531 C<Look> gets and untars (if not yet done) the distribution file,
9532 changes to the appropriate directory and opens a subshell process in
9533 that directory. C<perldoc> displays the pod documentation of the
9534 module in html or plain text format.
9538 =item C<ls> globbing_expression
9540 The first form lists all distribution files in and below an author's
9541 CPAN directory as they are stored in the CHECKUMS files distributed on
9542 CPAN. The listing goes recursive into all subdirectories.
9544 The second form allows to limit or expand the output with shell
9545 globbing as in the following examples:
9551 The last example is very slow and outputs extra progress indicators
9552 that break the alignment of the result.
9554 Note that globbing only lists directories explicitly asked for, for
9555 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
9556 regarded as a bug and may be changed in future versions.
9560 The C<failed> command reports all distributions that failed on one of
9561 C<make>, C<test> or C<install> for some reason in the currently
9562 running shell session.
9564 =item Persistence between sessions
9566 If the C<YAML> or the c<YAML::Syck> module is installed a record of
9567 the internal state of all modules is written to disk after each step.
9568 The files contain a signature of the currently running perl version
9571 If the configurations variable C<build_dir_reuse> is set to a true
9572 value, then CPAN.pm reads the collected YAML files. If the stored
9573 signature matches the currently running perl the stored state is
9574 loaded into memory such that effectively persistence between sessions
9577 =item The C<force> and the C<fforce> pragma
9579 To speed things up in complex installation scenarios, CPAN.pm keeps
9580 track of what it has already done and refuses to do some things a
9581 second time. A C<get>, a C<make>, and an C<install> are not repeated.
9582 A C<test> is only repeated if the previous test was unsuccessful. The
9583 diagnostic message when CPAN.pm refuses to do something a second time
9584 is one of I<Has already been >C<unwrapped|made|tested successfully> or
9585 something similar. Another situation where CPAN refuses to act is an
9586 C<install> if the according C<test> was not successful.
9588 In all these cases, the user can override the goatish behaviour by
9589 prepending the command with the word force, for example:
9592 cpan> force make AUTHOR/Bar-3.14.tar.gz
9593 cpan> force test Baz
9594 cpan> force install Acme::Meta
9596 Each I<forced> command is executed with the according part of its
9599 The C<fforce> pragma is a variant that emulates a C<force get> which
9600 erases the entire memory followed by the action specified, effectively
9601 restarting the whole get/make/test/install procedure from scratch.
9605 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>.
9606 Batch jobs can run without a lockfile and do not disturb each other.
9608 The shell offers to run in I<degraded mode> when another process is
9609 holding the lockfile. This is an experimental feature that is not yet
9610 tested very well. This second shell then does not write the history
9611 file, does not use the metadata file and has a different prompt.
9615 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
9616 in the cpan-shell it is intended that you can press C<^C> anytime and
9617 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
9618 to clean up and leave the shell loop. You can emulate the effect of a
9619 SIGTERM by sending two consecutive SIGINTs, which usually means by
9620 pressing C<^C> twice.
9622 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
9623 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
9624 Build.PL> subprocess.
9630 The commands that are available in the shell interface are methods in
9631 the package CPAN::Shell. If you enter the shell command, all your
9632 input is split by the Text::ParseWords::shellwords() routine which
9633 acts like most shells do. The first word is being interpreted as the
9634 method to be called and the rest of the words are treated as arguments
9635 to this method. Continuation lines are supported if a line ends with a
9640 C<autobundle> writes a bundle file into the
9641 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
9642 a list of all modules that are both available from CPAN and currently
9643 installed within @INC. The name of the bundle file is based on the
9644 current date and a counter.
9648 This commands provides a statistical overview over recent download
9649 activities. The data for this is collected in the YAML file
9650 C<FTPstats.yml> in your C<cpan_home> directory. If no YAML module is
9651 configured or YAML not installed, then no stats are provided.
9655 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
9656 directory so that you can save your own preferences instead of the
9661 recompile() is a very special command in that it takes no argument and
9662 runs the make/test/install cycle with brute force over all installed
9663 dynamically loadable extensions (aka XS modules) with 'force' in
9664 effect. The primary purpose of this command is to finish a network
9665 installation. Imagine, you have a common source tree for two different
9666 architectures. You decide to do a completely independent fresh
9667 installation. You start on one architecture with the help of a Bundle
9668 file produced earlier. CPAN installs the whole Bundle for you, but
9669 when you try to repeat the job on the second architecture, CPAN
9670 responds with a C<"Foo up to date"> message for all modules. So you
9671 invoke CPAN's recompile on the second architecture and you're done.
9673 Another popular use for C<recompile> is to act as a rescue in case your
9674 perl breaks binary compatibility. If one of the modules that CPAN uses
9675 is in turn depending on binary compatibility (so you cannot run CPAN
9676 commands), then you should try the CPAN::Nox module for recovery.
9678 =head2 report Bundle|Distribution|Module
9680 The C<report> command temporarily turns on the C<test_report> config
9681 variable, then runs the C<force test> command with the given
9682 arguments. The C<force> pragma is used to re-run the tests and repeat
9683 every step that might have failed before.
9685 =head2 upgrade [Module|/Regex/]...
9687 The C<upgrade> command first runs an C<r> command with the given
9688 arguments and then installs the newest versions of all modules that
9689 were listed by that.
9691 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
9693 Although it may be considered internal, the class hierarchy does matter
9694 for both users and programmer. CPAN.pm deals with above mentioned four
9695 classes, and all those classes share a set of methods. A classical
9696 single polymorphism is in effect. A metaclass object registers all
9697 objects of all kinds and indexes them with a string. The strings
9698 referencing objects have a separated namespace (well, not completely
9703 words containing a "/" (slash) Distribution
9704 words starting with Bundle:: Bundle
9705 everything else Module or Author
9707 Modules know their associated Distribution objects. They always refer
9708 to the most recent official release. Developers may mark their releases
9709 as unstable development versions (by inserting an underbar into the
9710 module version number which will also be reflected in the distribution
9711 name when you run 'make dist'), so the really hottest and newest
9712 distribution is not always the default. If a module Foo circulates
9713 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
9714 way to install version 1.23 by saying
9718 This would install the complete distribution file (say
9719 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
9720 like to install version 1.23_90, you need to know where the
9721 distribution file resides on CPAN relative to the authors/id/
9722 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
9723 so you would have to say
9725 install BAR/Foo-1.23_90.tar.gz
9727 The first example will be driven by an object of the class
9728 CPAN::Module, the second by an object of class CPAN::Distribution.
9730 =head2 Integrating local directories
9732 Distribution objects are normally distributions from the CPAN, but
9733 there is a slightly degenerate case for Distribution objects, too, of
9734 projects held on the local disk. These distribution objects have the
9735 same name as the local directory and end with a dot. A dot by itself
9736 is also allowed for the current directory at the time CPAN.pm was
9737 used. All actions such as C<make>, C<test>, and C<install> are applied
9738 directly to that directory. This gives the command C<cpan .> an
9739 interesting touch: while the normal mantra of installing a CPAN module
9740 without CPAN.pm is one of
9742 perl Makefile.PL perl Build.PL
9743 ( go and get prerequisites )
9745 make test ./Build test
9746 make install ./Build install
9748 the command C<cpan .> does all of this at once. It figures out which
9749 of the two mantras is appropriate, fetches and installs all
9750 prerequisites, cares for them recursively and finally finishes the
9751 installation of the module in the current directory, be it a CPAN
9754 The typical usage case is for private modules or working copies of
9755 projects from remote repositories on the local disk.
9757 =head1 CONFIGURATION
9759 When the CPAN module is used for the first time, a configuration
9760 dialog tries to determine a couple of site specific options. The
9761 result of the dialog is stored in a hash reference C< $CPAN::Config >
9762 in a file CPAN/Config.pm.
9764 The default values defined in the CPAN/Config.pm file can be
9765 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
9766 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
9767 added to the search path of the CPAN module before the use() or
9768 require() statements. The mkmyconfig command writes this file for you.
9770 The C<o conf> command has various bells and whistles:
9774 =item completion support
9776 If you have a ReadLine module installed, you can hit TAB at any point
9777 of the commandline and C<o conf> will offer you completion for the
9778 built-in subcommands and/or config variable names.
9780 =item displaying some help: o conf help
9782 Displays a short help
9784 =item displaying current values: o conf [KEY]
9786 Displays the current value(s) for this config variable. Without KEY
9787 displays all subcommands and config variables.
9793 =item changing of scalar values: o conf KEY VALUE
9795 Sets the config variable KEY to VALUE. The empty string can be
9796 specified as usual in shells, with C<''> or C<"">
9800 o conf wget /usr/bin/wget
9802 =item changing of list values: o conf KEY SHIFT|UNSHIFT|PUSH|POP|SPLICE|LIST
9804 If a config variable name ends with C<list>, it is a list. C<o conf
9805 KEY shift> removes the first element of the list, C<o conf KEY pop>
9806 removes the last element of the list. C<o conf KEYS unshift LIST>
9807 prepends a list of values to the list, C<o conf KEYS push LIST>
9808 appends a list of valued to the list.
9810 Likewise, C<o conf KEY splice LIST> passes the LIST to the according
9813 Finally, any other list of arguments is taken as a new list value for
9814 the KEY variable discarding the previous value.
9818 o conf urllist unshift http://cpan.dev.local/CPAN
9819 o conf urllist splice 3 1
9820 o conf urllist http://cpan1.local http://cpan2.local ftp://ftp.perl.org
9822 =item reverting to saved: o conf defaults
9824 Reverts all config variables to the state in the saved config file.
9826 =item saving the config: o conf commit
9828 Saves all config variables to the current config file (CPAN/Config.pm
9829 or CPAN/MyConfig.pm that was loaded at start).
9833 The configuration dialog can be started any time later again by
9834 issuing the command C< o conf init > in the CPAN shell. A subset of
9835 the configuration dialog can be run by issuing C<o conf init WORD>
9836 where WORD is any valid config variable or a regular expression.
9838 =head2 Config Variables
9840 Currently the following keys in the hash reference $CPAN::Config are
9843 applypatch path to external prg
9844 auto_commit commit all changes to config variables to disk
9845 build_cache size of cache for directories to build modules
9846 build_dir locally accessible directory to build modules
9847 build_dir_reuse boolean if distros in build_dir are persistent
9848 build_requires_install_policy
9849 to install or not to install when a module is
9850 only needed for building. yes|no|ask/yes|ask/no
9851 bzip2 path to external prg
9852 cache_metadata use serializer to cache metadata
9853 commands_quote prefered character to use for quoting external
9854 commands when running them. Defaults to double
9855 quote on Windows, single tick everywhere else;
9856 can be set to space to disable quoting
9857 check_sigs if signatures should be verified
9858 colorize_debug Term::ANSIColor attributes for debugging output
9859 colorize_output boolean if Term::ANSIColor should colorize output
9860 colorize_print Term::ANSIColor attributes for normal output
9861 colorize_warn Term::ANSIColor attributes for warnings
9862 commandnumber_in_prompt
9863 boolean if you want to see current command number
9864 cpan_home local directory reserved for this package
9865 curl path to external prg
9866 dontload_hash DEPRECATED
9867 dontload_list arrayref: modules in the list will not be
9868 loaded by the CPAN::has_inst() routine
9869 ftp path to external prg
9870 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
9871 ftp_proxy proxy host for ftp requests
9873 gpg path to external prg
9874 gzip location of external program gzip
9875 histfile file to maintain history between sessions
9876 histsize maximum number of lines to keep in histfile
9877 http_proxy proxy host for http requests
9878 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
9879 after this many seconds inactivity. Set to 0 to
9881 index_expire after this many days refetch index files
9882 inhibit_startup_message
9883 if true, does not print the startup message
9884 keep_source_where directory in which to keep the source (if we do)
9885 lynx path to external prg
9886 make location of external make program
9887 make_arg arguments that should always be passed to 'make'
9888 make_install_make_command
9889 the make command for running 'make install', for
9891 make_install_arg same as make_arg for 'make install'
9892 makepl_arg arguments passed to 'perl Makefile.PL'
9893 mbuild_arg arguments passed to './Build'
9894 mbuild_install_arg arguments passed to './Build install'
9895 mbuild_install_build_command
9896 command to use instead of './Build' when we are
9897 in the install stage, for example 'sudo ./Build'
9898 mbuildpl_arg arguments passed to 'perl Build.PL'
9899 ncftp path to external prg
9900 ncftpget path to external prg
9901 no_proxy don't proxy to these hosts/domains (comma separated list)
9902 pager location of external program more (or any pager)
9903 password your password if you CPAN server wants one
9904 patch path to external prg
9905 prefer_installer legal values are MB and EUMM: if a module comes
9906 with both a Makefile.PL and a Build.PL, use the
9907 former (EUMM) or the latter (MB); if the module
9908 comes with only one of the two, that one will be
9910 prerequisites_policy
9911 what to do if you are missing module prerequisites
9912 ('follow' automatically, 'ask' me, or 'ignore')
9913 prefs_dir local directory to store per-distro build options
9914 proxy_user username for accessing an authenticating proxy
9915 proxy_pass password for accessing an authenticating proxy
9916 randomize_urllist add some randomness to the sequence of the urllist
9917 scan_cache controls scanning of cache ('atstart' or 'never')
9918 shell your favorite shell
9919 show_upload_date boolean if commands should try to determine upload date
9920 tar location of external program tar
9921 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
9922 (and nonsense for characters outside latin range)
9923 term_ornaments boolean to turn ReadLine ornamenting on/off
9924 test_report email test reports (if CPAN::Reporter is installed)
9925 unzip location of external program unzip
9926 urllist arrayref to nearby CPAN sites (or equivalent locations)
9927 use_sqlite use CPAN::SQLite for metadata storage (fast and lean)
9928 username your username if you CPAN server wants one
9929 wait_list arrayref to a wait server to try (See CPAN::WAIT)
9930 wget path to external prg
9931 yaml_module which module to use to read/write YAML files
9933 You can set and query each of these options interactively in the cpan
9934 shell with the C<o conf> or the C<o conf init> command as specified below.
9938 =item C<o conf E<lt>scalar optionE<gt>>
9940 prints the current value of the I<scalar option>
9942 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
9944 Sets the value of the I<scalar option> to I<value>
9946 =item C<o conf E<lt>list optionE<gt>>
9948 prints the current value of the I<list option> in MakeMaker's
9951 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
9953 shifts or pops the array in the I<list option> variable
9955 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
9957 works like the corresponding perl commands.
9959 =item interactive editing: o conf init [MATCH|LIST]
9961 Runs an interactive configuration dialog for matching variables.
9962 Without argument runs the dialog over all supported config variables.
9963 To specify a MATCH the argument must be enclosed by slashes.
9967 o conf init ftp_passive ftp_proxy
9970 Note: this method of setting config variables often provides more
9971 explanation about the functioning of a variable than the manpage.
9975 =head2 CPAN::anycwd($path): Note on config variable getcwd
9977 CPAN.pm changes the current working directory often and needs to
9978 determine its own current working directory. Per default it uses
9979 Cwd::cwd but if this doesn't work on your system for some reason,
9980 alternatives can be configured according to the following table:
9998 Calls the external command cwd.
10002 =head2 Note on the format of the urllist parameter
10004 urllist parameters are URLs according to RFC 1738. We do a little
10005 guessing if your URL is not compliant, but if you have problems with
10006 C<file> URLs, please try the correct format. Either:
10008 file://localhost/whatever/ftp/pub/CPAN/
10012 file:///home/ftp/pub/CPAN/
10014 =head2 The urllist parameter has CD-ROM support
10016 The C<urllist> parameter of the configuration table contains a list of
10017 URLs that are to be used for downloading. If the list contains any
10018 C<file> URLs, CPAN always tries to get files from there first. This
10019 feature is disabled for index files. So the recommendation for the
10020 owner of a CD-ROM with CPAN contents is: include your local, possibly
10021 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
10023 o conf urllist push file://localhost/CDROM/CPAN
10025 CPAN.pm will then fetch the index files from one of the CPAN sites
10026 that come at the beginning of urllist. It will later check for each
10027 module if there is a local copy of the most recent version.
10029 Another peculiarity of urllist is that the site that we could
10030 successfully fetch the last file from automatically gets a preference
10031 token and is tried as the first site for the next request. So if you
10032 add a new site at runtime it may happen that the previously preferred
10033 site will be tried another time. This means that if you want to disallow
10034 a site for the next transfer, it must be explicitly removed from
10037 =head2 Maintaining the urllist parameter
10039 If you have YAML.pm (or some other YAML module configured in
10040 C<yaml_module>) installed, CPAN.pm collects a few statistical data
10041 about recent downloads. You can view the statistics with the C<hosts>
10042 command or inspect them directly by looking into the C<FTPstats.yml>
10043 file in your C<cpan_home> directory.
10045 To get some interesting statistics it is recommended to set the
10046 C<randomize_urllist> parameter that introduces some amount of
10047 randomness into the URL selection.
10049 =head2 The C<requires> and C<build_requires> dependency declarations
10051 Since CPAN.pm version 1.88_51 modules declared as C<build_requires> by
10052 a distribution are treated differently depending on the config
10053 variable C<build_requires_install_policy>. By setting
10054 C<build_requires_install_policy> to C<no> such a module is not being
10055 installed. It is only built and tested and then kept in the list of
10056 tested but uninstalled modules. As such it is available during the
10057 build of the dependent module by integrating the path to the
10058 C<blib/arch> and C<blib/lib> directories in the environment variable
10059 PERL5LIB. If C<build_requires_install_policy> is set ti C<yes>, then
10060 both modules declared as C<requires> and those declared as
10061 C<build_requires> are treated alike. By setting to C<ask/yes> or
10062 C<ask/no>, CPAN.pm asks the user and sets the default accordingly.
10064 =head2 Configuration for individual distributions (I<Distroprefs>)
10066 (B<Note:> This feature has been introduced in CPAN.pm 1.8854 and is
10067 still considered beta quality)
10069 Distributions on the CPAN usually behave according to what we call the
10070 CPAN mantra. Or since the event of Module::Build we should talk about
10073 perl Makefile.PL perl Build.PL
10075 make test ./Build test
10076 make install ./Build install
10078 But some modules cannot be built with this mantra. They try to get
10079 some extra data from the user via the environment, extra arguments or
10080 interactively thus disturbing the installation of large bundles like
10081 Phalanx100 or modules with many dependencies like Plagger.
10083 The distroprefs system of C<CPAN.pm> addresses this problem by
10084 allowing the user to specify extra informations and recipes in YAML
10091 pass additional arguments to one of the four commands,
10095 set environment variables
10099 instantiate an Expect object that reads from the console, waits for
10100 some regular expressions and enters some answers
10104 temporarily override assorted C<CPAN.pm> configuration variables
10108 disable the installation of an object altogether
10112 See the YAML and Data::Dumper files that come with the C<CPAN.pm>
10113 distribution in the C<distroprefs/> directory for examples.
10117 The YAML files themselves must have the C<.yml> extension, all other
10118 files are ignored (for two exceptions see I<Fallback Data::Dumper and
10119 Storable> below). The containing directory can be specified in
10120 C<CPAN.pm> in the C<prefs_dir> config variable. Try C<o conf init
10121 prefs_dir> in the CPAN shell to set and activate the distroprefs
10124 Every YAML file may contain arbitrary documents according to the YAML
10125 specification and every single document is treated as an entity that
10126 can specify the treatment of a single distribution.
10128 The names of the files can be picked freely, C<CPAN.pm> always reads
10129 all files (in alphabetical order) and takes the key C<match> (see
10130 below in I<Language Specs>) as a hashref containing match criteria
10131 that determine if the current distribution matches the YAML document
10134 =head2 Fallback Data::Dumper and Storable
10136 If neither your configured C<yaml_module> nor YAML.pm is installed
10137 CPAN.pm falls back to using Data::Dumper and Storable and looks for
10138 files with the extensions C<.dd> or C<.st> in the C<prefs_dir>
10139 directory. These files are expected to contain one or more hashrefs.
10140 For Data::Dumper generated files, this is expected to be done with by
10141 defining C<$VAR1>, C<$VAR2>, etc. The YAML shell would produce these
10144 ysh < somefile.yml > somefile.dd
10146 For Storable files the rule is that they must be constructed such that
10147 C<Storable::retrieve(file)> returns an array reference and the array
10148 elements represent one distropref object each. The conversion from
10149 YAML would look like so:
10151 perl -MYAML=LoadFile -MStorable=nstore -e '
10152 @y=LoadFile(shift);
10153 nstore(\@y, shift)' somefile.yml somefile.st
10155 In bootstrapping situations it is usually sufficient to translate only
10156 a few YAML files to Data::Dumper for the crucial modules like
10157 C<YAML::Syck>, C<YAML.pm> and C<Expect.pm>. If you prefer Storable
10158 over Data::Dumper, remember to pull out a Storable version that writes
10159 an older format than all the other Storable versions that will need to
10164 The following example contains all supported keywords and structures
10165 with the exception of C<eexpect> which can be used instead of
10171 module: "Dancing::Queen"
10172 distribution: "^CHACHACHA/Dancing-"
10173 perl: "/usr/local/cariba-perl/bin/perl"
10179 - "--somearg=specialcase"
10184 - "Which is your favorite fruit"
10196 commendline: "echo SKIPPING make"
10209 WANT_TO_INSTALL: YES
10212 - "Do you really want to install"
10216 - "ABCDE/Fedcba-3.14-ABCDE-01.patch"
10219 =head2 Language Specs
10221 Every YAML document represents a single hash reference. The valid keys
10222 in this hash are as follows:
10226 =item comment [scalar]
10230 =item cpanconfig [hash]
10232 Temporarily override assorted C<CPAN.pm> configuration variables.
10234 Supported are: C<build_requires_install_policy>, C<check_sigs>,
10235 C<make>, C<make_install_make_command>, C<prefer_installer>,
10236 C<test_report>. Please report as a bug when you need another one
10239 =item disabled [boolean]
10241 Specifies that this distribution shall not be processed at all.
10243 =item goto [string]
10245 The canonical name of a delegate distribution that shall be installed
10246 instead. Useful when a new version, although it tests OK itself,
10247 breaks something else or a developer release or a fork is already
10248 uploaded that is better than the last released version.
10250 =item install [hash]
10252 Processing instructions for the C<make install> or C<./Build install>
10253 phase of the CPAN mantra. See below under I<Processiong Instructions>.
10257 Processing instructions for the C<make> or C<./Build> phase of the
10258 CPAN mantra. See below under I<Processiong Instructions>.
10262 A hashref with one or more of the keys C<distribution>, C<modules>, or
10263 C<perl> that specify if a document is targeted at a specific CPAN
10266 The corresponding values are interpreted as regular expressions. The
10267 C<distribution> related one will be matched against the canonical
10268 distribution name, e.g. "AUTHOR/Foo-Bar-3.14.tar.gz".
10270 The C<module> related one will be matched against I<all> modules
10271 contained in the distribution until one module matches.
10273 The C<perl> related one will be matched against C<$^X>.
10275 If more than one restriction of C<module>, C<distribution>, and
10276 C<perl> is specified, the results of the separately computed match
10277 values must all match. If this is the case then the hashref
10278 represented by the YAML document is returned as the preference
10279 structure for the current distribution.
10281 =item patches [array]
10283 An array of patches on CPAN or on the local disk to be applied in
10284 order via the external patch program. If the value for the C<-p>
10285 parameter is C<0> or C<1> is determined by reading the patch
10288 Note: if the C<applypatch> program is installed and C<CPAN::Config>
10289 knows about it B<and> a patch is written by the C<makepatch> program,
10290 then C<CPAN.pm> lets C<applypatch> apply the patch. Both C<makepatch>
10291 and C<applypatch> are available from CPAN in the C<JV/makepatch-*>
10296 Processing instructions for the C<perl Makefile.PL> or C<perl
10297 Build.PL> phase of the CPAN mantra. See below under I<Processiong
10302 Processing instructions for the C<make test> or C<./Build test> phase
10303 of the CPAN mantra. See below under I<Processiong Instructions>.
10307 =head2 Processing Instructions
10313 Arguments to be added to the command line
10317 A full commandline that will be executed as it stands by a system
10318 call. During the execution the environment variable PERL will is set
10319 to $^X. If C<commandline> is specified, the content of C<args> is not
10322 =item eexpect [hash]
10324 Extended C<expect>. This is a hash reference with three allowed keys,
10325 C<mode>, C<timeout>, and C<talk>.
10327 C<mode> may have the values C<deterministic> for the case where all
10328 questions come in the order written down and C<anyorder> for the case
10329 where the questions may come in any order. The default mode is
10332 C<timeout> denotes a timeout in seconds. Floating point timeouts are
10333 OK. In the case of a C<mode=deterministic> the timeout denotes the
10334 timeout per question, in the case of C<mode=anyorder> it denotes the
10335 timeout per byte received from the stream or questions.
10337 C<talk> is a reference to an array that contains alternating questions
10338 and answers. Questions are regular expressions and answers are literal
10339 strings. The Expect module will then watch the stream coming from the
10340 execution of the external program (C<perl Makefile.PL>, C<perl
10341 Build.PL>, C<make>, etc.).
10343 In the case of C<mode=deterministic> the CPAN.pm will inject the
10344 according answer as soon as the stream matches the regular expression.
10345 In the case of C<mode=anyorder> the CPAN.pm will answer a question as
10346 soon as the timeout is reached for the next byte in the input stream.
10347 In the latter case it removes the according question/answer pair from
10348 the array, so if you want to answer the question C<Do you really want
10349 to do that> several times, then it must be included in the array at
10350 least as often as you want this answer to be given.
10354 Environment variables to be set during the command
10356 =item expect [array]
10358 C<< expect: <array> >> is a short notation for
10361 mode: deterministic
10367 =head2 Schema verification with C<Kwalify>
10369 If you have the C<Kwalify> module installed (which is part of the
10370 Bundle::CPANxxl), then all your distroprefs files are checked for
10371 syntactical correctness.
10373 =head2 Example Distroprefs Files
10375 C<CPAN.pm> comes with a collection of example YAML files. Note that these
10376 are really just examples and should not be used without care because
10377 they cannot fit everybody's purpose. After all the authors of the
10378 packages that ask questions had a need to ask, so you should watch
10379 their questions and adjust the examples to your environment and your
10380 needs. You have beend warned:-)
10382 =head1 PROGRAMMER'S INTERFACE
10384 If you do not enter the shell, the available shell commands are both
10385 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
10386 functions in the calling package (C<install(...)>). Before calling low-level
10387 commands it makes sense to initialize components of CPAN you need, e.g.:
10389 CPAN::HandleConfig->load;
10390 CPAN::Shell::setup_output;
10391 CPAN::Index->reload;
10393 High-level commands do such initializations automatically.
10395 There's currently only one class that has a stable interface -
10396 CPAN::Shell. All commands that are available in the CPAN shell are
10397 methods of the class CPAN::Shell. Each of the commands that produce
10398 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
10399 the IDs of all modules within the list.
10403 =item expand($type,@things)
10405 The IDs of all objects available within a program are strings that can
10406 be expanded to the corresponding real objects with the
10407 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
10408 list of CPAN::Module objects according to the C<@things> arguments
10409 given. In scalar context it only returns the first element of the
10412 =item expandany(@things)
10414 Like expand, but returns objects of the appropriate type, i.e.
10415 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
10416 CPAN::Distribution objects for distributions. Note: it does not expand
10417 to CPAN::Author objects.
10419 =item Programming Examples
10421 This enables the programmer to do operations that combine
10422 functionalities that are available in the shell.
10424 # install everything that is outdated on my disk:
10425 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
10427 # install my favorite programs if necessary:
10428 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
10429 CPAN::Shell->install($mod);
10432 # list all modules on my disk that have no VERSION number
10433 for $mod (CPAN::Shell->expand("Module","/./")){
10434 next unless $mod->inst_file;
10435 # MakeMaker convention for undefined $VERSION:
10436 next unless $mod->inst_version eq "undef";
10437 print "No VERSION in ", $mod->id, "\n";
10440 # find out which distribution on CPAN contains a module:
10441 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
10443 Or if you want to write a cronjob to watch The CPAN, you could list
10444 all modules that need updating. First a quick and dirty way:
10446 perl -e 'use CPAN; CPAN::Shell->r;'
10448 If you don't want to get any output in the case that all modules are
10449 up to date, you can parse the output of above command for the regular
10450 expression //modules are up to date// and decide to mail the output
10451 only if it doesn't match. Ick?
10453 If you prefer to do it more in a programmer style in one single
10454 process, maybe something like this suits you better:
10456 # list all modules on my disk that have newer versions on CPAN
10457 for $mod (CPAN::Shell->expand("Module","/./")){
10458 next unless $mod->inst_file;
10459 next if $mod->uptodate;
10460 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
10461 $mod->id, $mod->inst_version, $mod->cpan_version;
10464 If that gives you too much output every day, you maybe only want to
10465 watch for three modules. You can write
10467 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
10469 as the first line instead. Or you can combine some of the above
10472 # watch only for a new mod_perl module
10473 $mod = CPAN::Shell->expand("Module","mod_perl");
10474 exit if $mod->uptodate;
10475 # new mod_perl arrived, let me know all update recommendations
10480 =head2 Methods in the other Classes
10484 =item CPAN::Author::as_glimpse()
10486 Returns a one-line description of the author
10488 =item CPAN::Author::as_string()
10490 Returns a multi-line description of the author
10492 =item CPAN::Author::email()
10494 Returns the author's email address
10496 =item CPAN::Author::fullname()
10498 Returns the author's name
10500 =item CPAN::Author::name()
10502 An alias for fullname
10504 =item CPAN::Bundle::as_glimpse()
10506 Returns a one-line description of the bundle
10508 =item CPAN::Bundle::as_string()
10510 Returns a multi-line description of the bundle
10512 =item CPAN::Bundle::clean()
10514 Recursively runs the C<clean> method on all items contained in the bundle.
10516 =item CPAN::Bundle::contains()
10518 Returns a list of objects' IDs contained in a bundle. The associated
10519 objects may be bundles, modules or distributions.
10521 =item CPAN::Bundle::force($method,@args)
10523 Forces CPAN to perform a task that it normally would have refused to
10524 do. Force takes as arguments a method name to be called and any number
10525 of additional arguments that should be passed to the called method.
10526 The internals of the object get the needed changes so that CPAN.pm
10527 does not refuse to take the action. The C<force> is passed recursively
10528 to all contained objects. See also the section above on the C<force>
10529 and the C<fforce> pragma.
10531 =item CPAN::Bundle::get()
10533 Recursively runs the C<get> method on all items contained in the bundle
10535 =item CPAN::Bundle::inst_file()
10537 Returns the highest installed version of the bundle in either @INC or
10538 C<$CPAN::Config->{cpan_home}>. Note that this is different from
10539 CPAN::Module::inst_file.
10541 =item CPAN::Bundle::inst_version()
10543 Like CPAN::Bundle::inst_file, but returns the $VERSION
10545 =item CPAN::Bundle::uptodate()
10547 Returns 1 if the bundle itself and all its members are uptodate.
10549 =item CPAN::Bundle::install()
10551 Recursively runs the C<install> method on all items contained in the bundle
10553 =item CPAN::Bundle::make()
10555 Recursively runs the C<make> method on all items contained in the bundle
10557 =item CPAN::Bundle::readme()
10559 Recursively runs the C<readme> method on all items contained in the bundle
10561 =item CPAN::Bundle::test()
10563 Recursively runs the C<test> method on all items contained in the bundle
10565 =item CPAN::Distribution::as_glimpse()
10567 Returns a one-line description of the distribution
10569 =item CPAN::Distribution::as_string()
10571 Returns a multi-line description of the distribution
10573 =item CPAN::Distribution::author
10575 Returns the CPAN::Author object of the maintainer who uploaded this
10578 =item CPAN::Distribution::clean()
10580 Changes to the directory where the distribution has been unpacked and
10581 runs C<make clean> there.
10583 =item CPAN::Distribution::containsmods()
10585 Returns a list of IDs of modules contained in a distribution file.
10586 Only works for distributions listed in the 02packages.details.txt.gz
10587 file. This typically means that only the most recent version of a
10588 distribution is covered.
10590 =item CPAN::Distribution::cvs_import()
10592 Changes to the directory where the distribution has been unpacked and
10593 runs something like
10595 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
10599 =item CPAN::Distribution::dir()
10601 Returns the directory into which this distribution has been unpacked.
10603 =item CPAN::Distribution::force($method,@args)
10605 Forces CPAN to perform a task that it normally would have refused to
10606 do. Force takes as arguments a method name to be called and any number
10607 of additional arguments that should be passed to the called method.
10608 The internals of the object get the needed changes so that CPAN.pm
10609 does not refuse to take the action. See also the section above on the
10610 C<force> and the C<fforce> pragma.
10612 =item CPAN::Distribution::get()
10614 Downloads the distribution from CPAN and unpacks it. Does nothing if
10615 the distribution has already been downloaded and unpacked within the
10618 =item CPAN::Distribution::install()
10620 Changes to the directory where the distribution has been unpacked and
10621 runs the external command C<make install> there. If C<make> has not
10622 yet been run, it will be run first. A C<make test> will be issued in
10623 any case and if this fails, the install will be canceled. The
10624 cancellation can be avoided by letting C<force> run the C<install> for
10627 This install method has only the power to install the distribution if
10628 there are no dependencies in the way. To install an object and all of
10629 its dependencies, use CPAN::Shell->install.
10631 Note that install() gives no meaningful return value. See uptodate().
10633 =item CPAN::Distribution::install_tested()
10635 Install all the distributions that have been tested sucessfully but
10636 not yet installed. See also C<is_tested>.
10638 =item CPAN::Distribution::isa_perl()
10640 Returns 1 if this distribution file seems to be a perl distribution.
10641 Normally this is derived from the file name only, but the index from
10642 CPAN can contain a hint to achieve a return value of true for other
10645 =item CPAN::Distribution::is_tested()
10647 List all the distributions that have been tested sucessfully but not
10648 yet installed. See also C<install_tested>.
10650 =item CPAN::Distribution::look()
10652 Changes to the directory where the distribution has been unpacked and
10653 opens a subshell there. Exiting the subshell returns.
10655 =item CPAN::Distribution::make()
10657 First runs the C<get> method to make sure the distribution is
10658 downloaded and unpacked. Changes to the directory where the
10659 distribution has been unpacked and runs the external commands C<perl
10660 Makefile.PL> or C<perl Build.PL> and C<make> there.
10662 =item CPAN::Distribution::perldoc()
10664 Downloads the pod documentation of the file associated with a
10665 distribution (in html format) and runs it through the external
10666 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
10667 isn't available, it converts it to plain text with external
10668 command html2text and runs it through the pager specified
10669 in C<$CPAN::Config->{pager}>
10671 =item CPAN::Distribution::prefs()
10673 Returns the hash reference from the first matching YAML file that the
10674 user has deposited in the C<prefs_dir/> directory. The first
10675 succeeding match wins. The files in the C<prefs_dir/> are processed
10676 alphabetically and the canonical distroname (e.g.
10677 AUTHOR/Foo-Bar-3.14.tar.gz) is matched against the regular expressions
10678 stored in the $root->{match}{distribution} attribute value.
10679 Additionally all module names contained in a distribution are matched
10680 agains the regular expressions in the $root->{match}{module} attribute
10681 value. The two match values are ANDed together. Each of the two
10682 attributes are optional.
10684 =item CPAN::Distribution::prereq_pm()
10686 Returns the hash reference that has been announced by a distribution
10687 as the the C<requires> and C<build_requires> elements. These can be
10688 declared either by the C<META.yml> (if authoritative) or can be
10689 deposited after the run of C<Build.PL> in the file C<./_build/prereqs>
10690 or after the run of C<Makfile.PL> written as the C<PREREQ_PM> hash in
10691 a comment in the produced C<Makefile>. I<Note>: this method only works
10692 after an attempt has been made to C<make> the distribution. Returns
10695 =item CPAN::Distribution::readme()
10697 Downloads the README file associated with a distribution and runs it
10698 through the pager specified in C<$CPAN::Config->{pager}>.
10700 =item CPAN::Distribution::read_yaml()
10702 Returns the content of the META.yml of this distro as a hashref. Note:
10703 works only after an attempt has been made to C<make> the distribution.
10704 Returns undef otherwise. Also returns undef if the content of META.yml
10705 is not authoritative. (The rules about what exactly makes the content
10706 authoritative are still in flux.)
10708 =item CPAN::Distribution::test()
10710 Changes to the directory where the distribution has been unpacked and
10711 runs C<make test> there.
10713 =item CPAN::Distribution::uptodate()
10715 Returns 1 if all the modules contained in the distribution are
10716 uptodate. Relies on containsmods.
10718 =item CPAN::Index::force_reload()
10720 Forces a reload of all indices.
10722 =item CPAN::Index::reload()
10724 Reloads all indices if they have not been read for more than
10725 C<$CPAN::Config->{index_expire}> days.
10727 =item CPAN::InfoObj::dump()
10729 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
10730 inherit this method. It prints the data structure associated with an
10731 object. Useful for debugging. Note: the data structure is considered
10732 internal and thus subject to change without notice.
10734 =item CPAN::Module::as_glimpse()
10736 Returns a one-line description of the module in four columns: The
10737 first column contains the word C<Module>, the second column consists
10738 of one character: an equals sign if this module is already installed
10739 and uptodate, a less-than sign if this module is installed but can be
10740 upgraded, and a space if the module is not installed. The third column
10741 is the name of the module and the fourth column gives maintainer or
10742 distribution information.
10744 =item CPAN::Module::as_string()
10746 Returns a multi-line description of the module
10748 =item CPAN::Module::clean()
10750 Runs a clean on the distribution associated with this module.
10752 =item CPAN::Module::cpan_file()
10754 Returns the filename on CPAN that is associated with the module.
10756 =item CPAN::Module::cpan_version()
10758 Returns the latest version of this module available on CPAN.
10760 =item CPAN::Module::cvs_import()
10762 Runs a cvs_import on the distribution associated with this module.
10764 =item CPAN::Module::description()
10766 Returns a 44 character description of this module. Only available for
10767 modules listed in The Module List (CPAN/modules/00modlist.long.html
10768 or 00modlist.long.txt.gz)
10770 =item CPAN::Module::distribution()
10772 Returns the CPAN::Distribution object that contains the current
10773 version of this module.
10775 =item CPAN::Module::dslip_status()
10777 Returns a hash reference. The keys of the hash are the letters C<D>,
10778 C<S>, C<L>, C<I>, and <P>, for development status, support level,
10779 language, interface and public licence respectively. The data for the
10780 DSLIP status are collected by pause.perl.org when authors register
10781 their namespaces. The values of the 5 hash elements are one-character
10782 words whose meaning is described in the table below. There are also 5
10783 hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
10784 verbose value of the 5 status variables.
10786 Where the 'DSLIP' characters have the following meanings:
10788 D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
10789 i - Idea, listed to gain consensus or as a placeholder
10790 c - under construction but pre-alpha (not yet released)
10791 a/b - Alpha/Beta testing
10793 M - Mature (no rigorous definition)
10794 S - Standard, supplied with Perl 5
10799 u - Usenet newsgroup comp.lang.perl.modules
10800 n - None known, try comp.lang.perl.modules
10801 a - abandoned; volunteers welcome to take over maintainance
10804 p - Perl-only, no compiler needed, should be platform independent
10805 c - C and perl, a C compiler will be needed
10806 h - Hybrid, written in perl with optional C code, no compiler needed
10807 + - C++ and perl, a C++ compiler will be needed
10808 o - perl and another language other than C or C++
10810 I - Interface Style
10811 f - plain Functions, no references used
10812 h - hybrid, object and function interfaces available
10813 n - no interface at all (huh?)
10814 r - some use of unblessed References or ties
10815 O - Object oriented using blessed references and/or inheritance
10818 p - Standard-Perl: user may choose between GPL and Artistic
10819 g - GPL: GNU General Public License
10820 l - LGPL: "GNU Lesser General Public License" (previously known as
10821 "GNU Library General Public License")
10822 b - BSD: The BSD License
10823 a - Artistic license alone
10824 o - open source: appoved by www.opensource.org
10825 d - allows distribution without restrictions
10826 r - restricted distribtion
10827 n - no license at all
10829 =item CPAN::Module::force($method,@args)
10831 Forces CPAN to perform a task that it normally would have refused to
10832 do. Force takes as arguments a method name to be called and any number
10833 of additional arguments that should be passed to the called method.
10834 The internals of the object get the needed changes so that CPAN.pm
10835 does not refuse to take the action. See also the section above on the
10836 C<force> and the C<fforce> pragma.
10838 =item CPAN::Module::get()
10840 Runs a get on the distribution associated with this module.
10842 =item CPAN::Module::inst_file()
10844 Returns the filename of the module found in @INC. The first file found
10845 is reported just like perl itself stops searching @INC when it finds a
10848 =item CPAN::Module::available_file()
10850 Returns the filename of the module found in PERL5LIB or @INC. The
10851 first file found is reported. The advantage of this method over
10852 C<inst_file> is that modules that have been tested but not yet
10853 installed are included because PERL5LIB keeps track of tested modules.
10855 =item CPAN::Module::inst_version()
10857 Returns the version number of the installed module in readable format.
10859 =item CPAN::Module::available_version()
10861 Returns the version number of the available module in readable format.
10863 =item CPAN::Module::install()
10865 Runs an C<install> on the distribution associated with this module.
10867 =item CPAN::Module::look()
10869 Changes to the directory where the distribution associated with this
10870 module has been unpacked and opens a subshell there. Exiting the
10873 =item CPAN::Module::make()
10875 Runs a C<make> on the distribution associated with this module.
10877 =item CPAN::Module::manpage_headline()
10879 If module is installed, peeks into the module's manpage, reads the
10880 headline and returns it. Moreover, if the module has been downloaded
10881 within this session, does the equivalent on the downloaded module even
10882 if it is not installed.
10884 =item CPAN::Module::perldoc()
10886 Runs a C<perldoc> on this module.
10888 =item CPAN::Module::readme()
10890 Runs a C<readme> on the distribution associated with this module.
10892 =item CPAN::Module::test()
10894 Runs a C<test> on the distribution associated with this module.
10896 =item CPAN::Module::uptodate()
10898 Returns 1 if the module is installed and up-to-date.
10900 =item CPAN::Module::userid()
10902 Returns the author's ID of the module.
10906 =head2 Cache Manager
10908 Currently the cache manager only keeps track of the build directory
10909 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
10910 deletes complete directories below C<build_dir> as soon as the size of
10911 all directories there gets bigger than $CPAN::Config->{build_cache}
10912 (in MB). The contents of this cache may be used for later
10913 re-installations that you intend to do manually, but will never be
10914 trusted by CPAN itself. This is due to the fact that the user might
10915 use these directories for building modules on different architectures.
10917 There is another directory ($CPAN::Config->{keep_source_where}) where
10918 the original distribution files are kept. This directory is not
10919 covered by the cache manager and must be controlled by the user. If
10920 you choose to have the same directory as build_dir and as
10921 keep_source_where directory, then your sources will be deleted with
10922 the same fifo mechanism.
10926 A bundle is just a perl module in the namespace Bundle:: that does not
10927 define any functions or methods. It usually only contains documentation.
10929 It starts like a perl module with a package declaration and a $VERSION
10930 variable. After that the pod section looks like any other pod with the
10931 only difference being that I<one special pod section> exists starting with
10936 In this pod section each line obeys the format
10938 Module_Name [Version_String] [- optional text]
10940 The only required part is the first field, the name of a module
10941 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
10942 of the line is optional. The comment part is delimited by a dash just
10943 as in the man page header.
10945 The distribution of a bundle should follow the same convention as
10946 other distributions.
10948 Bundles are treated specially in the CPAN package. If you say 'install
10949 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
10950 the modules in the CONTENTS section of the pod. You can install your
10951 own Bundles locally by placing a conformant Bundle file somewhere into
10952 your @INC path. The autobundle() command which is available in the
10953 shell interface does that for you by including all currently installed
10954 modules in a snapshot bundle file.
10956 =head1 PREREQUISITES
10958 If you have a local mirror of CPAN and can access all files with
10959 "file:" URLs, then you only need a perl better than perl5.003 to run
10960 this module. Otherwise Net::FTP is strongly recommended. LWP may be
10961 required for non-UNIX systems or if your nearest CPAN site is
10962 associated with a URL that is not C<ftp:>.
10964 If you have neither Net::FTP nor LWP, there is a fallback mechanism
10965 implemented for an external ftp command or for an external lynx
10970 =head2 Finding packages and VERSION
10972 This module presumes that all packages on CPAN
10978 declare their $VERSION variable in an easy to parse manner. This
10979 prerequisite can hardly be relaxed because it consumes far too much
10980 memory to load all packages into the running program just to determine
10981 the $VERSION variable. Currently all programs that are dealing with
10982 version use something like this
10984 perl -MExtUtils::MakeMaker -le \
10985 'print MM->parse_version(shift)' filename
10987 If you are author of a package and wonder if your $VERSION can be
10988 parsed, please try the above method.
10992 come as compressed or gzipped tarfiles or as zip files and contain a
10993 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
10994 without much enthusiasm).
11000 The debugging of this module is a bit complex, because we have
11001 interferences of the software producing the indices on CPAN, of the
11002 mirroring process on CPAN, of packaging, of configuration, of
11003 synchronicity, and of bugs within CPAN.pm.
11005 For debugging the code of CPAN.pm itself in interactive mode some more
11006 or less useful debugging aid can be turned on for most packages within
11007 CPAN.pm with one of
11011 =item o debug package...
11013 sets debug mode for packages.
11015 =item o debug -package...
11017 unsets debug mode for packages.
11021 turns debugging on for all packages.
11023 =item o debug number
11027 which sets the debugging packages directly. Note that C<o debug 0>
11028 turns debugging off.
11030 What seems quite a successful strategy is the combination of C<reload
11031 cpan> and the debugging switches. Add a new debug statement while
11032 running in the shell and then issue a C<reload cpan> and see the new
11033 debugging messages immediately without losing the current context.
11035 C<o debug> without an argument lists the valid package names and the
11036 current set of packages in debugging mode. C<o debug> has built-in
11037 completion support.
11039 For debugging of CPAN data there is the C<dump> command which takes
11040 the same arguments as make/test/install and outputs each object's
11041 Data::Dumper dump. If an argument looks like a perl variable and
11042 contains one of C<$>, C<@> or C<%>, it is eval()ed and fed to
11043 Data::Dumper directly.
11045 =head2 Floppy, Zip, Offline Mode
11047 CPAN.pm works nicely without network too. If you maintain machines
11048 that are not networked at all, you should consider working with file:
11049 URLs. Of course, you have to collect your modules somewhere first. So
11050 you might use CPAN.pm to put together all you need on a networked
11051 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
11052 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
11053 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
11054 with this floppy. See also below the paragraph about CD-ROM support.
11056 =head2 Basic Utilities for Programmers
11060 =item has_inst($module)
11062 Returns true if the module is installed. Used to load all modules into
11063 the running CPAN.pm which are considered optional. The config variable
11064 C<dontload_list> can be used to intercept the C<has_inst()> call such
11065 that an optional module is not loaded despite being available. For
11066 example the following command will prevent that C<YAML.pm> is being
11069 cpan> o conf dontload_list push YAML
11071 See the source for details.
11073 =item has_usable($module)
11075 Returns true if the module is installed and is in a usable state. Only
11076 useful for a handful of modules that are used internally. See the
11077 source for details.
11079 =item instance($module)
11081 The constructor for all the singletons used to represent modules,
11082 distributions, authors and bundles. If the object already exists, this
11083 method returns the object, otherwise it calls the constructor.
11089 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
11090 install foreign, unmasked, unsigned code on your machine. We compare
11091 to a checksum that comes from the net just as the distribution file
11092 itself. But we try to make it easy to add security on demand:
11094 =head2 Cryptographically signed modules
11096 Since release 1.77 CPAN.pm has been able to verify cryptographically
11097 signed module distributions using Module::Signature. The CPAN modules
11098 can be signed by their authors, thus giving more security. The simple
11099 unsigned MD5 checksums that were used before by CPAN protect mainly
11100 against accidental file corruption.
11102 You will need to have Module::Signature installed, which in turn
11103 requires that you have at least one of Crypt::OpenPGP module or the
11104 command-line F<gpg> tool installed.
11106 You will also need to be able to connect over the Internet to the public
11107 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
11109 The configuration parameter check_sigs is there to turn signature
11110 checking on or off.
11114 Most functions in package CPAN are exported per default. The reason
11115 for this is that the primary use is intended for the cpan shell or for
11120 When the CPAN shell enters a subshell via the look command, it sets
11121 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
11124 When CPAN runs, it sets the environment variable PERL5_CPAN_IS_RUNNING.
11126 When the config variable ftp_passive is set, all downloads will be run
11127 with the environment variable FTP_PASSIVE set to this value. This is
11128 in general a good idea as it influences both Net::FTP and LWP based
11129 connections. The same effect can be achieved by starting the cpan
11130 shell with this environment variable set. For Net::FTP alone, one can
11131 also always set passive mode by running libnetcfg.
11133 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
11135 Populating a freshly installed perl with my favorite modules is pretty
11136 easy if you maintain a private bundle definition file. To get a useful
11137 blueprint of a bundle definition file, the command autobundle can be used
11138 on the CPAN shell command line. This command writes a bundle definition
11139 file for all modules that are installed for the currently running perl
11140 interpreter. It's recommended to run this command only once and from then
11141 on maintain the file manually under a private name, say
11142 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
11144 cpan> install Bundle::my_bundle
11146 then answer a few questions and then go out for a coffee.
11148 Maintaining a bundle definition file means keeping track of two
11149 things: dependencies and interactivity. CPAN.pm sometimes fails on
11150 calculating dependencies because not all modules define all MakeMaker
11151 attributes correctly, so a bundle definition file should specify
11152 prerequisites as early as possible. On the other hand, it's a bit
11153 annoying that many distributions need some interactive configuring. So
11154 what I try to accomplish in my private bundle file is to have the
11155 packages that need to be configured early in the file and the gentle
11156 ones later, so I can go out after a few minutes and leave CPAN.pm
11159 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
11161 Thanks to Graham Barr for contributing the following paragraphs about
11162 the interaction between perl, and various firewall configurations. For
11163 further information on firewalls, it is recommended to consult the
11164 documentation that comes with the ncftp program. If you are unable to
11165 go through the firewall with a simple Perl setup, it is very likely
11166 that you can configure ncftp so that it works for your firewall.
11168 =head2 Three basic types of firewalls
11170 Firewalls can be categorized into three basic types.
11174 =item http firewall
11176 This is where the firewall machine runs a web server and to access the
11177 outside world you must do it via the web server. If you set environment
11178 variables like http_proxy or ftp_proxy to a values beginning with http://
11179 or in your web browser you have to set proxy information then you know
11180 you are running an http firewall.
11182 To access servers outside these types of firewalls with perl (even for
11183 ftp) you will need to use LWP.
11187 This where the firewall machine runs an ftp server. This kind of
11188 firewall will only let you access ftp servers outside the firewall.
11189 This is usually done by connecting to the firewall with ftp, then
11190 entering a username like "user@outside.host.com"
11192 To access servers outside these type of firewalls with perl you
11193 will need to use Net::FTP.
11195 =item One way visibility
11197 I say one way visibility as these firewalls try to make themselves look
11198 invisible to the users inside the firewall. An FTP data connection is
11199 normally created by sending the remote server your IP address and then
11200 listening for the connection. But the remote server will not be able to
11201 connect to you because of the firewall. So for these types of firewall
11202 FTP connections need to be done in a passive mode.
11204 There are two that I can think off.
11210 If you are using a SOCKS firewall you will need to compile perl and link
11211 it with the SOCKS library, this is what is normally called a 'socksified'
11212 perl. With this executable you will be able to connect to servers outside
11213 the firewall as if it is not there.
11215 =item IP Masquerade
11217 This is the firewall implemented in the Linux kernel, it allows you to
11218 hide a complete network behind one IP address. With this firewall no
11219 special compiling is needed as you can access hosts directly.
11221 For accessing ftp servers behind such firewalls you usually need to
11222 set the environment variable C<FTP_PASSIVE> or the config variable
11223 ftp_passive to a true value.
11229 =head2 Configuring lynx or ncftp for going through a firewall
11231 If you can go through your firewall with e.g. lynx, presumably with a
11234 /usr/local/bin/lynx -pscott:tiger
11236 then you would configure CPAN.pm with the command
11238 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
11240 That's all. Similarly for ncftp or ftp, you would configure something
11243 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
11245 Your mileage may vary...
11253 I installed a new version of module X but CPAN keeps saying,
11254 I have the old version installed
11256 Most probably you B<do> have the old version installed. This can
11257 happen if a module installs itself into a different directory in the
11258 @INC path than it was previously installed. This is not really a
11259 CPAN.pm problem, you would have the same problem when installing the
11260 module manually. The easiest way to prevent this behaviour is to add
11261 the argument C<UNINST=1> to the C<make install> call, and that is why
11262 many people add this argument permanently by configuring
11264 o conf make_install_arg UNINST=1
11268 So why is UNINST=1 not the default?
11270 Because there are people who have their precise expectations about who
11271 may install where in the @INC path and who uses which @INC array. In
11272 fine tuned environments C<UNINST=1> can cause damage.
11276 I want to clean up my mess, and install a new perl along with
11277 all modules I have. How do I go about it?
11279 Run the autobundle command for your old perl and optionally rename the
11280 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
11281 with the Configure option prefix, e.g.
11283 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
11285 Install the bundle file you produced in the first step with something like
11287 cpan> install Bundle::mybundle
11293 When I install bundles or multiple modules with one command
11294 there is too much output to keep track of.
11296 You may want to configure something like
11298 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
11299 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
11301 so that STDOUT is captured in a file for later inspection.
11306 I am not root, how can I install a module in a personal directory?
11308 First of all, you will want to use your own configuration, not the one
11309 that your root user installed. If you do not have permission to write
11310 in the cpan directory that root has configured, you will be asked if
11311 you want to create your own config. Answering "yes" will bring you into
11312 CPAN's configuration stage, using the system config for all defaults except
11313 things that have to do with CPAN's work directory, saving your choices to
11314 your MyConfig.pm file.
11316 You can also manually initiate this process with the following command:
11318 % perl -MCPAN -e 'mkmyconfig'
11324 from the CPAN shell.
11326 You will most probably also want to configure something like this:
11328 o conf makepl_arg "LIB=~/myperl/lib \
11329 INSTALLMAN1DIR=~/myperl/man/man1 \
11330 INSTALLMAN3DIR=~/myperl/man/man3"
11332 You can make this setting permanent like all C<o conf> settings with
11335 You will have to add ~/myperl/man to the MANPATH environment variable
11336 and also tell your perl programs to look into ~/myperl/lib, e.g. by
11339 use lib "$ENV{HOME}/myperl/lib";
11341 or setting the PERL5LIB environment variable.
11343 While we're speaking about $ENV{HOME}, it might be worth mentioning,
11344 that for Windows we use the File::HomeDir module that provides an
11345 equivalent to the concept of the home directory on Unix.
11347 Another thing you should bear in mind is that the UNINST parameter can
11348 be dnagerous when you are installing into a private area because you
11349 might accidentally remove modules that other people depend on that are
11350 not using the private area.
11354 How to get a package, unwrap it, and make a change before building it?
11356 Have a look at the C<look> (!) command.
11360 I installed a Bundle and had a couple of fails. When I
11361 retried, everything resolved nicely. Can this be fixed to work
11364 The reason for this is that CPAN does not know the dependencies of all
11365 modules when it starts out. To decide about the additional items to
11366 install, it just uses data found in the META.yml file or the generated
11367 Makefile. An undetected missing piece breaks the process. But it may
11368 well be that your Bundle installs some prerequisite later than some
11369 depending item and thus your second try is able to resolve everything.
11370 Please note, CPAN.pm does not know the dependency tree in advance and
11371 cannot sort the queue of things to install in a topologically correct
11372 order. It resolves perfectly well IF all modules declare the
11373 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
11374 the C<requires> stanza of Module::Build. For bundles which fail and
11375 you need to install often, it is recommended to sort the Bundle
11376 definition file manually.
11380 In our intranet we have many modules for internal use. How
11381 can I integrate these modules with CPAN.pm but without uploading
11382 the modules to CPAN?
11384 Have a look at the CPAN::Site module.
11388 When I run CPAN's shell, I get an error message about things in my
11389 /etc/inputrc (or ~/.inputrc) file.
11391 These are readline issues and can only be fixed by studying readline
11392 configuration on your architecture and adjusting the referenced file
11393 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
11394 and edit them. Quite often harmless changes like uppercasing or
11395 lowercasing some arguments solves the problem.
11399 Some authors have strange characters in their names.
11401 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
11402 expecting ISO-8859-1 charset, a converter can be activated by setting
11403 term_is_latin to a true value in your config file. One way of doing so
11406 cpan> o conf term_is_latin 1
11408 If other charset support is needed, please file a bugreport against
11409 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
11410 the support or maybe UTF-8 terminals become widely available.
11414 When an install fails for some reason and then I correct the error
11415 condition and retry, CPAN.pm refuses to install the module, saying
11416 C<Already tried without success>.
11418 Use the force pragma like so
11420 force install Foo::Bar
11426 and then 'make install' directly in the subshell.
11430 How do I install a "DEVELOPER RELEASE" of a module?
11432 By default, CPAN will install the latest non-developer release of a
11433 module. If you want to install a dev release, you have to specify the
11434 partial path starting with the author id to the tarball you wish to
11437 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
11439 Note that you can use the C<ls> command to get this path listed.
11443 How do I install a module and all its dependencies from the commandline,
11444 without being prompted for anything, despite my CPAN configuration
11447 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
11448 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
11449 asked any questions at all (assuming the modules you are installing are
11450 nice about obeying that variable as well):
11452 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
11456 How do I create a Module::Build based Build.PL derived from an
11457 ExtUtils::MakeMaker focused Makefile.PL?
11459 http://search.cpan.org/search?query=Module::Build::Convert
11461 http://accognoscere.org/papers/perl-module-build-convert/module-build-convert.html
11465 What's the best CPAN site for me?
11467 The urllist config parameter is yours. You can add and remove sites at
11468 will. You should find out which sites have the best uptodateness,
11469 bandwidth, reliability, etc. and are topologically close to you. Some
11470 people prefer fast downloads, others uptodateness, others reliability.
11471 You decide which to try in which order.
11473 Henk P. Penning maintains a site that collects data about CPAN sites:
11475 http://www.cs.uu.nl/people/henkp/mirmon/cpan.html
11479 =head1 COMPATIBILITY
11481 =head2 OLD PERL VERSIONS
11483 CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
11484 newer versions. It is getting more and more difficult to get the
11485 minimal prerequisites working on older perls. It is close to
11486 impossible to get the whole Bundle::CPAN working there. If you're in
11487 the position to have only these old versions, be advised that CPAN is
11488 designed to work fine without the Bundle::CPAN installed.
11490 To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
11491 compatible with ancient perls and that File::Temp is listed as a
11492 prerequisite but CPAN has reasonable workarounds if it is missing.
11496 This module and its competitor, the CPANPLUS module, are both much
11497 cooler than the other. CPAN.pm is older. CPANPLUS was designed to be
11498 more modular but it was never tried to make it compatible with CPAN.pm.
11500 =head1 SECURITY ADVICE
11502 This software enables you to upgrade software on your computer and so
11503 is inherently dangerous because the newly installed software may
11504 contain bugs and may alter the way your computer works or even make it
11505 unusable. Please consider backing up your data before every upgrade.
11509 Please report bugs via http://rt.cpan.org/
11511 Before submitting a bug, please make sure that the traditional method
11512 of building a Perl module package from a shell by following the
11513 installation instructions of that package still works in your
11518 Andreas Koenig C<< <andk@cpan.org> >>
11522 This program is free software; you can redistribute it and/or
11523 modify it under the same terms as Perl itself.
11525 See L<http://www.perl.com/perl/misc/Artistic.html>
11527 =head1 TRANSLATIONS
11529 Kawai,Takanori provides a Japanese translation of this manpage at
11530 http://homepage3.nifty.com/hippo2000/perltips/CPAN.htm
11534 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)