1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 $CPAN::VERSION = '1.88_66';
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
86 @CPAN::ISA = qw(CPAN::Debug Exporter);
88 # note that these functions live in CPAN::Shell and get executed via
89 # AUTOLOAD when called directly
113 sub soft_chdir_with_alternatives ($);
116 $autoload_recursion ||= 0;
118 #-> sub CPAN::AUTOLOAD ;
120 $autoload_recursion++;
124 warn "Refusing to autoload '$l' while signal pending";
125 $autoload_recursion--;
128 if ($autoload_recursion > 1) {
129 my $fullcommand = join " ", map { "'$_'" } $l, @_;
130 warn "Refusing to autoload $fullcommand in recursion\n";
131 $autoload_recursion--;
135 @export{@EXPORT} = '';
136 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
137 if (exists $export{$l}){
140 die(qq{Unknown CPAN command "$AUTOLOAD". }.
141 qq{Type ? for help.\n});
143 $autoload_recursion--;
147 #-> sub CPAN::shell ;
150 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
151 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
153 my $oprompt = shift || CPAN::Prompt->new;
154 my $prompt = $oprompt;
155 my $commandline = shift || "";
156 $CPAN::CurrentCommandId ||= 1;
159 unless ($Suppress_readline) {
160 require Term::ReadLine;
163 $term->ReadLine eq "Term::ReadLine::Stub"
165 $term = Term::ReadLine->new('CPAN Monitor');
167 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
168 my $attribs = $term->Attribs;
169 $attribs->{attempted_completion_function} = sub {
170 &CPAN::Complete::gnu_cpl;
173 $readline::rl_completion_function =
174 $readline::rl_completion_function = 'CPAN::Complete::cpl';
176 if (my $histfile = $CPAN::Config->{'histfile'}) {{
177 unless ($term->can("AddHistory")) {
178 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
181 my($fh) = FileHandle->new;
182 open $fh, "<$histfile" or last;
186 $term->AddHistory($_);
190 for ($CPAN::Config->{term_ornaments}) { # alias
191 local $Term::ReadLine::termcap_nowarn = 1;
192 $term->ornaments($_) if defined;
194 # $term->OUT is autoflushed anyway
195 my $odef = select STDERR;
203 my @cwd = grep { defined $_ and length $_ }
205 File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
206 File::Spec->rootdir();
207 my $try_detect_readline;
208 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
209 my $rl_avail = $Suppress_readline ? "suppressed" :
210 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
211 "available (try 'install Bundle::CPAN')";
213 unless ($CPAN::Config->{'inhibit_startup_message'}){
214 $CPAN::Frontend->myprint(
216 cpan shell -- CPAN exploration and modules installation (v%s)
224 my($continuation) = "";
225 my $last_term_ornaments;
226 SHELLCOMMAND: while () {
227 if ($Suppress_readline) {
229 last SHELLCOMMAND unless defined ($_ = <> );
232 last SHELLCOMMAND unless
233 defined ($_ = $term->readline($prompt, $commandline));
235 $_ = "$continuation$_" if $continuation;
237 next SHELLCOMMAND if /^$/;
238 $_ = 'h' if /^\s*\?/;
239 if (/^(?:q(?:uit)?|bye|exit)$/i) {
250 use vars qw($import_done);
251 CPAN->import(':DEFAULT') unless $import_done++;
252 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
259 eval { @line = Text::ParseWords::shellwords($_) };
260 warn($@), next SHELLCOMMAND if $@;
261 warn("Text::Parsewords could not parse the line [$_]"),
262 next SHELLCOMMAND unless @line;
263 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
264 my $command = shift @line;
265 eval { CPAN::Shell->$command(@line) };
270 if ($command =~ /^(make|test|install|ff?orce|notest|clean|report|upgrade)$/) {
271 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
273 soft_chdir_with_alternatives(\@cwd);
274 $CPAN::Frontend->myprint("\n");
276 $CPAN::CurrentCommandId++;
280 $commandline = ""; # I do want to be able to pass a default to
281 # shell, but on the second command I see no
284 CPAN::Queue->nullify_queue;
285 if ($try_detect_readline) {
286 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
288 $CPAN::META->has_inst("Term::ReadLine::Perl")
290 delete $INC{"Term/ReadLine.pm"};
292 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
293 require Term::ReadLine;
294 $CPAN::Frontend->myprint("\n$redef subroutines in ".
295 "Term::ReadLine redefined\n");
299 if ($term and $term->can("ornaments")) {
300 for ($CPAN::Config->{term_ornaments}) { # alias
302 if (not defined $last_term_ornaments
303 or $_ != $last_term_ornaments
305 local $Term::ReadLine::termcap_nowarn = 1;
306 $term->ornaments($_);
307 $last_term_ornaments = $_;
310 undef $last_term_ornaments;
314 for my $class (qw(Module Distribution)) {
315 # again unsafe meta access?
316 for my $dm (keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) {
317 next unless $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
318 CPAN->debug("BUG: $class '$dm' was in command state, resetting");
319 delete $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
323 $GOTOSHELL = 0; # not too often
324 $META->savehist if $CPAN::term && $CPAN::term->can("GetHistory");
329 soft_chdir_with_alternatives(\@cwd);
332 sub soft_chdir_with_alternatives ($) {
335 my $root = File::Spec->rootdir();
336 $CPAN::Frontend->mywarn(qq{Warning: no good directory to chdir to!
337 Trying '$root' as temporary haven.
342 if (chdir $cwd->[0]) {
346 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
347 Trying to chdir to "$cwd->[1]" instead.
351 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
358 my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
360 $yaml_module ne "YAML"
362 !$CPAN::META->has_inst($yaml_module)
364 # $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back to 'YAML'\n");
365 $yaml_module = "YAML";
370 # CPAN::_yaml_loadfile
372 my($self,$local_file) = @_;
373 return +[] unless -s $local_file;
374 my $yaml_module = $self->_yaml_module;
375 if ($CPAN::META->has_inst($yaml_module)) {
376 my $code = UNIVERSAL::can($yaml_module, "LoadFile");
378 eval { @yaml = $code->($local_file); };
380 $CPAN::Frontend->mydie("Alert: While trying to parse YAML file\n".
382 "with $yaml_module the following error was encountered:\n".
388 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot parse '$local_file'\n");
393 # CPAN::_yaml_dumpfile
395 my($self,$to_local_file,@what) = @_;
396 my $yaml_module = $self->_yaml_module;
397 if ($CPAN::META->has_inst($yaml_module)) {
398 if (UNIVERSAL::isa($to_local_file, "FileHandle")) {
399 my $code = UNIVERSAL::can($yaml_module, "Dump");
400 eval { print $to_local_file $code->(@what) };
402 my $code = UNIVERSAL::can($yaml_module, "DumpFile");
403 eval { $code->($to_local_file,@what); };
406 $CPAN::Frontend->mydie("Alert: While trying to dump YAML file\n".
408 "with $yaml_module the following error was encountered:\n".
413 if (UNIVERSAL::isa($to_local_file, "FileHandle")) {
414 # I think this case does not justify a warning at all
416 $CPAN::Frontend->myprint("Note (usually harmless): '$yaml_module' ".
417 "not installed, not dumping to '$to_local_file'\n");
422 sub _init_sqlite () {
423 unless ($CPAN::META->has_inst("CPAN::SQLite")) {
424 $CPAN::Frontend->mywarn(qq{CPAN::SQLite not installed, cannot work with it\n})
425 unless $Have_warned->{"CPAN::SQLite"}++;
428 require CPAN::SQLite::META; # not needed since CVS version of 2006-12-17
429 $CPAN::SQLite ||= CPAN::SQLite::META->new($CPAN::META);
433 my $negative_cache = {};
434 sub _sqlite_running {
435 if ($negative_cache->{time} && time < $negative_cache->{time} + 60) {
436 # need to cache the result, otherwise too slow
437 return $negative_cache->{fact};
439 $negative_cache = {}; # reset
441 my $ret = $CPAN::Config->{use_sqlite} && ($CPAN::SQLite || _init_sqlite());
442 return $ret if $ret; # fast anyway
443 $negative_cache->{time} = time;
444 return $negative_cache->{fact} = $ret;
448 package CPAN::CacheMgr;
450 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
455 use Fcntl qw(:flock);
456 use vars qw($Ua $Thesite $ThesiteURL $Themethod);
457 @CPAN::FTP::ISA = qw(CPAN::Debug);
459 package CPAN::LWP::UserAgent;
461 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
462 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
464 package CPAN::Complete;
466 @CPAN::Complete::ISA = qw(CPAN::Debug);
467 # Q: where is the "How do I add a new command" HOWTO?
468 # A: svn diff -r 1048:1049 where andk added the report command
469 @CPAN::Complete::COMMANDS = sort qw(
470 ! a b d h i m o q r u
497 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED);
498 @CPAN::Index::ISA = qw(CPAN::Debug);
501 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
504 package CPAN::InfoObj;
506 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
508 package CPAN::Author;
510 @CPAN::Author::ISA = qw(CPAN::InfoObj);
512 package CPAN::Distribution;
514 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
516 package CPAN::Bundle;
518 @CPAN::Bundle::ISA = qw(CPAN::Module);
520 package CPAN::Module;
522 @CPAN::Module::ISA = qw(CPAN::InfoObj);
524 package CPAN::Exception::RecursiveDependency;
526 use overload '""' => "as_string";
533 for my $dep (@$deps) {
535 last if $seen{$dep}++;
537 bless { deps => \@deps }, $class;
542 "\nRecursive dependency detected:\n " .
543 join("\n => ", @{$self->{deps}}) .
544 ".\nCannot continue.\n";
547 package CPAN::Prompt; use overload '""' => "as_string";
548 use vars qw($prompt);
550 $CPAN::CurrentCommandId ||= 0;
556 unless ($CPAN::META->{LOCK}) {
557 $word = "nolock_cpan";
559 if ($CPAN::Config->{commandnumber_in_prompt}) {
560 sprintf "$word\[%d]> ", $CPAN::CurrentCommandId;
566 package CPAN::URL; use overload '""' => "as_string", fallback => 1;
567 # accessors: TEXT(the url string), FROM(DEF=>defaultlist,USER=>urllist),
568 # planned are things like age or quality
570 my($class,%args) = @_;
582 $self->{TEXT} = $set;
587 package CPAN::Distrostatus;
588 use overload '""' => "as_string",
591 my($class,$arg) = @_;
594 FAILED => substr($arg,0,2) eq "NO",
595 COMMANDID => $CPAN::CurrentCommandId,
599 sub commandid { shift->{COMMANDID} }
600 sub failed { shift->{FAILED} }
604 $self->{TEXT} = $set;
623 @CPAN::Shell::ISA = qw(CPAN::Debug);
624 $COLOR_REGISTERED ||= 0;
627 $autoload_recursion ||= 0;
629 #-> sub CPAN::Shell::AUTOLOAD ;
631 $autoload_recursion++;
633 my $class = shift(@_);
634 # warn "autoload[$l] class[$class]";
637 warn "Refusing to autoload '$l' while signal pending";
638 $autoload_recursion--;
641 if ($autoload_recursion > 1) {
642 my $fullcommand = join " ", map { "'$_'" } $l, @_;
643 warn "Refusing to autoload $fullcommand in recursion\n";
644 $autoload_recursion--;
648 # XXX needs to be reconsidered
649 if ($CPAN::META->has_inst('CPAN::WAIT')) {
652 $CPAN::Frontend->mywarn(qq{
653 Commands starting with "w" require CPAN::WAIT to be installed.
654 Please consider installing CPAN::WAIT to use the fulltext index.
655 For this you just need to type
660 $CPAN::Frontend->mywarn(qq{Unknown shell command '$l'. }.
664 $autoload_recursion--;
671 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
673 # from here on only subs.
674 ################################################################################
676 sub _perl_fingerprint {
677 my($self,$other_fingerprint) = @_;
678 my $dll = eval {OS2::DLLname()};
681 $mtime_dll = (-f $dll ? (stat(_))[9] : '-1');
683 my $this_fingerprint = {
685 sitearchexp => $Config::Config{sitearchexp},
686 'mtime_$^X' => (stat $^X)[9],
687 'mtime_dll' => $mtime_dll,
689 if ($other_fingerprint) {
690 if (exists $other_fingerprint->{'stat($^X)'}) { # repair fp from rev. 1.88_57
691 $other_fingerprint->{'mtime_$^X'} = $other_fingerprint->{'stat($^X)'}[9];
693 # mandatory keys since 1.88_57
694 for my $key (qw($^X sitearchexp mtime_dll mtime_$^X)) {
695 return unless $other_fingerprint->{$key} eq $this_fingerprint->{$key};
699 return $this_fingerprint;
703 sub suggest_myconfig () {
704 SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
705 $CPAN::Frontend->myprint("You don't seem to have a user ".
706 "configuration (MyConfig.pm) yet.\n");
707 my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ".
708 "user configuration now? (Y/n)",
711 CPAN::Shell->mkmyconfig();
714 $CPAN::Frontend->mydie("OK, giving up.");
719 #-> sub CPAN::all_objects ;
721 my($mgr,$class) = @_;
722 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
723 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
725 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
728 # Called by shell, not in batch mode. In batch mode I see no risk in
729 # having many processes updating something as installations are
730 # continually checked at runtime. In shell mode I suspect it is
731 # unintentional to open more than one shell at a time
733 #-> sub CPAN::checklock ;
736 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
737 if (-f $lockfile && -M _ > 0) {
738 my $fh = FileHandle->new($lockfile) or
739 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
740 my $otherpid = <$fh>;
741 my $otherhost = <$fh>;
743 if (defined $otherpid && $otherpid) {
746 if (defined $otherhost && $otherhost) {
749 my $thishost = hostname();
750 if (defined $otherhost && defined $thishost &&
751 $otherhost ne '' && $thishost ne '' &&
752 $otherhost ne $thishost) {
753 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
754 "reports other host $otherhost and other ".
755 "process $otherpid.\n".
756 "Cannot proceed.\n"));
757 } elsif ($RUN_DEGRADED) {
758 $CPAN::Frontend->mywarn("Running in degraded mode (experimental)\n");
759 } elsif (defined $otherpid && $otherpid) {
760 return if $$ == $otherpid; # should never happen
761 $CPAN::Frontend->mywarn(
763 There seems to be running another CPAN process (pid $otherpid). Contacting...
765 if (kill 0, $otherpid) {
766 $CPAN::Frontend->mywarn(qq{Other job is running.\n});
768 CPAN::Shell::colorable_makemaker_prompt
769 (qq{Shall I try to run in degraded }.
770 qq{mode? (Y/n)},"y");
772 $CPAN::Frontend->mywarn("Running in degraded mode (experimental).
773 Please report if something unexpected happens\n");
775 for ($CPAN::Config) {
777 # $_->{build_dir_reuse} = 0; # 2006-11-17 akoenig Why was that?
778 $_->{commandnumber_in_prompt} = 0; # visibility
779 $_->{histfile} = ""; # who should win otherwise?
780 $_->{cache_metadata} = 0; # better would be a lock?
783 $CPAN::Frontend->mydie("
784 You may want to kill the other job and delete the lockfile. On UNIX try:
789 } elsif (-w $lockfile) {
791 CPAN::Shell::colorable_makemaker_prompt
792 (qq{Other job not responding. Shall I overwrite }.
793 qq{the lockfile '$lockfile'? (Y/n)},"y");
794 $CPAN::Frontend->myexit("Ok, bye\n")
795 unless $ans =~ /^y/i;
798 qq{Lockfile '$lockfile' not writeable by you. }.
799 qq{Cannot proceed.\n}.
801 qq{ rm '$lockfile'\n}.
802 qq{ and then rerun us.\n}
806 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Found invalid lockfile ".
807 "'$lockfile', please remove. Cannot proceed.\n"));
810 my $dotcpan = $CPAN::Config->{cpan_home};
811 eval { File::Path::mkpath($dotcpan);};
813 # A special case at least for Jarkko.
818 $symlinkcpan = readlink $dotcpan;
819 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
820 eval { File::Path::mkpath($symlinkcpan); };
824 $CPAN::Frontend->mywarn(qq{
825 Working directory $symlinkcpan created.
829 unless (-d $dotcpan) {
831 Your configuration suggests "$dotcpan" as your
832 CPAN.pm working directory. I could not create this directory due
833 to this error: $firsterror\n};
835 As "$dotcpan" is a symlink to "$symlinkcpan",
836 I tried to create that, but I failed with this error: $seconderror
839 Please make sure the directory exists and is writable.
841 $CPAN::Frontend->myprint($mess);
842 return suggest_myconfig;
844 } # $@ after eval mkpath $dotcpan
845 if (0) { # to test what happens when a race condition occurs
846 for (reverse 1..10) {
852 if (!$RUN_DEGRADED && !$self->{LOCKFH}) {
854 unless ($fh = FileHandle->new("+>>$lockfile")) {
855 if ($! =~ /Permission/) {
856 $CPAN::Frontend->myprint(qq{
858 Your configuration suggests that CPAN.pm should use a working
860 $CPAN::Config->{cpan_home}
861 Unfortunately we could not create the lock file
863 due to permission problems.
865 Please make sure that the configuration variable
866 \$CPAN::Config->{cpan_home}
867 points to a directory where you can write a .lock file. You can set
868 this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
871 return suggest_myconfig;
875 while (!flock $fh, LOCK_EX|LOCK_NB) {
877 $CPAN::Frontend->mydie("Giving up\n");
879 $CPAN::Frontend->mysleep($sleep++);
880 $CPAN::Frontend->mywarn("Could not lock lockfile with flock: $!; retrying\n");
885 $fh->print($$, "\n");
886 $fh->print(hostname(), "\n");
887 $self->{LOCK} = $lockfile;
888 $self->{LOCKFH} = $fh;
893 $CPAN::Frontend->mydie("Got SIG$sig, leaving");
899 die "Got yet another signal" if $Signal > 1;
900 $CPAN::Frontend->mydie("Got another SIG$sig") if $Signal;
901 $CPAN::Frontend->mywarn("Caught SIG$sig, trying to continue\n");
905 # From: Larry Wall <larry@wall.org>
906 # Subject: Re: deprecating SIGDIE
907 # To: perl5-porters@perl.org
908 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
910 # The original intent of __DIE__ was only to allow you to substitute one
911 # kind of death for another on an application-wide basis without respect
912 # to whether you were in an eval or not. As a global backstop, it should
913 # not be used any more lightly (or any more heavily :-) than class
914 # UNIVERSAL. Any attempt to build a general exception model on it should
915 # be politely squashed. Any bug that causes every eval {} to have to be
916 # modified should be not so politely squashed.
918 # Those are my current opinions. It is also my optinion that polite
919 # arguments degenerate to personal arguments far too frequently, and that
920 # when they do, it's because both people wanted it to, or at least didn't
921 # sufficiently want it not to.
925 # global backstop to cleanup if we should really die
926 $SIG{__DIE__} = \&cleanup;
927 $self->debug("Signal handler set.") if $CPAN::DEBUG;
930 #-> sub CPAN::DESTROY ;
932 &cleanup; # need an eval?
935 #-> sub CPAN::anycwd ;
938 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
943 sub cwd {Cwd::cwd();}
945 #-> sub CPAN::getcwd ;
946 sub getcwd {Cwd::getcwd();}
948 #-> sub CPAN::fastcwd ;
949 sub fastcwd {Cwd::fastcwd();}
951 #-> sub CPAN::backtickcwd ;
952 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
954 #-> sub CPAN::find_perl ;
956 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
957 my $pwd = $CPAN::iCwd = CPAN::anycwd();
958 my $candidate = File::Spec->catfile($pwd,$^X);
959 $perl ||= $candidate if MM->maybe_command($candidate);
962 my ($component,$perl_name);
963 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
964 PATH_COMPONENT: foreach $component (File::Spec->path(),
965 $Config::Config{'binexp'}) {
966 next unless defined($component) && $component;
967 my($abs) = File::Spec->catfile($component,$perl_name);
968 if (MM->maybe_command($abs)) {
980 #-> sub CPAN::exists ;
982 my($mgr,$class,$id) = @_;
983 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
985 ### Carp::croak "exists called without class argument" unless $class;
987 $id =~ s/:+/::/g if $class eq "CPAN::Module";
989 if (CPAN::_sqlite_running) {
990 $exists = (exists $META->{readonly}{$class}{$id} or
991 $CPAN::SQLite->set($class, $id));
993 $exists = exists $META->{readonly}{$class}{$id};
995 $exists ||= exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
998 #-> sub CPAN::delete ;
1000 my($mgr,$class,$id) = @_;
1001 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
1002 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
1005 #-> sub CPAN::has_usable
1006 # has_inst is sometimes too optimistic, we should replace it with this
1007 # has_usable whenever a case is given
1009 my($self,$mod,$message) = @_;
1010 return 1 if $HAS_USABLE->{$mod};
1011 my $has_inst = $self->has_inst($mod,$message);
1012 return unless $has_inst;
1015 LWP => [ # we frequently had "Can't locate object
1016 # method "new" via package "LWP::UserAgent" at
1017 # (eval 69) line 2006
1019 sub {require LWP::UserAgent},
1020 sub {require HTTP::Request},
1021 sub {require URI::URL},
1024 sub {require Net::FTP},
1025 sub {require Net::Config},
1027 'File::HomeDir' => [
1028 sub {require File::HomeDir;
1029 unless (File::HomeDir::->VERSION >= 0.52){
1030 for ("Will not use File::HomeDir, need 0.52\n") {
1031 $CPAN::Frontend->mywarn($_);
1038 if ($usable->{$mod}) {
1039 for my $c (0..$#{$usable->{$mod}}) {
1040 my $code = $usable->{$mod}[$c];
1041 my $ret = eval { &$code() };
1042 $ret = "" unless defined $ret;
1044 # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
1049 return $HAS_USABLE->{$mod} = 1;
1052 #-> sub CPAN::has_inst
1054 my($self,$mod,$message) = @_;
1055 Carp::croak("CPAN->has_inst() called without an argument")
1056 unless defined $mod;
1057 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
1058 keys %{$CPAN::Config->{dontload_hash}||{}},
1059 @{$CPAN::Config->{dontload_list}||[]};
1060 if (defined $message && $message eq "no" # afair only used by Nox
1064 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
1072 # checking %INC is wrong, because $INC{LWP} may be true
1073 # although $INC{"URI/URL.pm"} may have failed. But as
1074 # I really want to say "bla loaded OK", I have to somehow
1076 ### warn "$file in %INC"; #debug
1078 } elsif (eval { require $file }) {
1079 # eval is good: if we haven't yet read the database it's
1080 # perfect and if we have installed the module in the meantime,
1081 # it tries again. The second require is only a NOOP returning
1082 # 1 if we had success, otherwise it's retrying
1084 my $v = eval "\$$mod\::VERSION";
1085 $v = $v ? " (v$v)" : "";
1086 $CPAN::Frontend->myprint("CPAN: $mod loaded ok$v\n");
1087 if ($mod eq "CPAN::WAIT") {
1088 push @CPAN::Shell::ISA, 'CPAN::WAIT';
1091 } elsif ($mod eq "Net::FTP") {
1092 $CPAN::Frontend->mywarn(qq{
1093 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
1095 install Bundle::libnet
1097 }) unless $Have_warned->{"Net::FTP"}++;
1098 $CPAN::Frontend->mysleep(3);
1099 } elsif ($mod eq "Digest::SHA"){
1100 if ($Have_warned->{"Digest::SHA"}++) {
1101 $CPAN::Frontend->myprint(qq{CPAN: checksum security checks disabled}.
1102 qq{because Digest::SHA not installed.\n});
1104 $CPAN::Frontend->mywarn(qq{
1105 CPAN: checksum security checks disabled because Digest::SHA not installed.
1106 Please consider installing the Digest::SHA module.
1109 $CPAN::Frontend->mysleep(2);
1111 } elsif ($mod eq "Module::Signature"){
1112 # NOT prefs_lookup, we are not a distro
1113 my $check_sigs = $CPAN::Config->{check_sigs};
1114 if (not $check_sigs) {
1115 # they do not want us:-(
1116 } elsif (not $Have_warned->{"Module::Signature"}++) {
1117 # No point in complaining unless the user can
1118 # reasonably install and use it.
1119 if (eval { require Crypt::OpenPGP; 1 } ||
1121 defined $CPAN::Config->{'gpg'}
1123 $CPAN::Config->{'gpg'} =~ /\S/
1126 $CPAN::Frontend->mywarn(qq{
1127 CPAN: Module::Signature security checks disabled because Module::Signature
1128 not installed. Please consider installing the Module::Signature module.
1129 You may also need to be able to connect over the Internet to the public
1130 keyservers like pgp.mit.edu (port 11371).
1133 $CPAN::Frontend->mysleep(2);
1137 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
1142 #-> sub CPAN::instance ;
1144 my($mgr,$class,$id) = @_;
1145 CPAN::Index->reload;
1147 # unsafe meta access, ok?
1148 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
1149 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
1157 #-> sub CPAN::cleanup ;
1159 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
1160 local $SIG{__DIE__} = '';
1165 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
1166 $ineval = 1, last if
1167 $subroutine eq '(eval)';
1169 return if $ineval && !$CPAN::End;
1170 return unless defined $META->{LOCK};
1171 return unless -f $META->{LOCK};
1173 unlink $META->{LOCK};
1175 # Carp::cluck("DEBUGGING");
1176 if ( $CPAN::CONFIG_DIRTY ) {
1177 $CPAN::Frontend->mywarn("Warning: Configuration not saved.\n");
1179 $CPAN::Frontend->myprint("Lockfile removed.\n");
1182 #-> sub CPAN::savehist
1185 my($histfile,$histsize);
1186 unless ($histfile = $CPAN::Config->{'histfile'}){
1187 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
1190 $histsize = $CPAN::Config->{'histsize'} || 100;
1192 unless ($CPAN::term->can("GetHistory")) {
1193 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
1199 my @h = $CPAN::term->GetHistory;
1200 splice @h, 0, @h-$histsize if @h>$histsize;
1201 my($fh) = FileHandle->new;
1202 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
1203 local $\ = local $, = "\n";
1208 #-> sub CPAN::is_tested
1210 my($self,$what) = @_;
1211 $self->{is_tested}{$what} = 1;
1214 #-> sub CPAN::is_installed
1215 # unsets the is_tested flag: as soon as the thing is installed, it is
1216 # not needed in set_perl5lib anymore
1218 my($self,$what) = @_;
1219 delete $self->{is_tested}{$what};
1222 #-> sub CPAN::set_perl5lib
1224 my($self,$for) = @_;
1226 (undef,undef,undef,$for) = caller(1);
1229 $self->{is_tested} ||= {};
1230 return unless %{$self->{is_tested}};
1231 my $env = $ENV{PERL5LIB};
1232 $env = $ENV{PERLLIB} unless defined $env;
1234 push @env, $env if defined $env and length $env;
1235 #my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1236 #$CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1237 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} sort keys %{$self->{is_tested}};
1239 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB for $for\n");
1241 my @d = map {s/^\Q$CPAN::Config->{'build_dir'}/%BUILDDIR%/; $_ }
1242 sort keys %{$self->{is_tested}};
1243 $CPAN::Frontend->myprint("Prepending blib/arch and blib/lib subdirs of ".
1245 "%BUILDDIR%=$CPAN::Config->{'build_dir'} ".
1250 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1253 package CPAN::CacheMgr;
1256 #-> sub CPAN::CacheMgr::as_string ;
1258 eval { require Data::Dumper };
1260 return shift->SUPER::as_string;
1262 return Data::Dumper::Dumper(shift);
1266 #-> sub CPAN::CacheMgr::cachesize ;
1271 #-> sub CPAN::CacheMgr::tidyup ;
1274 return unless $CPAN::META->{LOCK};
1275 return unless -d $self->{ID};
1276 while ($self->{DU} > $self->{'MAX'} ) {
1277 my($toremove) = shift @{$self->{FIFO}};
1278 unless ($toremove =~ /\.yml$/) {
1279 $CPAN::Frontend->myprint(sprintf(
1280 "Deleting from cache".
1281 ": $toremove (%.1f>%.1f MB)\n",
1282 $self->{DU}, $self->{'MAX'})
1285 return if $CPAN::Signal;
1286 $self->_clean_cache($toremove);
1287 return if $CPAN::Signal;
1291 #-> sub CPAN::CacheMgr::dir ;
1296 #-> sub CPAN::CacheMgr::entries ;
1298 my($self,$dir) = @_;
1299 return unless defined $dir;
1300 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1301 $dir ||= $self->{ID};
1302 my($cwd) = CPAN::anycwd();
1303 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1304 my $dh = DirHandle->new(File::Spec->curdir)
1305 or Carp::croak("Couldn't opendir $dir: $!");
1308 next if $_ eq "." || $_ eq "..";
1310 push @entries, File::Spec->catfile($dir,$_);
1312 push @entries, File::Spec->catdir($dir,$_);
1314 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1317 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1318 sort { -M $b <=> -M $a} @entries;
1321 #-> sub CPAN::CacheMgr::disk_usage ;
1323 my($self,$dir) = @_;
1324 return if exists $self->{SIZE}{$dir};
1325 return if $CPAN::Signal;
1329 unless (chmod 0755, $dir) {
1330 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1331 "permission to change the permission; cannot ".
1332 "estimate disk usage of '$dir'\n");
1333 $CPAN::Frontend->mysleep(5);
1338 $CPAN::Frontend->mywarn("Directory '$dir' has gone. Cannot continue.\n");
1343 $File::Find::prune++ if $CPAN::Signal;
1345 if ($^O eq 'MacOS') {
1347 my $cat = Mac::Files::FSpGetCatInfo($_);
1348 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1352 unless (chmod 0755, $_) {
1353 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1354 "the permission to change the permission; ".
1355 "can only partially estimate disk usage ".
1357 $CPAN::Frontend->mysleep(5);
1368 return if $CPAN::Signal;
1369 $self->{SIZE}{$dir} = $Du/1024/1024;
1370 push @{$self->{FIFO}}, $dir;
1371 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1372 $self->{DU} += $Du/1024/1024;
1376 #-> sub CPAN::CacheMgr::_clean_cache ;
1378 my($self,$dir) = @_;
1379 return unless -e $dir;
1380 unless (File::Spec->canonpath(File::Basename::dirname($dir))
1381 eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
1382 $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
1383 "will not remove\n");
1384 $CPAN::Frontend->mysleep(5);
1387 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1389 File::Path::rmtree($dir);
1390 unlink "$dir.yml"; # may fail
1391 $self->{DU} -= $self->{SIZE}{$dir};
1392 delete $self->{SIZE}{$dir};
1395 #-> sub CPAN::CacheMgr::new ;
1402 ID => $CPAN::Config->{'build_dir'},
1403 MAX => $CPAN::Config->{'build_cache'},
1404 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1407 File::Path::mkpath($self->{ID});
1408 my $dh = DirHandle->new($self->{ID});
1409 bless $self, $class;
1412 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1414 CPAN->debug($debug) if $CPAN::DEBUG;
1418 #-> sub CPAN::CacheMgr::scan_cache ;
1421 return if $self->{SCAN} eq 'never';
1422 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1423 unless $self->{SCAN} eq 'atstart';
1424 $CPAN::Frontend->myprint(
1425 sprintf("Scanning cache %s for sizes\n",
1428 for $e ($self->entries($self->{ID})) {
1429 next if $e eq ".." || $e eq ".";
1430 $self->disk_usage($e);
1431 return if $CPAN::Signal;
1436 package CPAN::Shell;
1439 #-> sub CPAN::Shell::h ;
1441 my($class,$about) = @_;
1442 if (defined $about) {
1443 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1445 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1446 $CPAN::Frontend->myprint(qq{
1447 Display Information $filler (ver $CPAN::VERSION)
1448 command argument description
1449 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1450 i WORD or /REGEXP/ about any of the above
1451 ls AUTHOR or GLOB about files in the author's directory
1452 (with WORD being a module, bundle or author name or a distribution
1453 name of the form AUTHOR/DISTRIBUTION)
1455 Download, Test, Make, Install...
1456 get download clean make clean
1457 make make (implies get) look open subshell in dist directory
1458 test make test (implies make) readme display these README files
1459 install make install (implies test) perldoc display POD documentation
1462 r WORDs or /REGEXP/ or NONE report updates for some/matching/all modules
1463 upgrade WORDs or /REGEXP/ or NONE upgrade some/matching/all modules
1466 force CMD try hard to do command
1467 notest CMD skip testing
1470 h,? display this menu ! perl-code eval a perl command
1471 o conf [opt] set and query options q quit the cpan shell
1472 reload cpan load CPAN.pm again reload index load newer indices
1473 autobundle Snapshot recent latest CPAN uploads});
1479 #-> sub CPAN::Shell::a ;
1481 my($self,@arg) = @_;
1482 # authors are always UPPERCASE
1484 $_ = uc $_ unless /=/;
1486 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1489 #-> sub CPAN::Shell::globls ;
1491 my($self,$s,$pragmas) = @_;
1492 # ls is really very different, but we had it once as an ordinary
1493 # command in the Shell (upto rev. 321) and we could not handle
1495 my(@accept,@preexpand);
1496 if ($s =~ /[\*\?\/]/) {
1497 if ($CPAN::META->has_inst("Text::Glob")) {
1498 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1499 my $rau = Text::Glob::glob_to_regex(uc $au);
1500 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1502 push @preexpand, map { $_->id . "/" . $pathglob }
1503 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1505 my $rau = Text::Glob::glob_to_regex(uc $s);
1506 push @preexpand, map { $_->id }
1507 CPAN::Shell->expand_by_method('CPAN::Author',
1512 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1515 push @preexpand, uc $s;
1518 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1519 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1524 my $silent = @accept>1;
1525 my $last_alpha = "";
1527 for my $a (@accept){
1528 my($author,$pathglob);
1529 if ($a =~ m|(.*?)/(.*)|) {
1532 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1534 $a2) or die "No author found for $a2";
1536 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1538 $a) or die "No author found for $a";
1541 my $alpha = substr $author->id, 0, 1;
1543 if ($alpha eq $last_alpha) {
1547 $last_alpha = $alpha;
1549 $CPAN::Frontend->myprint($ad);
1551 for my $pragma (@$pragmas) {
1552 if ($author->can($pragma)) {
1556 push @results, $author->ls($pathglob,$silent); # silent if
1559 for my $pragma (@$pragmas) {
1560 my $unpragma = "un$pragma";
1561 if ($author->can($unpragma)) {
1562 $author->$unpragma();
1569 #-> sub CPAN::Shell::local_bundles ;
1571 my($self,@which) = @_;
1572 my($incdir,$bdir,$dh);
1573 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1574 my @bbase = "Bundle";
1575 while (my $bbase = shift @bbase) {
1576 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1577 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1578 if ($dh = DirHandle->new($bdir)) { # may fail
1580 for $entry ($dh->read) {
1581 next if $entry =~ /^\./;
1582 next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
1583 if (-d File::Spec->catdir($bdir,$entry)){
1584 push @bbase, "$bbase\::$entry";
1586 next unless $entry =~ s/\.pm(?!\n)\Z//;
1587 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1595 #-> sub CPAN::Shell::b ;
1597 my($self,@which) = @_;
1598 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1599 $self->local_bundles;
1600 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1603 #-> sub CPAN::Shell::d ;
1604 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1606 #-> sub CPAN::Shell::m ;
1607 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1609 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1612 #-> sub CPAN::Shell::i ;
1616 @args = '/./' unless @args;
1618 for my $type (qw/Bundle Distribution Module/) {
1619 push @result, $self->expand($type,@args);
1621 # Authors are always uppercase.
1622 push @result, $self->expand("Author", map { uc $_ } @args);
1624 my $result = @result == 1 ?
1625 $result[0]->as_string :
1627 "No objects found of any type for argument @args\n" :
1629 (map {$_->as_glimpse} @result),
1630 scalar @result, " items found\n",
1632 $CPAN::Frontend->myprint($result);
1635 #-> sub CPAN::Shell::o ;
1637 # CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o
1638 # conf' calls through to CPAN::HandleConfig::edit. 'o conf' should
1639 # probably have been called 'set' and 'o debug' maybe 'set debug' or
1640 # 'debug'; 'o conf ARGS' calls ->edit in CPAN/HandleConfig.pm
1642 my($self,$o_type,@o_what) = @_;
1644 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1645 if ($o_type eq 'conf') {
1646 if (!@o_what) { # print all things, "o conf"
1648 $CPAN::Frontend->myprint("\$CPAN::Config options from ");
1650 if (exists $INC{'CPAN/Config.pm'}) {
1651 push @from, $INC{'CPAN/Config.pm'};
1653 if (exists $INC{'CPAN/MyConfig.pm'}) {
1654 push @from, $INC{'CPAN/MyConfig.pm'};
1656 $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
1657 $CPAN::Frontend->myprint(":\n");
1658 for $k (sort keys %CPAN::HandleConfig::can) {
1659 $v = $CPAN::HandleConfig::can{$k};
1660 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
1662 $CPAN::Frontend->myprint("\n");
1663 for $k (sort keys %$CPAN::Config) {
1664 CPAN::HandleConfig->prettyprint($k);
1666 $CPAN::Frontend->myprint("\n");
1668 if (CPAN::HandleConfig->edit(@o_what)) {
1669 unless ($o_what[0] =~ /^(init|commit|defaults)$/) {
1670 $CPAN::Frontend->myprint("Please use 'o conf commit' to ".
1671 "make the config permanent!\n\n");
1674 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
1678 } elsif ($o_type eq 'debug') {
1680 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1683 my($what) = shift @o_what;
1684 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1685 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1688 if ( exists $CPAN::DEBUG{$what} ) {
1689 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1690 } elsif ($what =~ /^\d/) {
1691 $CPAN::DEBUG = $what;
1692 } elsif (lc $what eq 'all') {
1694 for (values %CPAN::DEBUG) {
1697 $CPAN::DEBUG = $max;
1700 for (keys %CPAN::DEBUG) {
1701 next unless lc($_) eq lc($what);
1702 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1705 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1710 my $raw = "Valid options for debug are ".
1711 join(", ",sort(keys %CPAN::DEBUG), 'all').
1712 qq{ or a number. Completion works on the options. }.
1713 qq{Case is ignored.};
1715 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1716 $CPAN::Frontend->myprint("\n\n");
1719 $CPAN::Frontend->myprint("Options set for debugging ($CPAN::DEBUG):\n");
1721 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1722 $v = $CPAN::DEBUG{$k};
1723 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1724 if $v & $CPAN::DEBUG;
1727 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1730 $CPAN::Frontend->myprint(qq{
1732 conf set or get configuration variables
1733 debug set or get debugging options
1738 # CPAN::Shell::paintdots_onreload
1739 sub paintdots_onreload {
1742 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
1746 # $CPAN::Frontend->myprint(".($subr)");
1747 $CPAN::Frontend->myprint(".");
1748 if ($subr =~ /\bshell\b/i) {
1749 # warn "debug[$_[0]]";
1751 # It would be nice if we could detect that a
1752 # subroutine has actually changed, but for now we
1753 # practically always set the GOTOSHELL global
1763 #-> sub CPAN::Shell::hosts ;
1766 my $fullstats = CPAN::FTP->_ftp_statistics();
1767 my $history = $fullstats->{history} || [];
1769 while (my $last = pop @$history) {
1770 my $attempts = $last->{attempts} or next;
1773 $start = $attempts->[-1]{start};
1774 if ($#$attempts > 0) {
1775 for my $i (0..$#$attempts-1) {
1776 my $url = $attempts->[$i]{url} or next;
1781 $start = $last->{start};
1783 next unless $last->{thesiteurl}; # C-C? bad filenames?
1785 $S{end} ||= $last->{end};
1786 my $dltime = $last->{end} - $start;
1787 my $dlsize = $last->{filesize} || 0;
1788 my $url = $last->{thesiteurl}->text;
1789 my $s = $S{ok}{$url} ||= {};
1792 $s->{dlsize} += $dlsize/1024;
1794 $s->{dltime} += $dltime;
1797 for my $url (keys %{$S{ok}}) {
1798 next if $S{ok}{$url}{dltime} == 0; # div by zero
1799 push @{$res->{ok}}, [@{$S{ok}{$url}}{qw(n dlsize dltime)},
1800 $S{ok}{$url}{dlsize}/$S{ok}{$url}{dltime},
1804 for my $url (keys %{$S{no}}) {
1805 push @{$res->{no}}, [$S{no}{$url},
1809 my $R = ""; # report
1810 $R .= sprintf "Log starts: %s\n", scalar(localtime $S{start}) || "unknown";
1811 $R .= sprintf "Log ends : %s\n", scalar(localtime $S{end}) || "unknown";
1812 if ($res->{ok} && @{$res->{ok}}) {
1813 $R .= sprintf "\nSuccessful downloads:
1814 N kB secs kB/s url\n";
1816 for (sort { $b->[3] <=> $a->[3] } @{$res->{ok}}) {
1817 $R .= sprintf "%4d %8d %5d %9.1f %s\n", @$_;
1821 if ($res->{no} && @{$res->{no}}) {
1822 $R .= sprintf "\nUnsuccessful downloads:\n";
1824 for (sort { $b->[0] <=> $a->[0] } @{$res->{no}}) {
1825 $R .= sprintf "%4d %s\n", @$_;
1829 $CPAN::Frontend->myprint($R);
1832 #-> sub CPAN::Shell::reload ;
1834 my($self,$command,@arg) = @_;
1836 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1837 if ($command =~ /^cpan$/i) {
1839 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
1844 "CPAN/FirstTime.pm",
1845 "CPAN/HandleConfig.pm",
1852 MFILE: for my $f (@relo) {
1853 next unless exists $INC{$f};
1857 $CPAN::Frontend->myprint("($p");
1858 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
1859 $self->_reload_this($f) or $failed++;
1860 my $v = eval "$p\::->VERSION";
1861 $CPAN::Frontend->myprint("v$v)");
1863 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1865 my $errors = $failed == 1 ? "error" : "errors";
1866 $CPAN::Frontend->mywarn("\n$failed $errors during reload. You better quit ".
1869 } elsif ($command =~ /^index$/i) {
1870 CPAN::Index->force_reload;
1872 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN modules
1873 index re-reads the index files\n});
1877 # reload means only load again what we have loaded before
1878 #-> sub CPAN::Shell::_reload_this ;
1880 my($self,$f,$args) = @_;
1881 CPAN->debug("f[$f]") if $CPAN::DEBUG;
1882 return 1 unless $INC{$f}; # we never loaded this, so we do not
1884 my $pwd = CPAN::anycwd();
1885 CPAN->debug("pwd[$pwd]") if $CPAN::DEBUG;
1887 for my $inc (@INC) {
1888 $file = File::Spec->catfile($inc,split /\//, $f);
1892 CPAN->debug("file[$file]") if $CPAN::DEBUG;
1894 unless ($file && -f $file) {
1895 # this thingie is not in the INC path, maybe CPAN/MyConfig.pm?
1897 unless (CPAN->has_inst("File::Basename")) {
1898 @inc = File::Basename::dirname($file);
1900 # do we ever need this?
1901 @inc = substr($file,0,-length($f)-1); # bring in back to me!
1904 CPAN->debug("file[$file]inc[@inc]") if $CPAN::DEBUG;
1906 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
1909 my $mtime = (stat $file)[9];
1910 $reload->{$f} ||= $^T;
1911 my $must_reload = $mtime > $reload->{$f};
1913 $must_reload ||= $args->{reloforce};
1915 my $fh = FileHandle->new($file) or
1916 $CPAN::Frontend->mydie("Could not open $file: $!");
1919 my $content = <$fh>;
1920 CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128)))
1924 eval "require '$f'";
1929 $reload->{$f} = time;
1931 $CPAN::Frontend->myprint("__unchanged__");
1936 #-> sub CPAN::Shell::mkmyconfig ;
1938 my($self, $cpanpm, %args) = @_;
1939 require CPAN::FirstTime;
1940 my $home = CPAN::HandleConfig::home;
1941 $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
1942 File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
1943 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
1944 CPAN::HandleConfig::require_myconfig_or_config;
1945 $CPAN::Config ||= {};
1950 keep_source_where => undef,
1953 CPAN::FirstTime::init($cpanpm, %args);
1956 #-> sub CPAN::Shell::_binary_extensions ;
1957 sub _binary_extensions {
1958 my($self) = shift @_;
1959 my(@result,$module,%seen,%need,$headerdone);
1960 for $module ($self->expand('Module','/./')) {
1961 my $file = $module->cpan_file;
1962 next if $file eq "N/A";
1963 next if $file =~ /^Contact Author/;
1964 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
1965 next if $dist->isa_perl;
1966 next unless $module->xs_file;
1968 $CPAN::Frontend->myprint(".");
1969 push @result, $module;
1971 # print join " | ", @result;
1972 $CPAN::Frontend->myprint("\n");
1976 #-> sub CPAN::Shell::recompile ;
1978 my($self) = shift @_;
1979 my($module,@module,$cpan_file,%dist);
1980 @module = $self->_binary_extensions();
1981 for $module (@module){ # we force now and compile later, so we
1983 $cpan_file = $module->cpan_file;
1984 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1986 $dist{$cpan_file}++;
1988 for $cpan_file (sort keys %dist) {
1989 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1990 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1992 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1993 # stop a package from recompiling,
1994 # e.g. IO-1.12 when we have perl5.003_10
1998 #-> sub CPAN::Shell::scripts ;
2000 my($self, $arg) = @_;
2001 $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n");
2003 for my $req (qw( HTML::LinkExtor Sort::Versions List::Util )) {
2004 unless ($CPAN::META->has_inst($req)) {
2005 $CPAN::Frontend->mywarn(" $req not available\n");
2008 my $p = HTML::LinkExtor->new();
2009 my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html";
2010 unless (-f $indexfile) {
2011 $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n");
2013 $p->parse_file($indexfile);
2016 if ($arg =~ s|^/(.+)/$|$1|) {
2017 $qrarg = eval 'qr/$arg/'; # hide construct from 5.004
2019 for my $l ($p->links) {
2020 my $tag = shift @$l;
2021 next unless $tag eq "a";
2023 my $href = $att{href};
2024 next unless $href =~ s|^\.\./authors/id/./../||;
2027 if ($href =~ $qrarg) {
2031 if ($href =~ /\Q$arg\E/) {
2039 # now filter for the latest version if there is more than one of a name
2045 $stems{$stem} ||= [];
2046 push @{$stems{$stem}}, $href;
2048 for (sort keys %stems) {
2050 if (@{$stems{$_}} > 1) {
2051 $highest = List::Util::reduce {
2052 Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b
2055 $highest = $stems{$_}[0];
2057 $CPAN::Frontend->myprint("$highest\n");
2061 #-> sub CPAN::Shell::report ;
2063 my($self,@args) = @_;
2064 unless ($CPAN::META->has_inst("CPAN::Reporter")) {
2065 $CPAN::Frontend->mydie("CPAN::Reporter not installed; cannot continue");
2067 local $CPAN::Config->{test_report} = 1;
2068 $self->force("test",@args); # force is there so that the test be
2069 # re-run (as documented)
2072 #-> sub CPAN::Shell::install_tested
2073 sub install_tested {
2074 my($self,@some) = @_;
2075 $CPAN::Frontend->mywarn("install_tested() requires no arguments.\n"),
2077 CPAN::Index->reload;
2079 for my $d (%{$CPAN::META->{readwrite}{'CPAN::Distribution'}}) {
2080 my $do = CPAN::Shell->expandany($d);
2081 next unless $do->{build_dir};
2085 $CPAN::Frontend->mywarn("No tested distributions found.\n"),
2086 return unless @some;
2088 @some = grep { $_->{make_test} && ! $_->{make_test}->failed } @some;
2089 $CPAN::Frontend->mywarn("No distributions tested with this build of perl found.\n"),
2090 return unless @some;
2092 @some = grep { not $_->uptodate } @some;
2093 $CPAN::Frontend->mywarn("No non-uptodate distributions tested with this build of perl found.\n"),
2094 return unless @some;
2096 CPAN->debug("some[@some]");
2098 my $id = $d->can("pretty_id") ? $d->pretty_id : $d->id;
2099 $CPAN::Frontend->myprint("install_tested: Running for $id\n");
2100 $CPAN::Frontend->sleep(1);
2105 #-> sub CPAN::Shell::upgrade ;
2107 my($self,@args) = @_;
2108 $self->install($self->r(@args));
2111 #-> sub CPAN::Shell::_u_r_common ;
2113 my($self) = shift @_;
2114 my($what) = shift @_;
2115 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
2116 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
2117 $what && $what =~ /^[aru]$/;
2119 @args = '/./' unless @args;
2120 my(@result,$module,%seen,%need,$headerdone,
2121 $version_undefs,$version_zeroes);
2122 $version_undefs = $version_zeroes = 0;
2123 my $sprintf = "%s%-25s%s %9s %9s %s\n";
2124 my @expand = $self->expand('Module',@args);
2125 my $expand = scalar @expand;
2126 if (0) { # Looks like noise to me, was very useful for debugging
2127 # for metadata cache
2128 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
2130 MODULE: for $module (@expand) {
2131 my $file = $module->cpan_file;
2132 next MODULE unless defined $file; # ??
2133 $file =~ s|^./../||;
2134 my($latest) = $module->cpan_version;
2135 my($inst_file) = $module->inst_file;
2137 return if $CPAN::Signal;
2140 $have = $module->inst_version;
2141 } elsif ($what eq "r") {
2142 $have = $module->inst_version;
2144 if ($have eq "undef"){
2146 } elsif ($have == 0){
2149 next MODULE unless CPAN::Version->vgt($latest, $have);
2150 # to be pedantic we should probably say:
2151 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
2152 # to catch the case where CPAN has a version 0 and we have a version undef
2153 } elsif ($what eq "u") {
2159 } elsif ($what eq "r") {
2161 } elsif ($what eq "u") {
2165 return if $CPAN::Signal; # this is sometimes lengthy
2168 push @result, sprintf "%s %s\n", $module->id, $have;
2169 } elsif ($what eq "r") {
2170 push @result, $module->id;
2171 next MODULE if $seen{$file}++;
2172 } elsif ($what eq "u") {
2173 push @result, $module->id;
2174 next MODULE if $seen{$file}++;
2175 next MODULE if $file =~ /^Contact/;
2177 unless ($headerdone++){
2178 $CPAN::Frontend->myprint("\n");
2179 $CPAN::Frontend->myprint(sprintf(
2182 "Package namespace",
2194 $CPAN::META->has_inst("Term::ANSIColor")
2196 $module->description
2198 $color_on = Term::ANSIColor::color("green");
2199 $color_off = Term::ANSIColor::color("reset");
2201 $CPAN::Frontend->myprint(sprintf $sprintf,
2208 $need{$module->id}++;
2212 $CPAN::Frontend->myprint("No modules found for @args\n");
2213 } elsif ($what eq "r") {
2214 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
2218 if ($version_zeroes) {
2219 my $s_has = $version_zeroes > 1 ? "s have" : " has";
2220 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
2221 qq{a version number of 0\n});
2223 if ($version_undefs) {
2224 my $s_has = $version_undefs > 1 ? "s have" : " has";
2225 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
2226 qq{parseable version number\n});
2232 #-> sub CPAN::Shell::r ;
2234 shift->_u_r_common("r",@_);
2237 #-> sub CPAN::Shell::u ;
2239 shift->_u_r_common("u",@_);
2242 #-> sub CPAN::Shell::failed ;
2244 my($self,$only_id,$silent) = @_;
2246 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
2248 NAY: for my $nosayer ( # order matters!
2257 next unless exists $d->{$nosayer};
2258 next unless defined $d->{$nosayer};
2260 UNIVERSAL::can($d->{$nosayer},"failed") ?
2261 $d->{$nosayer}->failed :
2262 $d->{$nosayer} =~ /^NO/
2264 next NAY if $only_id && $only_id != (
2265 UNIVERSAL::can($d->{$nosayer},"commandid")
2267 $d->{$nosayer}->commandid
2269 $CPAN::CurrentCommandId
2274 next DIST unless $failed;
2278 # " %-45s: %s %s\n",
2281 UNIVERSAL::can($d->{$failed},"failed") ?
2283 $d->{$failed}->commandid,
2286 $d->{$failed}->text,
2287 $d->{$failed}{TIME}||0,
2300 $scope = "this command";
2301 } elsif ($CPAN::Index::HAVE_REANIMATED) {
2302 $scope = "this or a previous session";
2303 # it might be nice to have a section for previous session and
2306 $scope = "this session";
2313 map { sprintf "%5d %-45s: %s %s\n", @$_ }
2314 sort { $a->[0] <=> $b->[0] } @failed;
2317 map { sprintf " %-45s: %s %s\n", @$_[1..3] }
2324 $CPAN::Frontend->myprint("Failed during $scope:\n$print");
2325 } elsif (!$only_id || !$silent) {
2326 $CPAN::Frontend->myprint("Nothing failed in $scope\n");
2330 # XXX intentionally undocumented because completely bogus, unportable,
2333 #-> sub CPAN::Shell::status ;
2336 require Devel::Size;
2337 my $ps = FileHandle->new;
2338 open $ps, "/proc/$$/status";
2341 next unless /VmSize:\s+(\d+)/;
2345 $CPAN::Frontend->mywarn(sprintf(
2346 "%-27s %6d\n%-27s %6d\n",
2350 Devel::Size::total_size($CPAN::META)/1024,
2352 for my $k (sort keys %$CPAN::META) {
2353 next unless substr($k,0,4) eq "read";
2354 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
2355 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
2356 warn sprintf " %-25s %6d (keys: %6d)\n",
2358 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
2359 scalar keys %{$CPAN::META->{$k}{$k2}};
2364 #-> sub CPAN::Shell::autobundle ;
2367 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
2368 my(@bundle) = $self->_u_r_common("a",@_);
2369 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2370 File::Path::mkpath($todir);
2371 unless (-d $todir) {
2372 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
2375 my($y,$m,$d) = (localtime)[5,4,3];
2379 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
2380 my($to) = File::Spec->catfile($todir,"$me.pm");
2382 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
2383 $to = File::Spec->catfile($todir,"$me.pm");
2385 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
2387 "package Bundle::$me;\n\n",
2388 "\$VERSION = '0.01';\n\n",
2392 "Bundle::$me - Snapshot of installation on ",
2393 $Config::Config{'myhostname'},
2396 "\n\n=head1 SYNOPSIS\n\n",
2397 "perl -MCPAN -e 'install Bundle::$me'\n\n",
2398 "=head1 CONTENTS\n\n",
2399 join("\n", @bundle),
2400 "\n\n=head1 CONFIGURATION\n\n",
2402 "\n\n=head1 AUTHOR\n\n",
2403 "This Bundle has been generated automatically ",
2404 "by the autobundle routine in CPAN.pm.\n",
2407 $CPAN::Frontend->myprint("\nWrote bundle file
2411 #-> sub CPAN::Shell::expandany ;
2414 CPAN->debug("s[$s]") if $CPAN::DEBUG;
2415 if ($s =~ m|/| or substr($s,-1,1) eq ".") { # looks like a file or a directory
2416 $s = CPAN::Distribution->normalize($s);
2417 return $CPAN::META->instance('CPAN::Distribution',$s);
2418 # Distributions spring into existence, not expand
2419 } elsif ($s =~ m|^Bundle::|) {
2420 $self->local_bundles; # scanning so late for bundles seems
2421 # both attractive and crumpy: always
2422 # current state but easy to forget
2424 return $self->expand('Bundle',$s);
2426 return $self->expand('Module',$s)
2427 if $CPAN::META->exists('CPAN::Module',$s);
2432 #-> sub CPAN::Shell::expand ;
2435 my($type,@args) = @_;
2436 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
2437 my $class = "CPAN::$type";
2438 my $methods = ['id'];
2439 for my $meth (qw(name)) {
2440 next unless $class->can($meth);
2441 push @$methods, $meth;
2443 $self->expand_by_method($class,$methods,@args);
2446 #-> sub CPAN::Shell::expand_by_method ;
2447 sub expand_by_method {
2449 my($class,$methods,@args) = @_;
2452 my($regex,$command);
2453 if ($arg =~ m|^/(.*)/$|) {
2455 } elsif ($arg =~ m/=/) {
2459 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
2461 defined $regex ? $regex : "UNDEFINED",
2462 defined $command ? $command : "UNDEFINED",
2464 if (defined $regex) {
2465 if (CPAN::_sqlite_running) {
2466 $CPAN::SQLite->search($class, $regex);
2469 $CPAN::META->all_objects($class)
2472 # BUG, we got an empty object somewhere
2473 require Data::Dumper;
2474 CPAN->debug(sprintf(
2475 "Bug in CPAN: Empty id on obj[%s][%s]",
2477 Data::Dumper::Dumper($obj)
2481 for my $method (@$methods) {
2482 my $match = eval {$obj->$method() =~ /$regex/i};
2484 my($err) = $@ =~ /^(.+) at .+? line \d+\.$/;
2485 $err ||= $@; # if we were too restrictive above
2486 $CPAN::Frontend->mydie("$err\n");
2493 } elsif ($command) {
2494 die "equal sign in command disabled (immature interface), ".
2496 ! \$CPAN::Shell::ADVANCED_QUERY=1
2497 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
2498 that may go away anytime.\n"
2499 unless $ADVANCED_QUERY;
2500 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
2501 my($matchcrit) = $criterion =~ m/^~(.+)/;
2505 $CPAN::META->all_objects($class)
2507 my $lhs = $self->$method() or next; # () for 5.00503
2509 push @m, $self if $lhs =~ m/$matchcrit/;
2511 push @m, $self if $lhs eq $criterion;
2516 if ( $class eq 'CPAN::Bundle' ) {
2517 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
2518 } elsif ($class eq "CPAN::Distribution") {
2519 $xarg = CPAN::Distribution->normalize($arg);
2523 if ($CPAN::META->exists($class,$xarg)) {
2524 $obj = $CPAN::META->instance($class,$xarg);
2525 } elsif ($CPAN::META->exists($class,$arg)) {
2526 $obj = $CPAN::META->instance($class,$arg);
2533 @m = sort {$a->id cmp $b->id} @m;
2534 if ( $CPAN::DEBUG ) {
2535 my $wantarray = wantarray;
2536 my $join_m = join ",", map {$_->id} @m;
2537 $self->debug("wantarray[$wantarray]join_m[$join_m]");
2539 return wantarray ? @m : $m[0];
2542 #-> sub CPAN::Shell::format_result ;
2545 my($type,@args) = @_;
2546 @args = '/./' unless @args;
2547 my(@result) = $self->expand($type,@args);
2548 my $result = @result == 1 ?
2549 $result[0]->as_string :
2551 "No objects of type $type found for argument @args\n" :
2553 (map {$_->as_glimpse} @result),
2554 scalar @result, " items found\n",
2559 #-> sub CPAN::Shell::report_fh ;
2561 my $installation_report_fh;
2562 my $previously_noticed = 0;
2565 return $installation_report_fh if $installation_report_fh;
2566 if ($CPAN::META->has_inst("File::Temp")) {
2567 $installation_report_fh
2569 template => 'cpan_install_XXXX',
2574 unless ( $installation_report_fh ) {
2575 warn("Couldn't open installation report file; " .
2576 "no report file will be generated."
2577 ) unless $previously_noticed++;
2583 # The only reason for this method is currently to have a reliable
2584 # debugging utility that reveals which output is going through which
2585 # channel. No, I don't like the colors ;-)
2587 # to turn colordebugging on, write
2588 # cpan> o conf colorize_output 1
2590 #-> sub CPAN::Shell::print_ornamented ;
2592 my $print_ornamented_have_warned = 0;
2593 sub colorize_output {
2594 my $colorize_output = $CPAN::Config->{colorize_output};
2595 if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) {
2596 unless ($print_ornamented_have_warned++) {
2597 # no myprint/mywarn within myprint/mywarn!
2598 warn "Colorize_output is set to true but Term::ANSIColor is not
2599 installed. To activate colorized output, please install Term::ANSIColor.\n\n";
2601 $colorize_output = 0;
2603 return $colorize_output;
2608 #-> sub CPAN::Shell::print_ornamented ;
2609 sub print_ornamented {
2610 my($self,$what,$ornament) = @_;
2611 return unless defined $what;
2613 local $| = 1; # Flush immediately
2614 if ( $CPAN::Be_Silent ) {
2615 print {report_fh()} $what;
2618 my $swhat = "$what"; # stringify if it is an object
2619 if ($CPAN::Config->{term_is_latin}){
2622 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
2624 if ($self->colorize_output) {
2625 if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) {
2626 # if you want to have this configurable, please file a bugreport
2627 $ornament = "black on_cyan";
2629 my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
2631 print "Term::ANSIColor rejects color[$ornament]: $@\n
2632 Please choose a different color (Hint: try 'o conf init color.*')\n";
2636 Term::ANSIColor::color("reset");
2642 #-> sub CPAN::Shell::myprint ;
2644 # where is myprint/mywarn/Frontend/etc. documented? We need guidelines
2645 # where to use what! I think, we send everything to STDOUT and use
2646 # print for normal/good news and warn for news that need more
2647 # attention. Yes, this is our working contract for now.
2649 my($self,$what) = @_;
2651 $self->print_ornamented($what, $CPAN::Config->{colorize_print}||'bold blue on_white');
2654 #-> sub CPAN::Shell::myexit ;
2656 my($self,$what) = @_;
2657 $self->myprint($what);
2661 #-> sub CPAN::Shell::mywarn ;
2663 my($self,$what) = @_;
2664 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2667 # only to be used for shell commands
2668 #-> sub CPAN::Shell::mydie ;
2670 my($self,$what) = @_;
2671 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2673 # If it is the shell, we want that the following die to be silent,
2674 # but if it is not the shell, we would need a 'die $what'. We need
2675 # to take care that only shell commands use mydie. Is this
2681 # sub CPAN::Shell::colorable_makemaker_prompt ;
2682 sub colorable_makemaker_prompt {
2684 if (CPAN::Shell->colorize_output) {
2685 my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white';
2686 my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
2689 my $ans = ExtUtils::MakeMaker::prompt($foo,$bar);
2690 if (CPAN::Shell->colorize_output) {
2691 print Term::ANSIColor::color('reset');
2696 # use this only for unrecoverable errors!
2697 #-> sub CPAN::Shell::unrecoverable_error ;
2698 sub unrecoverable_error {
2699 my($self,$what) = @_;
2700 my @lines = split /\n/, $what;
2702 for my $l (@lines) {
2703 $longest = length $l if length $l > $longest;
2705 $longest = 62 if $longest > 62;
2706 for my $l (@lines) {
2712 if (length $l < 66) {
2713 $l = pack "A66 A*", $l, "<==";
2717 unshift @lines, "\n";
2718 $self->mydie(join "", @lines);
2721 #-> sub CPAN::Shell::mysleep ;
2723 my($self, $sleep) = @_;
2727 #-> sub CPAN::Shell::setup_output ;
2729 return if -t STDOUT;
2730 my $odef = select STDERR;
2737 #-> sub CPAN::Shell::rematein ;
2738 # RE-adme||MA-ke||TE-st||IN-stall : nearly everything runs through here
2741 my($meth,@some) = @_;
2743 while($meth =~ /^(force|notest)$/) {
2744 push @pragma, $meth;
2745 $meth = shift @some or
2746 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
2750 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
2752 # Here is the place to set "test_count" on all involved parties to
2753 # 0. We then can pass this counter on to the involved
2754 # distributions and those can refuse to test if test_count > X. In
2755 # the first stab at it we could use a 1 for "X".
2757 # But when do I reset the distributions to start with 0 again?
2758 # Jost suggested to have a random or cycling interaction ID that
2759 # we pass through. But the ID is something that is just left lying
2760 # around in addition to the counter, so I'd prefer to set the
2761 # counter to 0 now, and repeat at the end of the loop. But what
2762 # about dependencies? They appear later and are not reset, they
2763 # enter the queue but not its copy. How do they get a sensible
2766 # construct the queue
2768 STHING: foreach $s (@some) {
2771 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
2773 } elsif ($s =~ m|[\$\@\%]|) { # looks like a perl variable
2774 } elsif ($s =~ m|^/|) { # looks like a regexp
2775 if (substr($s,-1,1) eq ".") {
2776 $obj = CPAN::Shell->expandany($s);
2778 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
2779 "not supported.\nRejecting argument '$s'\n");
2780 $CPAN::Frontend->mysleep(2);
2783 } elsif ($meth eq "ls") {
2784 $self->globls($s,\@pragma);
2787 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
2788 $obj = CPAN::Shell->expandany($s);
2791 } elsif (ref $obj) {
2792 $obj->color_cmd_tmps(0,1);
2793 CPAN::Queue->new(qmod => $obj->id, reqtype => "c");
2795 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
2796 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
2797 if ($meth =~ /^(dump|ls)$/) {
2800 $CPAN::Frontend->mywarn(
2802 "Don't be silly, you can't $meth ",
2806 $CPAN::Frontend->mysleep(2);
2808 } elsif ($s =~ m|[\$\@\%]| && $meth eq "dump") {
2809 CPAN::InfoObj->dump($s);
2812 ->mywarn(qq{Warning: Cannot $meth $s, }.
2813 qq{don't know what it is.
2818 to find objects with matching identifiers.
2820 $CPAN::Frontend->mysleep(2);
2824 # queuerunner (please be warned: when I started to change the
2825 # queue to hold objects instead of names, I made one or two
2826 # mistakes and never found which. I reverted back instead)
2827 while (my $q = CPAN::Queue->first) {
2829 my $s = $q->as_string;
2830 my $reqtype = $q->reqtype || "";
2831 $obj = CPAN::Shell->expandany($s);
2832 $obj->{reqtype} ||= "";
2834 # force debugging because CPAN::SQLite somehow delivers us
2837 # local $CPAN::DEBUG = 1024; # Shell; probably fixed now
2839 CPAN->debug("s[$s]obj-reqtype[$obj->{reqtype}]".
2840 "q-reqtype[$reqtype]") if $CPAN::DEBUG;
2842 if ($obj->{reqtype}) {
2843 if ($obj->{reqtype} eq "b" && $reqtype =~ /^[rc]$/) {
2844 $obj->{reqtype} = $reqtype;
2846 exists $obj->{install}
2849 UNIVERSAL::can($obj->{install},"failed") ?
2850 $obj->{install}->failed :
2851 $obj->{install} =~ /^NO/
2854 delete $obj->{install};
2855 $CPAN::Frontend->mywarn
2856 ("Promoting $obj->{ID} from 'build_requires' to 'requires'");
2860 $obj->{reqtype} = $reqtype;
2863 for my $pragma (@pragma) {
2866 $obj->can($pragma)){
2867 $obj->$pragma($meth);
2870 if (UNIVERSAL::can($obj, 'called_for')) {
2871 $obj->called_for($s);
2873 CPAN->debug(qq{pragma[@pragma]meth[$meth]}.
2874 qq{ID[$obj->{ID}]}) if $CPAN::DEBUG;
2877 if (! UNIVERSAL::can($obj,$meth)) {
2879 my $serialized = "";
2881 } elsif ($CPAN::META->has_inst("YAML::Syck")) {
2882 $serialized = YAML::Syck::Dump($obj);
2883 } elsif ($CPAN::META->has_inst("YAML")) {
2884 $serialized = YAML::Dump($obj);
2885 } elsif ($CPAN::META->has_inst("Data::Dumper")) {
2886 $serialized = Data::Dumper::Dumper($obj);
2889 $serialized = overload::StrVal($obj);
2891 $CPAN::Frontend->mydie("Panic: obj[$serialized] cannot meth[$meth]");
2892 } elsif ($obj->$meth()){
2893 CPAN::Queue->delete($s);
2895 CPAN->debug("failed");
2899 for my $pragma (@pragma) {
2900 my $unpragma = "un$pragma";
2901 if ($obj->can($unpragma)) {
2905 CPAN::Queue->delete_first($s);
2907 for my $obj (@qcopy) {
2908 $obj->color_cmd_tmps(0,0);
2912 #-> sub CPAN::Shell::recent ;
2916 CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
2921 # set up the dispatching methods
2923 for my $command (qw(
2938 *$command = sub { shift->rematein($command, @_); };
2942 package CPAN::LWP::UserAgent;
2946 return if $SETUPDONE;
2947 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2948 require LWP::UserAgent;
2949 @ISA = qw(Exporter LWP::UserAgent);
2952 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
2956 sub get_basic_credentials {
2957 my($self, $realm, $uri, $proxy) = @_;
2958 if ($USER && $PASSWD) {
2959 return ($USER, $PASSWD);
2962 ($USER,$PASSWD) = $self->get_proxy_credentials();
2964 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
2966 return($USER,$PASSWD);
2969 sub get_proxy_credentials {
2971 my ($user, $password);
2972 if ( defined $CPAN::Config->{proxy_user} &&
2973 defined $CPAN::Config->{proxy_pass}) {
2974 $user = $CPAN::Config->{proxy_user};
2975 $password = $CPAN::Config->{proxy_pass};
2976 return ($user, $password);
2978 my $username_prompt = "\nProxy authentication needed!
2979 (Note: to permanently configure username and password run
2980 o conf proxy_user your_username
2981 o conf proxy_pass your_password
2983 ($user, $password) =
2984 _get_username_and_password_from_user($username_prompt);
2985 return ($user,$password);
2988 sub get_non_proxy_credentials {
2990 my ($user,$password);
2991 if ( defined $CPAN::Config->{username} &&
2992 defined $CPAN::Config->{password}) {
2993 $user = $CPAN::Config->{username};
2994 $password = $CPAN::Config->{password};
2995 return ($user, $password);
2997 my $username_prompt = "\nAuthentication needed!
2998 (Note: to permanently configure username and password run
2999 o conf username your_username
3000 o conf password your_password
3003 ($user, $password) =
3004 _get_username_and_password_from_user($username_prompt);
3005 return ($user,$password);
3008 sub _get_username_and_password_from_user {
3009 my $username_message = shift;
3010 my ($username,$password);
3012 ExtUtils::MakeMaker->import(qw(prompt));
3013 $username = prompt($username_message);
3014 if ($CPAN::META->has_inst("Term::ReadKey")) {
3015 Term::ReadKey::ReadMode("noecho");
3018 $CPAN::Frontend->mywarn(
3019 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
3022 $password = prompt("Password:");
3024 if ($CPAN::META->has_inst("Term::ReadKey")) {
3025 Term::ReadKey::ReadMode("restore");
3027 $CPAN::Frontend->myprint("\n\n");
3028 return ($username,$password);
3031 # mirror(): Its purpose is to deal with proxy authentication. When we
3032 # call SUPER::mirror, we relly call the mirror method in
3033 # LWP::UserAgent. LWP::UserAgent will then call
3034 # $self->get_basic_credentials or some equivalent and this will be
3035 # $self->dispatched to our own get_basic_credentials method.
3037 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
3039 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
3040 # although we have gone through our get_basic_credentials, the proxy
3041 # server refuses to connect. This could be a case where the username or
3042 # password has changed in the meantime, so I'm trying once again without
3043 # $USER and $PASSWD to give the get_basic_credentials routine another
3044 # chance to set $USER and $PASSWD.
3046 # mirror(): Its purpose is to deal with proxy authentication. When we
3047 # call SUPER::mirror, we relly call the mirror method in
3048 # LWP::UserAgent. LWP::UserAgent will then call
3049 # $self->get_basic_credentials or some equivalent and this will be
3050 # $self->dispatched to our own get_basic_credentials method.
3052 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
3054 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
3055 # although we have gone through our get_basic_credentials, the proxy
3056 # server refuses to connect. This could be a case where the username or
3057 # password has changed in the meantime, so I'm trying once again without
3058 # $USER and $PASSWD to give the get_basic_credentials routine another
3059 # chance to set $USER and $PASSWD.
3062 my($self,$url,$aslocal) = @_;
3063 my $result = $self->SUPER::mirror($url,$aslocal);
3064 if ($result->code == 407) {
3067 $result = $self->SUPER::mirror($url,$aslocal);
3075 #-> sub CPAN::FTP::ftp_statistics
3076 # if they want to rewrite, they need to pass in a filehandle
3077 sub _ftp_statistics {
3079 my $locktype = $fh ? LOCK_EX : LOCK_SH;
3080 $fh ||= FileHandle->new;
3081 my $file = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
3082 open $fh, "+>>$file" or $CPAN::Frontend->mydie("Could not open '$file': $!");
3085 while (!flock $fh, $locktype|LOCK_NB) {
3086 $waitstart ||= localtime();
3088 $CPAN::Frontend->mywarn("Waiting for a read lock on '$file' (since $waitstart)\n");
3090 $CPAN::Frontend->mysleep($sleep);
3093 } elsif ($sleep <=6) {
3097 my $stats = CPAN->_yaml_loadfile($file);
3101 #-> sub CPAN::FTP::_mytime
3103 if (CPAN->has_inst("Time::HiRes")) {
3104 return Time::HiRes::time();
3110 #-> sub CPAN::FTP::_new_stats
3112 my($self,$file) = @_;
3121 #-> sub CPAN::FTP::_add_to_statistics
3122 sub _add_to_statistics {
3123 my($self,$stats) = @_;
3124 my $yaml_module = $self->CPAN::_yaml_module;
3125 if ($CPAN::META->has_inst($yaml_module)) {
3126 $stats->{thesiteurl} = $ThesiteURL;
3127 if (CPAN->has_inst("Time::HiRes")) {
3128 $stats->{end} = Time::HiRes::time();
3130 $stats->{end} = time;
3132 my $fh = FileHandle->new;
3133 my $fullstats = $self->_ftp_statistics($fh);
3134 $fullstats->{history} ||= [];
3135 my @debug = scalar @{$fullstats->{history}};
3136 push @{$fullstats->{history}}, $stats;
3138 shift @{$fullstats->{history}}
3139 while $time - $fullstats->{history}[0]{start} > 30*86400; # one month too much?
3140 push @debug, scalar @{$fullstats->{history}};
3141 push @debug, scalar localtime($fullstats->{history}[0]{start});
3143 # local $CPAN::DEBUG = 512;
3144 CPAN->debug(sprintf("DEBUG history: before[%d]after[%d]oldest[%s]",
3150 CPAN->_yaml_dumpfile($fh,$fullstats);
3154 # if file is CHECKSUMS, suggest the place where we got the file to be
3155 # checked from, maybe only for young files?
3156 #-> sub CPAN::FTP::_recommend_url_for
3157 sub _recommend_url_for {
3158 my($self, $file) = @_;
3159 my $urllist = $self->_get_urllist;
3160 if ($file =~ s|/CHECKSUMS(.gz)?$||) {
3161 my $fullstats = $self->_ftp_statistics();
3162 my $history = $fullstats->{history} || [];
3163 while (my $last = pop @$history) {
3164 last if $last->{end} - time > 3600; # only young results are interesting
3165 next unless $last->{file}; # dirname of nothing dies!
3166 next unless $file eq File::Basename::dirname($last->{file});
3167 return $last->{thesiteurl};
3170 if ($CPAN::Config->{randomize_urllist}
3172 rand(1) < $CPAN::Config->{randomize_urllist}
3174 $urllist->[int rand scalar @$urllist];
3180 #-> sub CPAN::FTP::_get_urllist
3183 $CPAN::Config->{urllist} ||= [];
3184 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
3185 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
3186 $CPAN::Config->{urllist} = [];
3188 my @urllist = grep { defined $_ and length $_ } @{$CPAN::Config->{urllist}};
3189 for my $u (@urllist) {
3190 CPAN->debug("u[$u]") if $CPAN::DEBUG;
3191 if (UNIVERSAL::can($u,"text")) {
3192 $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
3194 $u .= "/" unless substr($u,-1) eq "/";
3195 $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
3201 #-> sub CPAN::FTP::ftp_get ;
3203 my($class,$host,$dir,$file,$target) = @_;
3205 qq[Going to fetch file [$file] from dir [$dir]
3206 on host [$host] as local [$target]\n]
3208 my $ftp = Net::FTP->new($host);
3210 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
3213 return 0 unless defined $ftp;
3214 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
3215 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
3216 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
3217 my $msg = $ftp->message;
3218 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
3221 unless ( $ftp->cwd($dir) ){
3222 my $msg = $ftp->message;
3223 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
3227 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
3228 unless ( $ftp->get($file,$target) ){
3229 my $msg = $ftp->message;
3230 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
3233 $ftp->quit; # it's ok if this fails
3237 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
3239 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
3240 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
3242 # > *** 1562,1567 ****
3243 # > --- 1562,1580 ----
3244 # > return 1 if substr($url,0,4) eq "file";
3245 # > return 1 unless $url =~ m|://([^/]+)|;
3247 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
3249 # > + $proxy =~ m|://([^/:]+)|;
3251 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
3252 # > + if ($noproxy) {
3253 # > + if ($host !~ /$noproxy$/) {
3254 # > + $host = $proxy;
3257 # > + $host = $proxy;
3260 # > require Net::Ping;
3261 # > return 1 unless $Net::Ping::VERSION >= 2;
3265 #-> sub CPAN::FTP::localize ;
3267 my($self,$file,$aslocal,$force) = @_;
3269 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
3270 unless defined $aslocal;
3271 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
3274 if ($^O eq 'MacOS') {
3275 # Comment by AK on 2000-09-03: Uniq short filenames would be
3276 # available in CHECKSUMS file
3277 my($name, $path) = File::Basename::fileparse($aslocal, '');
3278 if (length($name) > 31) {
3289 my $size = 31 - length($suf);
3290 while (length($name) > $size) {
3294 $aslocal = File::Spec->catfile($path, $name);
3298 if (-f $aslocal && -r _ && !($force & 1)){
3300 if ($size = -s $aslocal) {
3301 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
3304 # empty file from a previous unsuccessful attempt to download it
3306 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
3307 "could not remove.");
3310 my($maybe_restore) = 0;
3312 rename $aslocal, "$aslocal.bak$$";
3316 my($aslocal_dir) = File::Basename::dirname($aslocal);
3317 File::Path::mkpath($aslocal_dir);
3318 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
3319 qq{directory "$aslocal_dir".
3320 I\'ll continue, but if you encounter problems, they may be due
3321 to insufficient permissions.\n}) unless -w $aslocal_dir;
3323 # Inheritance is not easier to manage than a few if/else branches
3324 if ($CPAN::META->has_usable('LWP::UserAgent')) {
3326 CPAN::LWP::UserAgent->config;
3327 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
3329 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
3333 $Ua->proxy('ftp', $var)
3334 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
3335 $Ua->proxy('http', $var)
3336 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
3339 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
3341 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
3342 # > use ones that require basic autorization.
3344 # > Example of when I use it manually in my own stuff:
3346 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
3347 # > $req->proxy_authorization_basic("username","password");
3348 # > $res = $ua->request($req);
3352 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
3356 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
3357 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
3360 # Try the list of urls for each single object. We keep a record
3361 # where we did get a file from
3362 my(@reordered,$last);
3363 my $ccurllist = $self->_get_urllist;
3364 $last = $#$ccurllist;
3365 if ($force & 2) { # local cpans probably out of date, don't reorder
3366 @reordered = (0..$last);
3370 (substr($ccurllist->[$b],0,4) eq "file")
3372 (substr($ccurllist->[$a],0,4) eq "file")
3374 defined($ThesiteURL)
3376 ($ccurllist->[$b] eq $ThesiteURL)
3378 ($ccurllist->[$a] eq $ThesiteURL)
3383 $self->debug("Themethod[$Themethod]reordered[@reordered]") if $CPAN::DEBUG;
3385 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
3387 @levels = qw/easy hard hardest/;
3389 @levels = qw/easy/ if $^O eq 'MacOS';
3391 local $ENV{FTP_PASSIVE} =
3392 exists $CPAN::Config->{ftp_passive} ?
3393 $CPAN::Config->{ftp_passive} : 1;
3395 my $stats = $self->_new_stats($file);
3396 LEVEL: for $levelno (0..$#levels) {
3397 my $level = $levels[$levelno];
3398 my $method = "host$level";
3399 my @host_seq = $level eq "easy" ?
3400 @reordered : 0..$last; # reordered has CDROM up front
3401 my @urllist = map { $ccurllist->[$_] } @host_seq;
3402 for my $u (@CPAN::Defaultsites) {
3403 push @urllist, $u unless grep { $_ eq $u } @urllist;
3405 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
3406 my $aslocal_tempfile = $aslocal . ".tmp" . $$;
3407 if (my $recommend = $self->_recommend_url_for($file)) {
3408 @urllist = grep { $_ ne $recommend } @urllist;
3409 unshift @urllist, $recommend;
3411 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
3412 $ret = $self->$method(\@urllist,$file,$aslocal_tempfile,$stats);
3414 CPAN->debug("ret[$ret]aslocal[$aslocal]") if $CPAN::DEBUG;
3415 if ($ret eq $aslocal_tempfile) {
3416 # if we got it exactly as we asked for, only then we
3418 rename $aslocal_tempfile, $aslocal
3419 or $CPAN::Frontend->mydie("Error while trying to rename ".
3420 "'$ret' to '$aslocal': $!");
3423 $Themethod = $level;
3425 # utime $now, $now, $aslocal; # too bad, if we do that, we
3426 # might alter a local mirror
3427 $self->debug("level[$level]") if $CPAN::DEBUG;
3430 unlink $aslocal_tempfile;
3431 last if $CPAN::Signal; # need to cleanup
3435 $stats->{filesize} = -s $ret;
3437 $self->_add_to_statistics($stats);
3439 unlink "$aslocal.bak$$";
3442 unless ($CPAN::Signal) {
3445 if (@{$CPAN::Config->{urllist}}) {
3447 qq{Please check, if the URLs I found in your configuration file \(}.
3448 join(", ", @{$CPAN::Config->{urllist}}).
3451 push @mess, qq{Your urllist is empty!};
3453 push @mess, qq{The urllist can be edited.},
3454 qq{E.g. with 'o conf urllist push ftp://myurl/'};
3455 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
3456 $CPAN::Frontend->mywarn("Could not fetch $file\n");
3457 $CPAN::Frontend->mysleep(2);
3459 if ($maybe_restore) {
3460 rename "$aslocal.bak$$", $aslocal;
3461 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
3462 $self->ls($aslocal));
3469 my($self,$stats,$method,$url) = @_;
3470 push @{$stats->{attempts}}, {
3477 # package CPAN::FTP;
3479 my($self,$host_seq,$file,$aslocal,$stats) = @_;
3481 HOSTEASY: for $ro_url (@$host_seq) {
3482 $self->_set_attempt($stats,"easy",$ro_url);
3483 my $url .= "$ro_url$file";
3484 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
3485 if ($url =~ /^file:/) {
3487 if ($CPAN::META->has_inst('URI::URL')) {
3488 my $u = URI::URL->new($url);
3490 } else { # works only on Unix, is poorly constructed, but
3491 # hopefully better than nothing.
3492 # RFC 1738 says fileurl BNF is
3493 # fileurl = "file://" [ host | "localhost" ] "/" fpath
3494 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
3496 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
3497 $l =~ s|^file:||; # assume they
3501 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
3503 $self->debug("local file[$l]") if $CPAN::DEBUG;
3504 if ( -f $l && -r _) {
3505 $ThesiteURL = $ro_url;
3508 if ($l =~ /(.+)\.gz$/) {
3510 if ( -f $ungz && -r _) {
3511 $ThesiteURL = $ro_url;
3515 # Maybe mirror has compressed it?
3517 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
3518 eval { CPAN::Tarzip->new("$l.gz")->gunzip($aslocal) };
3520 $ThesiteURL = $ro_url;
3525 $self->debug("it was not a file URL") if $CPAN::DEBUG;
3526 if ($CPAN::META->has_usable('LWP')) {
3527 $CPAN::Frontend->myprint("Fetching with LWP:
3531 CPAN::LWP::UserAgent->config;
3532 eval { $Ua = CPAN::LWP::UserAgent->new; };
3534 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
3537 my $res = $Ua->mirror($url, $aslocal);
3538 if ($res->is_success) {
3539 $ThesiteURL = $ro_url;
3541 utime $now, $now, $aslocal; # download time is more
3542 # important than upload
3545 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3546 my $gzurl = "$url.gz";
3547 $CPAN::Frontend->myprint("Fetching with LWP:
3550 $res = $Ua->mirror($gzurl, "$aslocal.gz");
3551 if ($res->is_success) {
3552 if (eval {CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)}) {
3553 $ThesiteURL = $ro_url;
3558 $CPAN::Frontend->myprint(sprintf(
3559 "LWP failed with code[%s] message[%s]\n",
3563 # Alan Burlison informed me that in firewall environments
3564 # Net::FTP can still succeed where LWP fails. So we do not
3565 # skip Net::FTP anymore when LWP is available.
3568 $CPAN::Frontend->mywarn(" LWP not available\n");
3570 return if $CPAN::Signal;
3571 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3572 # that's the nice and easy way thanks to Graham
3573 $self->debug("recognized ftp") if $CPAN::DEBUG;
3574 my($host,$dir,$getfile) = ($1,$2,$3);
3575 if ($CPAN::META->has_usable('Net::FTP')) {
3577 $CPAN::Frontend->myprint("Fetching with Net::FTP:
3580 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
3581 "aslocal[$aslocal]") if $CPAN::DEBUG;
3582 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
3583 $ThesiteURL = $ro_url;
3586 if ($aslocal !~ /\.gz(?!\n)\Z/) {
3587 my $gz = "$aslocal.gz";
3588 $CPAN::Frontend->myprint("Fetching with Net::FTP
3591 if (CPAN::FTP->ftp_get($host,
3595 eval{CPAN::Tarzip->new($gz)->gunzip($aslocal)}
3597 $ThesiteURL = $ro_url;
3603 CPAN->debug("Net::FTP does not count as usable atm") if $CPAN::DEBUG;
3607 UNIVERSAL::can($ro_url,"text")
3609 $ro_url->{FROM} eq "USER"
3611 ##address #17973: default URLs should not try to override
3612 ##user-defined URLs just because LWP is not available
3613 my $ret = $self->hosthard([$ro_url],$file,$aslocal,$stats);
3614 return $ret if $ret;
3616 return if $CPAN::Signal;
3620 # package CPAN::FTP;
3622 my($self,$host_seq,$file,$aslocal,$stats) = @_;
3624 # Came back if Net::FTP couldn't establish connection (or
3625 # failed otherwise) Maybe they are behind a firewall, but they
3626 # gave us a socksified (or other) ftp program...
3629 my($devnull) = $CPAN::Config->{devnull} || "";
3631 my($aslocal_dir) = File::Basename::dirname($aslocal);
3632 File::Path::mkpath($aslocal_dir);
3633 HOSTHARD: for $ro_url (@$host_seq) {
3634 $self->_set_attempt($stats,"hard",$ro_url);
3635 my $url = "$ro_url$file";
3636 my($proto,$host,$dir,$getfile);
3638 # Courtesy Mark Conty mark_conty@cargill.com change from
3639 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3641 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
3642 # proto not yet used
3643 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
3645 next HOSTHARD; # who said, we could ftp anything except ftp?
3647 next HOSTHARD if $proto eq "file"; # file URLs would have had
3648 # success above. Likely a bogus URL
3650 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
3652 # Try the most capable first and leave ncftp* for last as it only
3654 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
3655 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
3656 next unless defined $funkyftp;
3657 next if $funkyftp =~ /^\s*$/;
3659 my($asl_ungz, $asl_gz);
3660 ($asl_ungz = $aslocal) =~ s/\.gz//;
3661 $asl_gz = "$asl_ungz.gz";
3663 my($src_switch) = "";
3665 my($stdout_redir) = " > $asl_ungz";
3667 $src_switch = " -source";
3668 } elsif ($f eq "ncftp"){
3669 $src_switch = " -c";
3670 } elsif ($f eq "wget"){
3671 $src_switch = " -O $asl_ungz";
3673 } elsif ($f eq 'curl'){
3674 $src_switch = ' -L -f -s -S --netrc-optional';
3677 if ($f eq "ncftpget"){
3678 $chdir = "cd $aslocal_dir && ";
3681 $CPAN::Frontend->myprint(
3683 Trying with "$funkyftp$src_switch" to get
3687 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
3688 $self->debug("system[$system]") if $CPAN::DEBUG;
3689 my($wstatus) = system($system);
3691 # lynx returns 0 when it fails somewhere
3693 my $content = do { local *FH;
3694 open FH, $asl_ungz or die;
3697 if ($content =~ /^<.*(<title>[45]|Error [45])/si) {
3698 $CPAN::Frontend->mywarn(qq{
3699 No success, the file that lynx has has downloaded looks like an error message:
3702 $CPAN::Frontend->mysleep(1);
3706 $CPAN::Frontend->myprint(qq{
3707 No success, the file that lynx has has downloaded is an empty file.
3712 if ($wstatus == 0) {
3715 } elsif ($asl_ungz ne $aslocal) {
3716 # test gzip integrity
3717 if (eval{CPAN::Tarzip->new($asl_ungz)->gtest}) {
3718 # e.g. foo.tar is gzipped --> foo.tar.gz
3719 rename $asl_ungz, $aslocal;
3721 eval{CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz)};
3724 $ThesiteURL = $ro_url;
3726 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3728 -f $asl_ungz && -s _ == 0;
3729 my $gz = "$aslocal.gz";
3730 my $gzurl = "$url.gz";
3731 $CPAN::Frontend->myprint(
3733 Trying with "$funkyftp$src_switch" to get
3736 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
3737 $self->debug("system[$system]") if $CPAN::DEBUG;
3739 if (($wstatus = system($system)) == 0
3743 # test gzip integrity
3744 my $ct = eval{CPAN::Tarzip->new($asl_gz)};
3745 if ($ct && $ct->gtest) {
3746 $ct->gunzip($aslocal);
3748 # somebody uncompressed file for us?
3749 rename $asl_ungz, $aslocal;
3751 $ThesiteURL = $ro_url;
3754 unlink $asl_gz if -f $asl_gz;
3757 my $estatus = $wstatus >> 8;
3758 my $size = -f $aslocal ?
3759 ", left\n$aslocal with size ".-s _ :
3760 "\nWarning: expected file [$aslocal] doesn't exist";
3761 $CPAN::Frontend->myprint(qq{
3762 System call "$system"
3763 returned status $estatus (wstat $wstatus)$size
3766 return if $CPAN::Signal;
3767 } # transfer programs
3771 # package CPAN::FTP;
3773 my($self,$host_seq,$file,$aslocal,$stats) = @_;
3776 my($aslocal_dir) = File::Basename::dirname($aslocal);
3777 File::Path::mkpath($aslocal_dir);
3778 my $ftpbin = $CPAN::Config->{ftp};
3779 unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) {
3780 $CPAN::Frontend->myprint("No external ftp command available\n\n");
3783 $CPAN::Frontend->mywarn(qq{
3784 As a last ressort we now switch to the external ftp command '$ftpbin'
3787 Doing so often leads to problems that are hard to diagnose.
3789 If you're victim of such problems, please consider unsetting the ftp
3790 config variable with
3796 $CPAN::Frontend->mysleep(2);
3797 HOSTHARDEST: for $ro_url (@$host_seq) {
3798 $self->_set_attempt($stats,"hardest",$ro_url);
3799 my $url = "$ro_url$file";
3800 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
3801 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3804 my($host,$dir,$getfile) = ($1,$2,$3);
3806 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
3807 $ctime,$blksize,$blocks) = stat($aslocal);
3808 $timestamp = $mtime ||= 0;
3809 my($netrc) = CPAN::FTP::netrc->new;
3810 my($netrcfile) = $netrc->netrc;
3811 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
3812 my $targetfile = File::Basename::basename($aslocal);
3818 map("cd $_", split /\//, $dir), # RFC 1738
3820 "get $getfile $targetfile",
3824 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
3825 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
3826 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
3828 $netrc->contains($host))) if $CPAN::DEBUG;
3829 if ($netrc->protected) {
3830 my $dialog = join "", map { " $_\n" } @dialog;
3832 if ($netrc->contains($host)) {
3833 $netrc_explain = "Relying that your .netrc entry for '$host' ".
3834 "manages the login";
3836 $netrc_explain = "Relying that your default .netrc entry ".
3837 "manages the login";
3839 $CPAN::Frontend->myprint(qq{
3840 Trying with external ftp to get
3843 Going to send the dialog
3847 $self->talk_ftp("$ftpbin$verbose $host",
3849 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3850 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3852 if ($mtime > $timestamp) {
3853 $CPAN::Frontend->myprint("GOT $aslocal\n");
3854 $ThesiteURL = $ro_url;
3857 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
3859 return if $CPAN::Signal;
3861 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
3862 qq{correctly protected.\n});
3865 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
3866 nor does it have a default entry\n");
3869 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
3870 # then and login manually to host, using e-mail as
3872 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
3876 "user anonymous $Config::Config{'cf_email'}"
3878 my $dialog = join "", map { " $_\n" } @dialog;
3879 $CPAN::Frontend->myprint(qq{
3880 Trying with external ftp to get
3882 Going to send the dialog
3886 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
3887 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3888 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3890 if ($mtime > $timestamp) {
3891 $CPAN::Frontend->myprint("GOT $aslocal\n");
3892 $ThesiteURL = $ro_url;
3895 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
3897 return if $CPAN::Signal;
3898 $CPAN::Frontend->mywarn("Can't access URL $url.\n\n");
3899 $CPAN::Frontend->mysleep(2);
3903 # package CPAN::FTP;
3905 my($self,$command,@dialog) = @_;
3906 my $fh = FileHandle->new;
3907 $fh->open("|$command") or die "Couldn't open ftp: $!";
3908 foreach (@dialog) { $fh->print("$_\n") }
3909 $fh->close; # Wait for process to complete
3911 my $estatus = $wstatus >> 8;
3912 $CPAN::Frontend->myprint(qq{
3913 Subprocess "|$command"
3914 returned status $estatus (wstat $wstatus)
3918 # find2perl needs modularization, too, all the following is stolen
3922 my($self,$name) = @_;
3923 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
3924 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
3926 my($perms,%user,%group);
3930 $blocks = int(($blocks + 1) / 2);
3933 $blocks = int(($sizemm + 1023) / 1024);
3936 if (-f _) { $perms = '-'; }
3937 elsif (-d _) { $perms = 'd'; }
3938 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
3939 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
3940 elsif (-p _) { $perms = 'p'; }
3941 elsif (-S _) { $perms = 's'; }
3942 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
3944 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
3945 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
3946 my $tmpmode = $mode;
3947 my $tmp = $rwx[$tmpmode & 7];
3949 $tmp = $rwx[$tmpmode & 7] . $tmp;
3951 $tmp = $rwx[$tmpmode & 7] . $tmp;
3952 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
3953 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
3954 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
3957 my $user = $user{$uid} || $uid; # too lazy to implement lookup
3958 my $group = $group{$gid} || $gid;
3960 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
3962 my($moname) = $moname[$mon];
3963 if (-M _ > 365.25 / 2) {
3964 $timeyear = $year + 1900;
3967 $timeyear = sprintf("%02d:%02d", $hour, $min);
3970 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
3984 package CPAN::FTP::netrc;
3987 # package CPAN::FTP::netrc;
3990 my $home = CPAN::HandleConfig::home;
3991 my $file = File::Spec->catfile($home,".netrc");
3993 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3994 $atime,$mtime,$ctime,$blksize,$blocks)
3999 my($fh,@machines,$hasdefault);
4001 $fh = FileHandle->new or die "Could not create a filehandle";
4003 if($fh->open($file)){
4004 $protected = ($mode & 077) == 0;
4006 NETRC: while (<$fh>) {
4007 my(@tokens) = split " ", $_;
4008 TOKEN: while (@tokens) {
4009 my($t) = shift @tokens;
4010 if ($t eq "default"){
4014 last TOKEN if $t eq "macdef";
4015 if ($t eq "machine") {
4016 push @machines, shift @tokens;
4021 $file = $hasdefault = $protected = "";
4025 'mach' => [@machines],
4027 'hasdefault' => $hasdefault,
4028 'protected' => $protected,
4032 # CPAN::FTP::netrc::hasdefault;
4033 sub hasdefault { shift->{'hasdefault'} }
4034 sub netrc { shift->{'netrc'} }
4035 sub protected { shift->{'protected'} }
4037 my($self,$mach) = @_;
4038 for ( @{$self->{'mach'}} ) {
4039 return 1 if $_ eq $mach;
4044 package CPAN::Complete;
4048 my($text, $line, $start, $end) = @_;
4049 my(@perlret) = cpl($text, $line, $start);
4050 # find longest common match. Can anybody show me how to peruse
4051 # T::R::Gnu to have this done automatically? Seems expensive.
4052 return () unless @perlret;
4053 my($newtext) = $text;
4054 for (my $i = length($text)+1;;$i++) {
4055 last unless length($perlret[0]) && length($perlret[0]) >= $i;
4056 my $try = substr($perlret[0],0,$i);
4057 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
4058 # warn "try[$try]tries[@tries]";
4059 if (@tries == @perlret) {
4065 ($newtext,@perlret);
4068 #-> sub CPAN::Complete::cpl ;
4070 my($word,$line,$pos) = @_;
4074 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4076 if ($line =~ s/^(force\s*)//) {
4081 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
4082 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
4084 } elsif ($line =~ /^(a|ls)\s/) {
4085 @return = cplx('CPAN::Author',uc($word));
4086 } elsif ($line =~ /^b\s/) {
4087 CPAN::Shell->local_bundles;
4088 @return = cplx('CPAN::Bundle',$word);
4089 } elsif ($line =~ /^d\s/) {
4090 @return = cplx('CPAN::Distribution',$word);
4091 } elsif ($line =~ m/^(
4092 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
4094 if ($word =~ /^Bundle::/) {
4095 CPAN::Shell->local_bundles;
4097 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
4098 } elsif ($line =~ /^i\s/) {
4099 @return = cpl_any($word);
4100 } elsif ($line =~ /^reload\s/) {
4101 @return = cpl_reload($word,$line,$pos);
4102 } elsif ($line =~ /^o\s/) {
4103 @return = cpl_option($word,$line,$pos);
4104 } elsif ($line =~ m/^\S+\s/ ) {
4105 # fallback for future commands and what we have forgotten above
4106 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
4113 #-> sub CPAN::Complete::cplx ;
4115 my($class, $word) = @_;
4116 # I believed for many years that this was sorted, today I
4117 # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
4118 # make it sorted again. Maybe sort was dropped when GNU-readline
4119 # support came in? The RCS file is difficult to read on that:-(
4120 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
4123 #-> sub CPAN::Complete::cpl_any ;
4127 cplx('CPAN::Author',$word),
4128 cplx('CPAN::Bundle',$word),
4129 cplx('CPAN::Distribution',$word),
4130 cplx('CPAN::Module',$word),
4134 #-> sub CPAN::Complete::cpl_reload ;
4136 my($word,$line,$pos) = @_;
4138 my(@words) = split " ", $line;
4139 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4140 my(@ok) = qw(cpan index);
4141 return @ok if @words == 1;
4142 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
4145 #-> sub CPAN::Complete::cpl_option ;
4147 my($word,$line,$pos) = @_;
4149 my(@words) = split " ", $line;
4150 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4151 my(@ok) = qw(conf debug);
4152 return @ok if @words == 1;
4153 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
4155 } elsif ($words[1] eq 'index') {
4157 } elsif ($words[1] eq 'conf') {
4158 return CPAN::HandleConfig::cpl(@_);
4159 } elsif ($words[1] eq 'debug') {
4160 return sort grep /^\Q$word\E/i,
4161 sort keys %CPAN::DEBUG, 'all';
4165 package CPAN::Index;
4168 #-> sub CPAN::Index::force_reload ;
4171 $CPAN::Index::LAST_TIME = 0;
4175 #-> sub CPAN::Index::reload ;
4177 my($self,$force) = @_;
4180 # XXX check if a newer one is available. (We currently read it
4181 # from time to time)
4182 for ($CPAN::Config->{index_expire}) {
4183 $_ = 0.001 unless $_ && $_ > 0.001;
4185 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
4186 # debug here when CPAN doesn't seem to read the Metadata
4188 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
4190 unless ($CPAN::META->{PROTOCOL}) {
4191 $self->read_metadata_cache;
4192 $CPAN::META->{PROTOCOL} ||= "1.0";
4194 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
4195 # warn "Setting last_time to 0";
4196 $LAST_TIME = 0; # No warning necessary
4198 if ($LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
4201 # CPAN->debug("LAST_TIME[$LAST_TIME]index_expire[$CPAN::Config->{index_expire}]time[$time]");
4203 # IFF we are developing, it helps to wipe out the memory
4204 # between reloads, otherwise it is not what a user expects.
4205 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
4206 $CPAN::META = CPAN->new;
4209 local $LAST_TIME = $time;
4210 local $CPAN::META->{PROTOCOL} = PROTOCOL;
4212 my $needshort = $^O eq "dos";
4214 $self->rd_authindex($self
4216 "authors/01mailrc.txt.gz",
4218 File::Spec->catfile('authors', '01mailrc.gz') :
4219 File::Spec->catfile('authors', '01mailrc.txt.gz'),
4222 $debug = "timing reading 01[".($t2 - $time)."]";
4224 return if $CPAN::Signal; # this is sometimes lengthy
4225 $self->rd_modpacks($self
4227 "modules/02packages.details.txt.gz",
4229 File::Spec->catfile('modules', '02packag.gz') :
4230 File::Spec->catfile('modules', '02packages.details.txt.gz'),
4233 $debug .= "02[".($t2 - $time)."]";
4235 return if $CPAN::Signal; # this is sometimes lengthy
4236 $self->rd_modlist($self
4238 "modules/03modlist.data.gz",
4240 File::Spec->catfile('modules', '03mlist.gz') :
4241 File::Spec->catfile('modules', '03modlist.data.gz'),
4243 $self->write_metadata_cache;
4245 $debug .= "03[".($t2 - $time)."]";
4247 CPAN->debug($debug) if $CPAN::DEBUG;
4249 if ($CPAN::Config->{build_dir_reuse}) {
4250 $self->reanimate_build_dir;
4252 if (CPAN::_sqlite_running) {
4253 $CPAN::SQLite->reload(time => $time, force => $force)
4257 $CPAN::META->{PROTOCOL} = PROTOCOL;
4260 #-> sub CPAN::Index::reanimate_build_dir ;
4261 sub reanimate_build_dir {
4263 unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module}||"YAML")) {
4266 return if $HAVE_REANIMATED++;
4267 my $d = $CPAN::Config->{build_dir};
4268 my $dh = DirHandle->new;
4269 opendir $dh, $d or return; # does not exist
4274 $CPAN::Frontend->myprint("Going to read $CPAN::Config->{build_dir}/\n");
4275 my @candidates = map { $_->[0] }
4276 sort { $b->[1] <=> $a->[1] }
4277 map { [ $_, -M File::Spec->catfile($d,$_) ] }
4278 grep {/\.yml$/} readdir $dh;
4279 DISTRO: for $dirent (@candidates) {
4280 my $c = CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))->[0];
4281 if ($c && CPAN->_perl_fingerprint($c->{perl})) {
4282 my $key = $c->{distribution}{ID};
4283 for my $k (keys %{$c->{distribution}}) {
4284 if ($c->{distribution}{$k}
4285 && ref $c->{distribution}{$k}
4286 && UNIVERSAL::isa($c->{distribution}{$k},"CPAN::Distrostatus")) {
4287 $c->{distribution}{$k}{COMMANDID} = $i - @candidates;
4291 #we tried to restore only if element already
4292 #exists; but then we do not work with metadata
4294 $CPAN::META->{readwrite}{'CPAN::Distribution'}{$key} = $c->{distribution};
4298 while (($painted/76) < ($i/@candidates)) {
4299 $CPAN::Frontend->myprint(".");
4303 $CPAN::Frontend->myprint(sprintf(
4304 "DONE\nFound %s old builds, restored the state of %s\n",
4305 @candidates ? sprintf("%d",scalar @candidates) : "no",
4306 $restored || "none",
4311 #-> sub CPAN::Index::reload_x ;
4313 my($cl,$wanted,$localname,$force) = @_;
4314 $force |= 2; # means we're dealing with an index here
4315 CPAN::HandleConfig->load; # we should guarantee loading wherever
4316 # we rely on Config XXX
4317 $localname ||= $wanted;
4318 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
4322 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
4325 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
4326 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
4327 qq{day$s. I\'ll use that.});
4330 $force |= 1; # means we're quite serious about it.
4332 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
4335 #-> sub CPAN::Index::rd_authindex ;
4337 my($cl, $index_target) = @_;
4338 return unless defined $index_target;
4339 return if CPAN::_sqlite_running;
4341 $CPAN::Frontend->myprint("Going to read $index_target\n");
4343 tie *FH, 'CPAN::Tarzip', $index_target;
4346 push @lines, split /\012/ while <FH>;
4350 my($userid,$fullname,$email) =
4351 m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/;
4352 $fullname ||= $email;
4353 if ($userid && $fullname && $email){
4354 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
4355 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
4357 CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG;
4360 while (($painted/76) < ($i/@lines)) {
4361 $CPAN::Frontend->myprint(".");
4364 return if $CPAN::Signal;
4366 $CPAN::Frontend->myprint("DONE\n");
4370 my($self,$dist) = @_;
4371 $dist = $self->{'id'} unless defined $dist;
4372 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
4376 #-> sub CPAN::Index::rd_modpacks ;
4378 my($self, $index_target) = @_;
4379 return unless defined $index_target;
4380 return if CPAN::_sqlite_running;
4381 $CPAN::Frontend->myprint("Going to read $index_target\n");
4382 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
4384 CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
4387 while (my $bytes = $fh->READ(\$chunk,8192)) {
4390 my @lines = split /\012/, $slurp;
4391 CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG;
4394 my($line_count,$last_updated);
4396 my $shift = shift(@lines);
4397 last if $shift =~ /^\s*$/;
4398 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
4399 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
4401 CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
4402 if (not defined $line_count) {
4404 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
4405 Please check the validity of the index file by comparing it to more
4406 than one CPAN mirror. I'll continue but problems seem likely to
4410 $CPAN::Frontend->mysleep(5);
4411 } elsif ($line_count != scalar @lines) {
4413 $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
4414 contains a Line-Count header of %d but I see %d lines there. Please
4415 check the validity of the index file by comparing it to more than one
4416 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
4417 $index_target, $line_count, scalar(@lines));
4420 if (not defined $last_updated) {
4422 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
4423 Please check the validity of the index file by comparing it to more
4424 than one CPAN mirror. I'll continue but problems seem likely to
4428 $CPAN::Frontend->mysleep(5);
4432 ->myprint(sprintf qq{ Database was generated on %s\n},
4434 $DATE_OF_02 = $last_updated;
4437 if ($CPAN::META->has_inst('HTTP::Date')) {
4439 $age -= HTTP::Date::str2time($last_updated);
4441 $CPAN::Frontend->mywarn(" HTTP::Date not available\n");
4442 require Time::Local;
4443 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
4444 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
4445 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
4452 qq{Warning: This index file is %d days old.
4453 Please check the host you chose as your CPAN mirror for staleness.
4454 I'll continue but problems seem likely to happen.\a\n},
4457 } elsif ($age < -1) {
4461 qq{Warning: Your system date is %d days behind this index file!
4463 Timestamp index file: %s
4464 Please fix your system time, problems with the make command expected.\n},
4474 # A necessity since we have metadata_cache: delete what isn't
4476 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
4477 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
4482 # before 1.56 we split into 3 and discarded the rest. From
4483 # 1.57 we assign remaining text to $comment thus allowing to
4484 # influence isa_perl
4485 my($mod,$version,$dist,$comment) = split " ", $_, 4;
4486 my($bundle,$id,$userid);
4488 if ($mod eq 'CPAN' &&
4490 CPAN::Queue->exists('Bundle::CPAN') ||
4491 CPAN::Queue->exists('CPAN')
4495 if ($version > $CPAN::VERSION){
4496 $CPAN::Frontend->mywarn(qq{
4497 New CPAN.pm version (v$version) available.
4498 [Currently running version is v$CPAN::VERSION]
4499 You might want to try
4502 to both upgrade CPAN.pm and run the new version without leaving
4503 the current session.
4506 $CPAN::Frontend->mysleep(2);
4507 $CPAN::Frontend->myprint(qq{\n});
4509 last if $CPAN::Signal;
4510 } elsif ($mod =~ /^Bundle::(.*)/) {
4515 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
4516 # Let's make it a module too, because bundles have so much
4517 # in common with modules.
4519 # Changed in 1.57_63: seems like memory bloat now without
4520 # any value, so commented out
4522 # $CPAN::META->instance('CPAN::Module',$mod);
4526 # instantiate a module object
4527 $id = $CPAN::META->instance('CPAN::Module',$mod);
4531 # Although CPAN prohibits same name with different version the
4532 # indexer may have changed the version for the same distro
4533 # since the last time ("Force Reindexing" feature)
4534 if ($id->cpan_file ne $dist
4536 $id->cpan_version ne $version
4538 $userid = $id->userid || $self->userid($dist);
4540 'CPAN_USERID' => $userid,
4541 'CPAN_VERSION' => $version,
4542 'CPAN_FILE' => $dist,
4546 # instantiate a distribution object
4547 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
4548 # we do not need CONTAINSMODS unless we do something with
4549 # this dist, so we better produce it on demand.
4551 ## my $obj = $CPAN::META->instance(
4552 ## 'CPAN::Distribution' => $dist
4554 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
4556 $CPAN::META->instance(
4557 'CPAN::Distribution' => $dist
4559 'CPAN_USERID' => $userid,
4560 'CPAN_COMMENT' => $comment,
4564 for my $name ($mod,$dist) {
4565 # $self->debug("exists name[$name]") if $CPAN::DEBUG;
4566 $exists{$name} = undef;
4570 while (($painted/76) < ($i/@lines)) {
4571 $CPAN::Frontend->myprint(".");
4574 return if $CPAN::Signal;
4576 $CPAN::Frontend->myprint("DONE\n");
4578 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
4579 for my $o ($CPAN::META->all_objects($class)) {
4580 next if exists $exists{$o->{ID}};
4581 $CPAN::META->delete($class,$o->{ID});
4582 # CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
4589 #-> sub CPAN::Index::rd_modlist ;
4591 my($cl,$index_target) = @_;
4592 return unless defined $index_target;
4593 return if CPAN::_sqlite_running;
4594 $CPAN::Frontend->myprint("Going to read $index_target\n");
4595 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
4599 while (my $bytes = $fh->READ(\$chunk,8192)) {
4602 my @eval2 = split /\012/, $slurp;
4605 my $shift = shift(@eval2);
4606 if ($shift =~ /^Date:\s+(.*)/){
4607 if ($DATE_OF_03 eq $1){
4608 $CPAN::Frontend->myprint("Unchanged.\n");
4613 last if $shift =~ /^\s*$/;
4615 push @eval2, q{CPAN::Modulelist->data;};
4617 my($comp) = Safe->new("CPAN::Safe1");
4618 my($eval2) = join("\n", @eval2);
4619 CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
4620 my $ret = $comp->reval($eval2);
4621 Carp::confess($@) if $@;
4622 return if $CPAN::Signal;
4624 my $until = keys(%$ret);
4626 CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
4628 my $obj = $CPAN::META->instance("CPAN::Module",$_);
4629 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
4630 $obj->set(%{$ret->{$_}});
4632 while (($painted/76) < ($i/$until)) {
4633 $CPAN::Frontend->myprint(".");
4636 return if $CPAN::Signal;
4638 $CPAN::Frontend->myprint("DONE\n");
4641 #-> sub CPAN::Index::write_metadata_cache ;
4642 sub write_metadata_cache {
4644 return unless $CPAN::Config->{'cache_metadata'};
4645 return if CPAN::_sqlite_running;
4646 return unless $CPAN::META->has_usable("Storable");
4648 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
4649 CPAN::Distribution)) {
4650 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
4652 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4653 $cache->{last_time} = $LAST_TIME;
4654 $cache->{DATE_OF_02} = $DATE_OF_02;
4655 $cache->{PROTOCOL} = PROTOCOL;
4656 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
4657 eval { Storable::nstore($cache, $metadata_file) };
4658 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4661 #-> sub CPAN::Index::read_metadata_cache ;
4662 sub read_metadata_cache {
4664 return unless $CPAN::Config->{'cache_metadata'};
4665 return if CPAN::_sqlite_running;
4666 return unless $CPAN::META->has_usable("Storable");
4667 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4668 return unless -r $metadata_file and -f $metadata_file;
4669 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
4671 eval { $cache = Storable::retrieve($metadata_file) };
4672 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4673 if (!$cache || !UNIVERSAL::isa($cache, 'HASH')){
4677 if (exists $cache->{PROTOCOL}) {
4678 if (PROTOCOL > $cache->{PROTOCOL}) {
4679 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
4680 "with protocol v%s, requiring v%s\n",
4687 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
4688 "with protocol v1.0\n");
4693 while(my($class,$v) = each %$cache) {
4694 next unless $class =~ /^CPAN::/;
4695 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
4696 while (my($id,$ro) = each %$v) {
4697 $CPAN::META->{readwrite}{$class}{$id} ||=
4698 $class->new(ID=>$id, RO=>$ro);
4703 unless ($clcnt) { # sanity check
4704 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
4707 if ($idcnt < 1000) {
4708 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
4709 "in $metadata_file\n");
4712 $CPAN::META->{PROTOCOL} ||=
4713 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
4714 # does initialize to some protocol
4715 $LAST_TIME = $cache->{last_time};
4716 $DATE_OF_02 = $cache->{DATE_OF_02};
4717 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
4718 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
4722 package CPAN::InfoObj;
4727 exists $self->{RO} and return $self->{RO};
4730 #-> sub CPAN::InfoObj::cpan_userid
4735 return $ro->{CPAN_USERID} || "N/A";
4737 $self->debug("ID[$self->{ID}]");
4738 # N/A for bundles found locally
4743 sub id { shift->{ID}; }
4745 #-> sub CPAN::InfoObj::new ;
4747 my $this = bless {}, shift;
4752 # The set method may only be used by code that reads index data or
4753 # otherwise "objective" data from the outside world. All session
4754 # related material may do anything else with instance variables but
4755 # must not touch the hash under the RO attribute. The reason is that
4756 # the RO hash gets written to Metadata file and is thus persistent.
4758 #-> sub CPAN::InfoObj::safe_chdir ;
4760 my($self,$todir) = @_;
4761 # we die if we cannot chdir and we are debuggable
4762 Carp::confess("safe_chdir called without todir argument")
4763 unless defined $todir and length $todir;
4765 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4769 unless (-x $todir) {
4770 unless (chmod 0755, $todir) {
4771 my $cwd = CPAN::anycwd();
4772 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
4773 "permission to change the permission; cannot ".
4774 "chdir to '$todir'\n");
4775 $CPAN::Frontend->mysleep(5);
4776 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4777 qq{to todir[$todir]: $!});
4781 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
4784 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4787 my $cwd = CPAN::anycwd();
4788 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4789 qq{to todir[$todir] (a chmod has been issued): $!});
4794 #-> sub CPAN::InfoObj::set ;
4796 my($self,%att) = @_;
4797 my $class = ref $self;
4799 # This must be ||=, not ||, because only if we write an empty
4800 # reference, only then the set method will write into the readonly
4801 # area. But for Distributions that spring into existence, maybe
4802 # because of a typo, we do not like it that they are written into
4803 # the readonly area and made permanent (at least for a while) and
4804 # that is why we do not "allow" other places to call ->set.
4805 unless ($self->id) {
4806 CPAN->debug("Bug? Empty ID, rejecting");
4809 my $ro = $self->{RO} =
4810 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
4812 while (my($k,$v) = each %att) {
4817 #-> sub CPAN::InfoObj::as_glimpse ;
4821 my $class = ref($self);
4822 $class =~ s/^CPAN:://;
4823 my $id = $self->can("pretty_id") ? $self->pretty_id : $self->{ID};
4824 push @m, sprintf "%-15s %s\n", $class, $id;
4828 #-> sub CPAN::InfoObj::as_string ;
4832 my $class = ref($self);
4833 $class =~ s/^CPAN:://;
4834 push @m, $class, " id = $self->{ID}\n";
4836 unless ($ro = $self->ro) {
4837 if (substr($self->{ID},-1,1) eq ".") { # directory
4840 $CPAN::Frontend->mydie("Unknown object $self->{ID}");
4843 for (sort keys %$ro) {
4844 # next if m/^(ID|RO)$/;
4846 if ($_ eq "CPAN_USERID") {
4848 $extra .= $self->fullname;
4849 my $email; # old perls!
4850 if ($email = $CPAN::META->instance("CPAN::Author",
4853 $extra .= " <$email>";
4855 $extra .= " <no email>";
4858 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
4859 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
4862 next unless defined $ro->{$_};
4863 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
4865 KEY: for (sort keys %$self) {
4866 next if m/^(ID|RO)$/;
4867 unless (defined $self->{$_}) {
4871 if (ref($self->{$_}) eq "ARRAY") {
4872 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
4873 } elsif (ref($self->{$_}) eq "HASH") {
4875 if (/^CONTAINSMODS$/) {
4876 $value = join(" ",sort keys %{$self->{$_}});
4877 } elsif (/^prereq_pm$/) {
4879 my $v = $self->{$_};
4880 for my $x (sort keys %$v) {
4882 for my $y (sort keys %{$v->{$x}}) {
4883 push @svalue, "$y=>$v->{$x}{$y}";
4885 push @value, "$x\:" . join ",", @svalue if @svalue;
4887 $value = join ";", @value;
4889 $value = $self->{$_};
4897 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
4903 #-> sub CPAN::InfoObj::fullname ;
4906 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
4909 #-> sub CPAN::InfoObj::dump ;
4911 my($self, $what) = @_;
4912 unless ($CPAN::META->has_inst("Data::Dumper")) {
4913 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
4915 local $Data::Dumper::Sortkeys;
4916 $Data::Dumper::Sortkeys = 1;
4917 my $out = Data::Dumper::Dumper($what ? eval $what : $self);
4918 if (length $out > 100000) {
4919 my $fh_pager = FileHandle->new;
4920 local($SIG{PIPE}) = "IGNORE";
4921 my $pager = $CPAN::Config->{'pager'} || "cat";
4922 $fh_pager->open("|$pager")
4923 or die "Could not open pager $pager\: $!";
4924 $fh_pager->print($out);
4927 $CPAN::Frontend->myprint($out);
4931 package CPAN::Author;
4934 #-> sub CPAN::Author::force
4940 #-> sub CPAN::Author::force
4943 delete $self->{force};
4946 #-> sub CPAN::Author::id
4949 my $id = $self->{ID};
4950 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
4954 #-> sub CPAN::Author::as_glimpse ;
4958 my $class = ref($self);
4959 $class =~ s/^CPAN:://;
4960 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
4968 #-> sub CPAN::Author::fullname ;
4970 shift->ro->{FULLNAME};
4974 #-> sub CPAN::Author::email ;
4975 sub email { shift->ro->{EMAIL}; }
4977 #-> sub CPAN::Author::ls ;
4980 my $glob = shift || "";
4981 my $silent = shift || 0;
4984 # adapted from CPAN::Distribution::verifyCHECKSUM ;
4985 my(@csf); # chksumfile
4986 @csf = $self->id =~ /(.)(.)(.*)/;
4987 $csf[1] = join "", @csf[0,1];
4988 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
4990 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
4991 unless (grep {$_->[2] eq $csf[1]} @dl) {
4992 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
4995 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
4996 unless (grep {$_->[2] eq $csf[2]} @dl) {
4997 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
5000 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
5002 if ($CPAN::META->has_inst("Text::Glob")) {
5003 my $rglob = Text::Glob::glob_to_regex($glob);
5004 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
5006 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
5009 $CPAN::Frontend->myprint(join "", map {
5010 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
5011 } sort { $a->[2] cmp $b->[2] } @dl);
5015 # returns an array of arrays, the latter contain (size,mtime,filename)
5016 #-> sub CPAN::Author::dir_listing ;
5019 my $chksumfile = shift;
5020 my $recursive = shift;
5021 my $may_ftp = shift;
5024 File::Spec->catfile($CPAN::Config->{keep_source_where},
5025 "authors", "id", @$chksumfile);
5029 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
5030 # hazard. (Without GPG installed they are not that much better,
5032 $fh = FileHandle->new;
5033 if (open($fh, $lc_want)) {
5034 my $line = <$fh>; close $fh;
5035 unlink($lc_want) unless $line =~ /PGP/;
5039 # connect "force" argument with "index_expire".
5040 my $force = $self->{force};
5041 if (my @stat = stat $lc_want) {
5042 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
5046 $lc_file = CPAN::FTP->localize(
5047 "authors/id/@$chksumfile",
5052 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
5053 $chksumfile->[-1] .= ".gz";
5054 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
5057 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
5058 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
5064 $lc_file = $lc_want;
5065 # we *could* second-guess and if the user has a file: URL,
5066 # then we could look there. But on the other hand, if they do
5067 # have a file: URL, wy did they choose to set
5068 # $CPAN::Config->{show_upload_date} to false?
5071 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
5072 $fh = FileHandle->new;
5074 if (open $fh, $lc_file){
5077 $eval =~ s/\015?\012/\n/g;
5079 my($comp) = Safe->new();
5080 $cksum = $comp->reval($eval);
5082 rename $lc_file, "$lc_file.bad";
5083 Carp::confess($@) if $@;
5085 } elsif ($may_ftp) {
5086 Carp::carp "Could not open '$lc_file' for reading.";
5088 # Maybe should warn: "You may want to set show_upload_date to a true value"
5092 for $f (sort keys %$cksum) {
5093 if (exists $cksum->{$f}{isdir}) {
5095 my(@dir) = @$chksumfile;
5097 push @dir, $f, "CHECKSUMS";
5099 [$_->[0], $_->[1], "$f/$_->[2]"]
5100 } $self->dir_listing(\@dir,1,$may_ftp);
5102 push @result, [ 0, "-", $f ];
5106 ($cksum->{$f}{"size"}||0),
5107 $cksum->{$f}{"mtime"}||"---",
5115 package CPAN::Distribution;
5121 my $ro = $self->ro or return;
5125 # CPAN::Distribution::undelay
5128 delete $self->{later};
5131 # add the A/AN/ stuff
5132 # CPAN::Distribution::normalize
5135 $s = $self->id unless defined $s;
5136 if (substr($s,-1,1) eq ".") {
5137 # using a global because we are sometimes called as static method
5138 if (!$CPAN::META->{LOCK}
5139 && !$CPAN::Have_warned->{"$s is unlocked"}++
5141 $CPAN::Frontend->mywarn("You are visiting the local directory
5143 without lock, take care that concurrent processes do not do likewise.\n");
5144 $CPAN::Frontend->mysleep(1);
5147 $s = "$CPAN::iCwd/.";
5148 } elsif (File::Spec->file_name_is_absolute($s)) {
5149 } elsif (File::Spec->can("rel2abs")) {
5150 $s = File::Spec->rel2abs($s);
5152 $CPAN::Frontend->mydie("Your File::Spec is too old, please upgrade File::Spec");
5154 CPAN->debug("s[$s]") if $CPAN::DEBUG;
5155 unless ($CPAN::META->exists("CPAN::Distribution", $s)) {
5156 for ($CPAN::META->instance("CPAN::Distribution", $s)) {
5157 $_->{build_dir} = $s;
5158 $_->{archived} = "local_directory";
5159 $_->{unwrapped} = CPAN::Distrostatus->new("YES -- local_directory");
5165 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
5167 return $s if $s =~ m:^N/A|^Contact Author: ;
5168 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
5169 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
5170 CPAN->debug("s[$s]") if $CPAN::DEBUG;
5175 #-> sub CPAN::Distribution::author ;
5179 if (substr($self->id,-1,1) eq ".") {
5180 $authorid = "LOCAL";
5182 ($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
5184 CPAN::Shell->expand("Author",$authorid);
5187 # tries to get the yaml from CPAN instead of the distro itself:
5188 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
5191 my $meta = $self->pretty_id;
5192 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
5193 my(@ls) = CPAN::Shell->globls($meta);
5194 my $norm = $self->normalize($meta);
5198 File::Spec->catfile(
5199 $CPAN::Config->{keep_source_where},
5204 $self->debug("Doing localize") if $CPAN::DEBUG;
5205 unless ($local_file =
5206 CPAN::FTP->localize("authors/id/$norm",
5208 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
5210 my $yaml = CPAN->_yaml_loadfile($local_file)->[0];
5213 #-> sub CPAN::Distribution::cpan_userid
5216 if ($self->{ID} =~ m{[A-Z]/[A-Z\-]{2}/([A-Z\-]+)/}) {
5219 return $self->SUPER::cpan_userid;
5222 #-> sub CPAN::Distribution::pretty_id
5226 return $id unless $id =~ m|^./../|;
5230 # mark as dirty/clean
5231 #-> sub CPAN::Distribution::color_cmd_tmps ;
5232 sub color_cmd_tmps {
5234 my($depth) = shift || 0;
5235 my($color) = shift || 0;
5236 my($ancestors) = shift || [];
5237 # a distribution needs to recurse into its prereq_pms
5239 return if exists $self->{incommandcolor}
5240 && $self->{incommandcolor}==$color;
5242 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
5244 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
5245 my $prereq_pm = $self->prereq_pm;
5246 if (defined $prereq_pm) {
5247 PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
5248 keys %{$prereq_pm->{build_requires}||{}}) {
5249 next PREREQ if $pre eq "perl";
5251 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
5252 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
5253 $CPAN::Frontend->mysleep(2);
5256 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
5260 delete $self->{sponsored_mods};
5261 delete $self->{badtestcnt};
5263 $self->{incommandcolor} = $color;
5266 #-> sub CPAN::Distribution::as_string ;
5269 $self->containsmods;
5271 $self->SUPER::as_string(@_);
5274 #-> sub CPAN::Distribution::containsmods ;
5277 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
5278 my $dist_id = $self->{ID};
5279 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
5280 my $mod_file = $mod->cpan_file or next;
5281 my $mod_id = $mod->{ID} or next;
5282 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
5284 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
5286 keys %{$self->{CONTAINSMODS}};
5289 #-> sub CPAN::Distribution::upload_date ;
5292 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
5293 my(@local_wanted) = split(/\//,$self->id);
5294 my $filename = pop @local_wanted;
5295 push @local_wanted, "CHECKSUMS";
5296 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
5297 return unless $author;
5298 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
5300 my($dirent) = grep { $_->[2] eq $filename } @dl;
5301 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
5302 return unless $dirent->[1];
5303 return $self->{UPLOAD_DATE} = $dirent->[1];
5306 #-> sub CPAN::Distribution::uptodate ;
5310 foreach $c ($self->containsmods) {
5311 my $obj = CPAN::Shell->expandany($c);
5312 unless ($obj->uptodate){
5313 my $id = $self->pretty_id;
5314 $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG;
5321 #-> sub CPAN::Distribution::called_for ;
5324 $self->{CALLED_FOR} = $id if defined $id;
5325 return $self->{CALLED_FOR};
5328 #-> sub CPAN::Distribution::get ;
5331 if (my $goto = $self->prefs->{goto}) {
5332 $CPAN::Frontend->mywarn
5334 "delegating to '%s' as specified in prefs file '%s' doc %d\n",
5336 $self->{prefs_file},
5337 $self->{prefs_file_doc},
5339 return $self->goto($goto);
5341 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
5343 : ($ENV{PERLLIB} || "");
5345 $CPAN::META->set_perl5lib;
5346 local $ENV{MAKEFLAGS}; # protect us from outer make calls
5350 if ($self->prefs->{disabled}) {
5352 "Disabled via prefs file '%s' doc %d",
5353 $self->{prefs_file},
5354 $self->{prefs_file_doc},
5357 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $why");
5358 # note: not intended to be persistent but at least visible
5359 # during this session
5361 exists $self->{build_dir} and push @e,
5362 "Is already unwrapped into directory $self->{build_dir}";
5364 exists $self->{unwrapped} and (
5365 UNIVERSAL::can($self->{unwrapped},"failed") ?
5366 $self->{unwrapped}->failed :
5367 $self->{unwrapped} =~ /^NO/
5369 and push @e, "Unwrapping had some problem, won't try again without force";
5372 $CPAN::Frontend->mywarn(join "", map {"$_\n"} @e) and return if @e;
5374 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
5377 # Get the file on local disk
5382 File::Spec->catfile(
5383 $CPAN::Config->{keep_source_where},
5386 split(/\//,$self->id)
5389 $self->debug("Doing localize") if $CPAN::DEBUG;
5390 unless ($local_file =
5391 CPAN::FTP->localize("authors/id/$self->{ID}",
5394 if ($CPAN::Index::DATE_OF_02) {
5395 $note = "Note: Current database in memory was generated ".
5396 "on $CPAN::Index::DATE_OF_02\n";
5398 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
5401 $self->debug("local_wanted[$local_wanted]local_file[$local_file]") if $CPAN::DEBUG;
5402 $self->{localfile} = $local_file;
5403 return if $CPAN::Signal;
5408 if ($CPAN::META->has_inst("Digest::SHA")) {
5409 $self->debug("Digest::SHA is installed, verifying");
5410 $self->verifyCHECKSUM;
5412 $self->debug("Digest::SHA is NOT installed");
5414 return if $CPAN::Signal;
5417 # Create a clean room and go there
5419 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
5420 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
5421 $self->safe_chdir($builddir);
5422 $self->debug("Removing tmp-$$") if $CPAN::DEBUG;
5423 File::Path::rmtree("tmp-$$");
5424 unless (mkdir "tmp-$$", 0755) {
5425 $CPAN::Frontend->unrecoverable_error(<<EOF);
5426 Couldn't mkdir '$builddir/tmp-$$': $!
5428 Cannot continue: Please find the reason why I cannot make the
5431 and fix the problem, then retry.
5436 $self->safe_chdir($sub_wd);
5439 $self->safe_chdir("tmp-$$");
5444 my $ct = eval{CPAN::Tarzip->new($local_file)};
5446 $self->{unwrapped} = CPAN::Distrostatus->new("NO");
5447 delete $self->{build_dir};
5450 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
5451 $self->{was_uncompressed}++ unless eval{$ct->gtest()};
5452 $self->untar_me($ct);
5453 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
5454 $self->unzip_me($ct);
5456 $self->{was_uncompressed}++ unless $ct->gtest();
5457 $local_file = $self->handle_singlefile($local_file);
5459 # $self->{archived} = "NO";
5460 # $self->safe_chdir($sub_wd);
5464 # we are still in the tmp directory!
5465 # Let's check if the package has its own directory.
5466 my $dh = DirHandle->new(File::Spec->curdir)
5467 or Carp::croak("Couldn't opendir .: $!");
5468 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
5471 # XXX here we want in each branch File::Temp to protect all build_dir directories
5472 if (CPAN->has_inst("File::Temp")) {
5476 if (@readdir == 1 && -d $readdir[0]) {
5477 $tdir_base = $readdir[0];
5478 $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]);
5479 my $dh2 = DirHandle->new($from_dir)
5480 or Carp::croak("Couldn't opendir $from_dir: $!");
5481 @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC??
5483 my $userid = $self->cpan_userid;
5484 CPAN->debug("userid[$userid]");
5485 if (!$userid or $userid eq "N/A") {
5488 $tdir_base = $userid;
5489 $from_dir = File::Spec->curdir;
5490 @dirents = @readdir;
5492 $packagedir = File::Temp::tempdir(
5493 "$tdir_base-XXXXXX",
5498 for $f (@dirents) { # is already without "." and ".."
5499 my $from = File::Spec->catdir($from_dir,$f);
5500 my $to = File::Spec->catdir($packagedir,$f);
5501 unless (File::Copy::move($from,$to)) {
5503 $from = File::Spec->rel2abs($from);
5504 Carp::confess("Couldn't move $from to $to: $err");
5507 } else { # older code below, still better than nothing when there is no File::Temp
5509 if (@readdir == 1 && -d $readdir[0]) {
5510 $distdir = $readdir[0];
5511 $packagedir = File::Spec->catdir($builddir,$distdir);
5512 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
5514 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
5516 File::Path::rmtree($packagedir);
5517 unless (File::Copy::move($distdir,$packagedir)) {
5518 $CPAN::Frontend->unrecoverable_error(<<EOF);
5519 Couldn't move '$distdir' to '$packagedir': $!
5521 Cannot continue: Please find the reason why I cannot move
5522 $builddir/tmp-$$/$distdir
5525 and fix the problem, then retry
5529 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
5536 my $userid = $self->cpan_userid;
5537 CPAN->debug("userid[$userid]");
5538 if (!$userid or $userid eq "N/A") {
5541 my $pragmatic_dir = $userid . '000';
5542 $pragmatic_dir =~ s/\W_//g;
5543 $pragmatic_dir++ while -d "../$pragmatic_dir";
5544 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
5545 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
5546 File::Path::mkpath($packagedir);
5548 for $f (@readdir) { # is already without "." and ".."
5549 my $to = File::Spec->catdir($packagedir,$f);
5550 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
5555 $self->safe_chdir($sub_wd);
5559 $self->{'build_dir'} = $packagedir;
5560 $self->safe_chdir($builddir);
5561 File::Path::rmtree("tmp-$$");
5563 $self->safe_chdir($packagedir);
5564 $self->_signature_business();
5565 $self->safe_chdir($builddir);
5566 return if $CPAN::Signal;
5569 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
5570 my($mpl_exists) = -f $mpl;
5571 unless ($mpl_exists) {
5572 # NFS has been reported to have racing problems after the
5573 # renaming of a directory in some environments.
5575 $CPAN::Frontend->mysleep(1);
5576 my $mpldh = DirHandle->new($packagedir)
5577 or Carp::croak("Couldn't opendir $packagedir: $!");
5578 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
5581 my $prefer_installer = "eumm"; # eumm|mb
5582 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
5583 if ($mpl_exists) { # they *can* choose
5584 $prefer_installer = CPAN::HandleConfig->prefs_lookup($self,
5585 q{prefer_installer});
5587 $prefer_installer = "mb";
5590 return unless $self->patch;
5591 if (lc($prefer_installer) eq "mb") {
5592 $self->{modulebuild} = 1;
5593 } elsif (! $mpl_exists) {
5594 $self->_edge_cases($mpl,$packagedir,$local_file);
5596 if ($self->{build_dir}
5598 $CPAN::Config->{build_dir_reuse}
5600 $self->store_persistent_state;
5606 #-> CPAN::Distribution::store_persistent_state
5607 sub store_persistent_state {
5609 my $dir = $self->{build_dir};
5610 unless (File::Spec->canonpath(File::Basename::dirname($dir))
5611 eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
5612 $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
5613 "will not store persistent state\n");
5616 my $file = sprintf "%s.yml", $dir;
5617 CPAN->_yaml_dumpfile(
5621 perl => CPAN::_perl_fingerprint,
5622 distribution => $self,
5627 #-> CPAN::Distribution::patch
5629 my($self,$patch) = @_;
5630 my $norm = $self->normalize($patch);
5632 File::Spec->catfile(
5633 $CPAN::Config->{keep_source_where},
5638 $self->debug("Doing localize") if $CPAN::DEBUG;
5639 return CPAN::FTP->localize("authors/id/$norm",
5643 #-> CPAN::Distribution::patch
5646 if (my $patches = $self->prefs->{patches}) {
5647 return unless @$patches;
5648 $self->safe_chdir($self->{build_dir});
5649 CPAN->debug("patches[$patches]");
5650 my $patchbin = $CPAN::Config->{patch};
5651 unless ($patchbin && length $patchbin) {
5652 $CPAN::Frontend->mydie("No external patch command configured\n\n".
5653 "Please run 'o conf init /patch/'\n\n");
5655 unless (MM->maybe_command($patchbin)) {
5656 $CPAN::Frontend->mydie("No external patch command available\n\n".
5657 "Please run 'o conf init /patch/'\n\n");
5659 $patchbin = CPAN::HandleConfig->safe_quote($patchbin);
5660 local $ENV{PATCH_GET} = 0; # shall replace -g0 which is not
5661 # supported everywhere (and then,
5662 # not ever necessary there)
5663 my $stdpatchargs = "-N --fuzz=3";
5664 my $countedpatches = @$patches == 1 ? "1 patch" : (scalar @$patches . " patches");
5665 $CPAN::Frontend->myprint("Going to apply $countedpatches:\n");
5666 for my $patch (@$patches) {
5667 unless (-f $patch) {
5668 if (my $trydl = $self->try_download($patch)) {
5671 my $fail = "Could not find patch '$patch'";
5672 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5673 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5674 delete $self->{build_dir};
5678 $CPAN::Frontend->myprint(" $patch\n");
5679 my $readfh = CPAN::Tarzip->TIEHANDLE($patch);
5680 my $thispatchargs = join " ", $stdpatchargs, $self->_patch_p_parameter($readfh);
5681 CPAN->debug("thispatchargs[$thispatchargs]") if $CPAN::DEBUG;
5682 $readfh = CPAN::Tarzip->TIEHANDLE($patch);
5683 my $writefh = FileHandle->new;
5684 unless (open $writefh, "|$patchbin $thispatchargs") {
5685 my $fail = "Could not fork '$patchbin $thispatchargs'";
5686 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5687 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5688 delete $self->{build_dir};
5691 while (my $x = $readfh->READLINE) {
5694 unless (close $writefh) {
5695 my $fail = "Could not apply patch '$patch'";
5696 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5697 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5698 delete $self->{build_dir};
5707 sub _patch_p_parameter {
5710 my $cnt_p0files = 0;
5712 while ($_ = $fh->READLINE) {
5713 next unless /^[\*\+]{3}\s(\S+)/;
5716 $cnt_p0files++ if -f $file;
5717 CPAN->debug("file[$file]cnt_files[$cnt_files]cnt_p0files[$cnt_p0files]") if $CPAN::DEBUG;
5719 return "-p1" unless $cnt_files;
5720 return $cnt_files==$cnt_p0files ? "-p0" : "-p1";
5723 #-> sub CPAN::Distribution::_edge_cases
5724 # with "configure" or "Makefile" or single file scripts
5726 my($self,$mpl,$packagedir,$local_file) = @_;
5727 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
5731 my($configure) = File::Spec->catfile($packagedir,"Configure");
5732 if (-f $configure) {
5733 # do we have anything to do?
5734 $self->{configure} = $configure;
5735 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
5736 $CPAN::Frontend->mywarn(qq{
5737 Package comes with a Makefile and without a Makefile.PL.
5738 We\'ll try to build it with that Makefile then.
5740 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
5741 $CPAN::Frontend->mysleep(2);
5743 my $cf = $self->called_for || "unknown";
5748 $cf =~ s|[/\\:]||g; # risk of filesystem damage
5749 $cf = "unknown" unless length($cf);
5750 $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
5751 (The test -f "$mpl" returned false.)
5752 Writing one on our own (setting NAME to $cf)\a\n});
5753 $self->{had_no_makefile_pl}++;
5754 $CPAN::Frontend->mysleep(3);
5756 # Writing our own Makefile.PL
5759 if ($self->{archived} eq "maybe_pl") {
5760 my $fh = FileHandle->new;
5761 my $script_file = File::Spec->catfile($packagedir,$local_file);
5762 $fh->open($script_file)
5763 or Carp::croak("Could not open $script_file: $!");
5765 # name parsen und prereq
5766 my($state) = "poddir";
5767 my($name, $prereq) = ("", "");
5769 if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
5772 } elsif ($1 eq 'PREREQUISITES') {
5775 } elsif ($state =~ m{^(name|prereq)$}) {
5780 } elsif ($state eq "name") {
5785 } elsif ($state eq "prereq") {
5788 } elsif (/^=cut\b/) {
5795 s{.*<}{}; # strip X<...>
5799 $prereq = join " ", split /\s+/, $prereq;
5800 my($PREREQ_PM) = join("\n", map {
5801 s{.*<}{}; # strip X<...>
5803 if (/[\s\'\"]/) { # prose?
5805 s/[^\w:]$//; # period?
5806 " "x28 . "'$_' => 0,";
5808 } split /\s*,\s*/, $prereq);
5811 EXE_FILES => ['$name'],
5817 my $to_file = File::Spec->catfile($packagedir, $name);
5818 rename $script_file, $to_file
5819 or die "Can't rename $script_file to $to_file: $!";
5823 my $fh = FileHandle->new;
5825 or Carp::croak("Could not open >$mpl: $!");
5827 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
5828 # because there was no Makefile.PL supplied.
5829 # Autogenerated on: }.scalar localtime().qq{
5831 use ExtUtils::MakeMaker;
5833 NAME => q[$cf],$script
5840 #-> CPAN::Distribution::_signature_business
5841 sub _signature_business {
5843 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
5846 if ($CPAN::META->has_inst("Module::Signature")) {
5847 if (-f "SIGNATURE") {
5848 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
5849 my $rv = Module::Signature::verify();
5850 if ($rv != Module::Signature::SIGNATURE_OK() and
5851 $rv != Module::Signature::SIGNATURE_MISSING()) {
5852 $CPAN::Frontend->mywarn(
5853 qq{\nSignature invalid for }.
5854 qq{distribution file. }.
5855 qq{Please investigate.\n\n}
5859 sprintf(qq{I'd recommend removing %s. Its signature
5860 is invalid. Maybe you have configured your 'urllist' with
5861 a bad URL. Please check this array with 'o conf urllist', and
5862 retry. For more information, try opening a subshell with
5870 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
5871 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
5872 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
5874 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
5875 $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
5878 $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n});
5881 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
5886 #-> CPAN::Distribution::untar_me ;
5889 $self->{archived} = "tar";
5891 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
5893 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- untar failed");
5897 # CPAN::Distribution::unzip_me ;
5900 $self->{archived} = "zip";
5902 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
5904 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- unzip failed");
5909 sub handle_singlefile {
5910 my($self,$local_file) = @_;
5912 if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ){
5913 $self->{archived} = "pm";
5915 $self->{archived} = "maybe_pl";
5918 my $to = File::Basename::basename($local_file);
5919 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
5920 if (eval{CPAN::Tarzip->new($local_file)->gunzip($to)}) {
5921 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
5923 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- uncompressing failed");
5926 File::Copy::cp($local_file,".");
5927 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- copying failed");
5932 #-> sub CPAN::Distribution::new ;
5934 my($class,%att) = @_;
5936 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
5938 my $this = { %att };
5939 return bless $this, $class;
5942 #-> sub CPAN::Distribution::look ;
5946 if ($^O eq 'MacOS') {
5947 $self->Mac::BuildTools::look;
5951 if ( $CPAN::Config->{'shell'} ) {
5952 $CPAN::Frontend->myprint(qq{
5953 Trying to open a subshell in the build directory...
5956 $CPAN::Frontend->myprint(qq{
5957 Your configuration does not define a value for subshells.
5958 Please define it with "o conf shell <your shell>"
5962 my $dist = $self->id;
5964 unless ($dir = $self->dir) {
5967 unless ($dir ||= $self->dir) {
5968 $CPAN::Frontend->mywarn(qq{
5969 Could not determine which directory to use for looking at $dist.
5973 my $pwd = CPAN::anycwd();
5974 $self->safe_chdir($dir);
5975 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
5977 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
5978 $ENV{CPAN_SHELL_LEVEL} += 1;
5979 my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
5980 unless (system($shell) == 0) {
5982 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
5985 $self->safe_chdir($pwd);
5988 # CPAN::Distribution::cvs_import ;
5992 my $dir = $self->dir;
5994 my $package = $self->called_for;
5995 my $module = $CPAN::META->instance('CPAN::Module', $package);
5996 my $version = $module->cpan_version;
5998 my $userid = $self->cpan_userid;
6000 my $cvs_dir = (split /\//, $dir)[-1];
6001 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
6003 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
6005 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
6006 if ($cvs_site_perl) {
6007 $cvs_dir = "$cvs_site_perl/$cvs_dir";
6009 my $cvs_log = qq{"imported $package $version sources"};
6010 $version =~ s/\./_/g;
6011 # XXX cvs: undocumented and unclear how it was meant to work
6012 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
6013 "$cvs_dir", $userid, "v$version");
6015 my $pwd = CPAN::anycwd();
6016 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
6018 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
6020 $CPAN::Frontend->myprint(qq{@cmd\n});
6021 system(@cmd) == 0 or
6023 $CPAN::Frontend->mydie("cvs import failed");
6024 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
6027 #-> sub CPAN::Distribution::readme ;
6030 my($dist) = $self->id;
6031 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
6032 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
6035 File::Spec->catfile(
6036 $CPAN::Config->{keep_source_where},
6039 split(/\//,"$sans.readme"),
6041 $self->debug("Doing localize") if $CPAN::DEBUG;
6042 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
6044 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
6046 if ($^O eq 'MacOS') {
6047 Mac::BuildTools::launch_file($local_file);
6051 my $fh_pager = FileHandle->new;
6052 local($SIG{PIPE}) = "IGNORE";
6053 my $pager = $CPAN::Config->{'pager'} || "cat";
6054 $fh_pager->open("|$pager")
6055 or die "Could not open pager $pager\: $!";
6056 my $fh_readme = FileHandle->new;
6057 $fh_readme->open($local_file)
6058 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
6059 $CPAN::Frontend->myprint(qq{
6064 $fh_pager->print(<$fh_readme>);
6068 #-> sub CPAN::Distribution::verifyCHECKSUM ;
6069 sub verifyCHECKSUM {
6073 $self->{CHECKSUM_STATUS} ||= "";
6074 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
6075 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6077 my($lc_want,$lc_file,@local,$basename);
6078 @local = split(/\//,$self->id);
6080 push @local, "CHECKSUMS";
6082 File::Spec->catfile($CPAN::Config->{keep_source_where},
6083 "authors", "id", @local);
6085 if (my $size = -s $lc_want) {
6086 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
6087 if ($self->CHECKSUM_check_file($lc_want,1)) {
6088 return $self->{CHECKSUM_STATUS} = "OK";
6091 $lc_file = CPAN::FTP->localize("authors/id/@local",
6094 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
6095 $local[-1] .= ".gz";
6096 $lc_file = CPAN::FTP->localize("authors/id/@local",
6099 $lc_file =~ s/\.gz(?!\n)\Z//;
6100 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
6105 if ($self->CHECKSUM_check_file($lc_file)) {
6106 return $self->{CHECKSUM_STATUS} = "OK";
6110 #-> sub CPAN::Distribution::SIG_check_file ;
6111 sub SIG_check_file {
6112 my($self,$chk_file) = @_;
6113 my $rv = eval { Module::Signature::_verify($chk_file) };
6115 if ($rv == Module::Signature::SIGNATURE_OK()) {
6116 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
6117 return $self->{SIG_STATUS} = "OK";
6119 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
6120 qq{distribution file. }.
6121 qq{Please investigate.\n\n}.
6123 $CPAN::META->instance(
6128 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
6129 is invalid. Maybe you have configured your 'urllist' with
6130 a bad URL. Please check this array with 'o conf urllist', and
6133 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
6137 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
6139 # sloppy is 1 when we have an old checksums file that maybe is good
6142 sub CHECKSUM_check_file {
6143 my($self,$chk_file,$sloppy) = @_;
6144 my($cksum,$file,$basename);
6147 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
6148 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
6151 if ($CPAN::META->has_inst("Module::Signature")) {
6152 $self->debug("Module::Signature is installed, verifying");
6153 $self->SIG_check_file($chk_file);
6155 $self->debug("Module::Signature is NOT installed");
6159 $file = $self->{localfile};
6160 $basename = File::Basename::basename($file);
6161 my $fh = FileHandle->new;
6162 if (open $fh, $chk_file){
6165 $eval =~ s/\015?\012/\n/g;
6167 my($comp) = Safe->new();
6168 $cksum = $comp->reval($eval);
6170 rename $chk_file, "$chk_file.bad";
6171 Carp::confess($@) if $@;
6174 Carp::carp "Could not open $chk_file for reading";
6177 if (! ref $cksum or ref $cksum ne "HASH") {
6178 $CPAN::Frontend->mywarn(qq{
6179 Warning: checksum file '$chk_file' broken.
6181 When trying to read that file I expected to get a hash reference
6182 for further processing, but got garbage instead.
6184 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
6185 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
6186 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
6188 } elsif (exists $cksum->{$basename}{sha256}) {
6189 $self->debug("Found checksum for $basename:" .
6190 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
6194 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
6196 $fh = CPAN::Tarzip->TIEHANDLE($file);
6199 my $dg = Digest::SHA->new(256);
6202 while ($fh->READ($ref, 4096) > 0){
6205 my $hexdigest = $dg->hexdigest;
6206 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
6210 $CPAN::Frontend->myprint("Checksum for $file ok\n");
6211 return $self->{CHECKSUM_STATUS} = "OK";
6213 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
6214 qq{distribution file. }.
6215 qq{Please investigate.\n\n}.
6217 $CPAN::META->instance(
6222 my $wrap = qq{I\'d recommend removing $file. Its
6223 checksum is incorrect. Maybe you have configured your 'urllist' with
6224 a bad URL. Please check this array with 'o conf urllist', and
6227 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
6229 # former versions just returned here but this seems a
6230 # serious threat that deserves a die
6232 # $CPAN::Frontend->myprint("\n\n");
6236 # close $fh if fileno($fh);
6239 unless ($self->{CHECKSUM_STATUS}) {
6240 $CPAN::Frontend->mywarn(qq{
6241 Warning: No checksum for $basename in $chk_file.
6243 The cause for this may be that the file is very new and the checksum
6244 has not yet been calculated, but it may also be that something is
6245 going awry right now.
6247 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes");
6248 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
6250 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
6255 #-> sub CPAN::Distribution::eq_CHECKSUM ;
6257 my($self,$fh,$expect) = @_;
6258 if ($CPAN::META->has_inst("Digest::SHA")) {
6259 my $dg = Digest::SHA->new(256);
6261 while (read($fh, $data, 4096)){
6264 my $hexdigest = $dg->hexdigest;
6265 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
6266 return $hexdigest eq $expect;
6271 #-> sub CPAN::Distribution::force ;
6273 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
6274 # effect by autoinspection, not by inspecting a global variable. One
6275 # of the reason why this was chosen to work that way was the treatment
6276 # of dependencies. They should not automatically inherit the force
6277 # status. But this has the downside that ^C and die() will return to
6278 # the prompt but will not be able to reset the force_update
6279 # attributes. We try to correct for it currently in the read_metadata
6280 # routine, and immediately before we check for a Signal. I hope this
6281 # works out in one of v1.57_53ff
6283 # "Force get forgets previous error conditions"
6285 #-> sub CPAN::Distribution::force ;
6287 my($self, $method) = @_;
6305 "prereq_pm_detected",
6319 PHASE: for my $phase (qw(get make test install unknown)) { # tentative
6320 ATTRIBUTE: for my $att (@{$phase_map{$phase}}) {
6321 if ($phase eq "get" && $self->id =~ /\.$/ && $att =~ /(unwrapped|build_dir)/ ) {
6322 # cannot be undone for local distros
6325 delete $self->{$att};
6326 CPAN->debug(sprintf "phase[%s]att[%s]", $phase, $att) if $CPAN::DEBUG;
6329 if ($method && $method =~ /make|test|install/) {
6330 $self->{"force_update"}++; # name should probably have been force_install
6334 #-> sub CPAN::Distribution::notest ;
6336 my($self, $method) = @_;
6337 # warn "XDEBUG: set notest for $self $method";
6338 $self->{"notest"}++; # name should probably have been force_install
6341 #-> sub CPAN::Distribution::unnotest ;
6344 # warn "XDEBUG: deleting notest";
6345 delete $self->{'notest'};
6348 #-> sub CPAN::Distribution::unforce ;
6351 delete $self->{'force_update'};
6354 #-> sub CPAN::Distribution::isa_perl ;
6357 my $file = File::Basename::basename($self->id);
6358 if ($file =~ m{ ^ perl
6367 \.tar[._-](?:gz|bz2)
6371 } elsif ($self->cpan_comment
6373 $self->cpan_comment =~ /isa_perl\(.+?\)/){
6379 #-> sub CPAN::Distribution::perl ;
6384 carp __PACKAGE__ . "::perl was called without parameters.";
6386 return CPAN::HandleConfig->safe_quote($CPAN::Perl);
6390 #-> sub CPAN::Distribution::make ;
6393 if (my $goto = $self->prefs->{goto}) {
6394 return $self->goto($goto);
6396 my $make = $self->{modulebuild} ? "Build" : "make";
6397 # Emergency brake if they said install Pippi and get newest perl
6398 if ($self->isa_perl) {
6400 $self->called_for ne $self->id &&
6401 ! $self->{force_update}
6403 # if we die here, we break bundles
6406 qq{The most recent version "%s" of the module "%s"
6407 is part of the perl-%s distribution. To install that, you need to run
6408 force install %s --or--
6411 $CPAN::META->instance(
6420 $self->{make} = CPAN::Distrostatus->new("NO isa perl");
6421 $CPAN::Frontend->mysleep(1);
6425 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
6427 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
6429 : ($ENV{PERLLIB} || "");
6431 $CPAN::META->set_perl5lib;
6432 local $ENV{MAKEFLAGS}; # protect us from outer make calls
6435 delete $self->{force_update};
6440 if (!$self->{archived} || $self->{archived} eq "NO") {
6441 push @e, "Is neither a tar nor a zip archive.";
6444 if (!$self->{unwrapped}
6446 UNIVERSAL::can($self->{unwrapped},"failed") ?
6447 $self->{unwrapped}->failed :
6448 $self->{unwrapped} =~ /^NO/
6450 push @e, "Had problems unarchiving. Please build manually";
6453 unless ($self->{force_update}) {
6454 exists $self->{signature_verify} and
6456 UNIVERSAL::can($self->{signature_verify},"failed") ?
6457 $self->{signature_verify}->failed :
6458 $self->{signature_verify} =~ /^NO/
6460 and push @e, "Did not pass the signature test.";
6463 if (exists $self->{writemakefile} &&
6465 UNIVERSAL::can($self->{writemakefile},"failed") ?
6466 $self->{writemakefile}->failed :
6467 $self->{writemakefile} =~ /^NO/
6469 # XXX maybe a retry would be in order?
6470 my $err = UNIVERSAL::can($self->{writemakefile},"text") ?
6471 $self->{writemakefile}->text :
6472 $self->{writemakefile};
6474 $err ||= "Had some problem writing Makefile";
6475 $err .= ", won't make";
6479 defined $self->{make} and push @e,
6480 "Has already been processed within this session";
6482 if (exists $self->{later} and length($self->{later})) {
6483 if ($self->unsat_prereq) {
6484 push @e, $self->{later};
6485 # RT ticket 18438 raises doubts if the deletion of {later} is valid.
6486 # YAML-0.53 triggered the later hodge-podge here, but my margin notes
6487 # are not sufficient to be sure if we really must/may do the delete
6488 # here. SO I accept the suggested patch for now. If we trigger a bug
6489 # again, I must go into deep contemplation about the {later} flag.
6492 # delete $self->{later};
6496 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6499 delete $self->{force_update};
6502 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
6503 my $builddir = $self->dir or
6504 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
6505 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
6506 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
6508 if ($^O eq 'MacOS') {
6509 Mac::BuildTools::make($self);
6514 while (my($k,$v) = each %ENV) {
6515 next unless defined $v;
6520 if (my $commandline = $self->prefs->{pl}{commandline}) {
6521 $system = $commandline;
6523 } elsif ($self->{'configure'}) {
6524 $system = $self->{'configure'};
6525 } elsif ($self->{modulebuild}) {
6526 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
6527 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
6529 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
6531 # This needs a handler that can be turned on or off:
6532 # $switch = "-MExtUtils::MakeMaker ".
6533 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
6535 my $makepl_arg = $self->make_x_arg("pl");
6536 $system = sprintf("%s%s Makefile.PL%s",
6538 $switch ? " $switch" : "",
6539 $makepl_arg ? " $makepl_arg" : "",
6542 if (my $env = $self->prefs->{pl}{env}) {
6543 for my $e (keys %$env) {
6544 $ENV{$e} = $env->{$e};
6547 if (exists $self->{writemakefile}) {
6549 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
6553 if ($CPAN::Config->{inactivity_timeout}) {
6555 if ($Config::Config{d_alarm}
6557 $Config::Config{d_alarm} eq "define"
6561 $CPAN::Frontend->mywarn("Warning: you have configured the config ".
6562 "variable 'inactivity_timeout' to ".
6563 "'$CPAN::Config->{inactivity_timeout}'. But ".
6564 "on this machine the system call 'alarm' ".
6565 "isn't available. This means that we cannot ".
6566 "provide the feature of intercepting long ".
6567 "waiting code and will turn this feature off.\n"
6569 $CPAN::Config->{inactivity_timeout} = 0;
6572 if ($go_via_alarm) {
6574 alarm $CPAN::Config->{inactivity_timeout};
6575 local $SIG{CHLD}; # = sub { wait };
6576 if (defined($pid = fork)) {
6581 # note, this exec isn't necessary if
6582 # inactivity_timeout is 0. On the Mac I'd
6583 # suggest, we set it always to 0.
6587 $CPAN::Frontend->myprint("Cannot fork: $!");
6596 $CPAN::Frontend->myprint($err);
6597 $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
6602 if (my $expect_model = $self->_prefs_with_expect("pl")) {
6603 $ret = $self->_run_via_expect($system,$expect_model);
6605 && $self->{writemakefile}
6606 && $self->{writemakefile}->failed) {
6611 $ret = system($system);
6614 $self->{writemakefile} = CPAN::Distrostatus
6615 ->new("NO '$system' returned status $ret");
6616 $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
6617 $self->store_persistent_state;
6618 $self->store_persistent_state;
6622 if (-f "Makefile" || -f "Build") {
6623 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
6624 delete $self->{make_clean}; # if cleaned before, enable next
6626 $self->{writemakefile} = CPAN::Distrostatus
6627 ->new(qq{NO -- Unknown reason});
6631 delete $self->{force_update};
6634 if (my @prereq = $self->unsat_prereq){
6635 if ($prereq[0][0] eq "perl") {
6636 my $need = "requires perl '$prereq[0][1]'";
6637 my $id = $self->pretty_id;
6638 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
6639 $self->{make} = CPAN::Distrostatus->new("NO $need");
6640 $self->store_persistent_state;
6643 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
6647 delete $self->{force_update};
6650 if (my $commandline = $self->prefs->{make}{commandline}) {
6651 $system = $commandline;
6654 if ($self->{modulebuild}) {
6655 unless (-f "Build") {
6656 my $cwd = CPAN::anycwd();
6657 $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'".
6658 " in cwd[$cwd]. Danger, Will Robinson!");
6659 $CPAN::Frontend->mysleep(5);
6661 $system = sprintf "%s %s", $self->_build_command(), $CPAN::Config->{mbuild_arg};
6663 $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
6665 my $make_arg = $self->make_x_arg("make");
6666 $system = sprintf("%s%s",
6668 $make_arg ? " $make_arg" : "",
6671 if (my $env = $self->prefs->{make}{env}) { # overriding the local
6672 # ENV of PL, not the
6674 # unlikely to be a risk
6675 for my $e (keys %$env) {
6676 $ENV{$e} = $env->{$e};
6679 my $expect_model = $self->_prefs_with_expect("make");
6680 my $want_expect = 0;
6681 if ( $expect_model && @{$expect_model->{talk}} ) {
6682 my $can_expect = $CPAN::META->has_inst("Expect");
6686 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
6692 $system_ok = $self->_run_via_expect($system,$expect_model) == 0;
6694 $system_ok = system($system) == 0;
6696 $self->introduce_myself;
6698 $CPAN::Frontend->myprint(" $system -- OK\n");
6699 $self->{make} = CPAN::Distrostatus->new("YES");
6701 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
6702 $self->{make} = CPAN::Distrostatus->new("NO");
6703 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
6705 $self->store_persistent_state;
6708 # CPAN::Distribution::_run_via_expect
6709 sub _run_via_expect {
6710 my($self,$system,$expect_model) = @_;
6711 CPAN->debug("system[$system]expect_model[$expect_model]") if $CPAN::DEBUG;
6712 if ($CPAN::META->has_inst("Expect")) {
6713 my $expo = Expect->new; # expo Expect object;
6714 $expo->spawn($system);
6715 $expect_model->{mode} ||= "deterministic";
6716 if ($expect_model->{mode} eq "deterministic") {
6717 return $self->_run_via_expect_deterministic($expo,$expect_model);
6718 } elsif ($expect_model->{mode} eq "anyorder") {
6719 return $self->_run_via_expect_anyorder($expo,$expect_model);
6721 die "Panic: Illegal expect mode: $expect_model->{mode}";
6724 $CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n");
6725 return system($system);
6729 sub _run_via_expect_anyorder {
6730 my($self,$expo,$expect_model) = @_;
6731 my $timeout = $expect_model->{timeout} || 5;
6732 my @expectacopy = @{$expect_model->{talk}}; # we trash it!
6735 my($eof,$ran_into_timeout);
6736 my @match = $expo->expect($timeout,
6741 $ran_into_timeout++;
6748 $but .= $expo->clear_accum;
6751 return $expo->exitstatus();
6752 } elsif ($ran_into_timeout) {
6753 # warn "DEBUG: they are asking a question, but[$but]";
6754 for (my $i = 0; $i <= $#expectacopy; $i+=2) {
6755 my($next,$send) = @expectacopy[$i,$i+1];
6756 my $regex = eval "qr{$next}";
6757 # warn "DEBUG: will compare with regex[$regex].";
6758 if ($but =~ /$regex/) {
6759 # warn "DEBUG: will send send[$send]";
6761 splice @expectacopy, $i, 2; # never allow reusing an QA pair
6765 my $why = "could not answer a question during the dialog";
6766 $CPAN::Frontend->mywarn("Failing: $why\n");
6767 $self->{writemakefile} =
6768 CPAN::Distrostatus->new("NO $why");
6774 sub _run_via_expect_deterministic {
6775 my($self,$expo,$expect_model) = @_;
6776 my $ran_into_timeout;
6777 my $timeout = $expect_model->{timeout} || 15; # currently unsettable
6778 my $expecta = $expect_model->{talk};
6779 EXPECT: for (my $i = 0; $i <= $#$expecta; $i+=2) {
6780 my($re,$send) = @$expecta[$i,$i+1];
6781 CPAN->debug("timeout[$timeout]re[$re]") if $CPAN::DEBUG;
6782 my $regex = eval "qr{$re}";
6783 $expo->expect($timeout,
6785 my $but = $expo->clear_accum;
6786 $CPAN::Frontend->mywarn("EOF (maybe harmless)
6787 expected[$regex]\nbut[$but]\n\n");
6791 my $but = $expo->clear_accum;
6792 $CPAN::Frontend->mywarn("TIMEOUT
6793 expected[$regex]\nbut[$but]\n\n");
6794 $ran_into_timeout++;
6797 if ($ran_into_timeout){
6798 # note that the caller expects 0 for success
6799 $self->{writemakefile} =
6800 CPAN::Distrostatus->new("NO timeout during expect dialog");
6806 return $expo->exitstatus();
6809 sub _validate_distropref {
6810 my($self,@args) = @_;
6812 $CPAN::META->has_inst("CPAN::Kwalify")
6814 $CPAN::META->has_inst("Kwalify")
6816 eval {CPAN::Kwalify::_validate("distroprefs",@args);};
6818 $CPAN::Frontend->mywarn($@);
6821 CPAN->debug("not validating '@args'") if $CPAN::DEBUG;
6825 # CPAN::Distribution::_find_prefs
6828 my $distroid = $self->pretty_id;
6829 CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
6830 my $prefs_dir = $CPAN::Config->{prefs_dir};
6831 eval { File::Path::mkpath($prefs_dir); };
6833 $CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
6835 my $yaml_module = CPAN->_yaml_module;
6837 if ($CPAN::META->has_inst($yaml_module)) {
6838 push @extensions, "yml";
6841 if ($CPAN::META->has_inst("Data::Dumper")) {
6842 push @extensions, "dd";
6843 push @fallbacks, "Data::Dumper";
6845 if ($CPAN::META->has_inst("Storable")) {
6846 push @extensions, "st";
6847 push @fallbacks, "Storable";
6851 unless ($self->{have_complained_about_missing_yaml}++) {
6852 $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back ".
6853 "to @fallbacks to read prefs '$prefs_dir'\n");
6856 unless ($self->{have_complained_about_missing_yaml}++) {
6857 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot ".
6858 "read prefs '$prefs_dir'\n");
6863 my $dh = DirHandle->new($prefs_dir)
6864 or die Carp::croak("Couldn't open '$prefs_dir': $!");
6865 DIRENT: for (sort $dh->read) {
6866 next if $_ eq "." || $_ eq "..";
6867 my $exte = join "|", @extensions;
6868 next unless /\.($exte)$/;
6870 my $abs = File::Spec->catfile($prefs_dir, $_);
6872 CPAN->debug(sprintf "abs[%s]", $abs) if $CPAN::DEBUG;
6874 if ($thisexte eq "yml") {
6875 @distropref = @{CPAN->_yaml_loadfile($abs)};
6876 } elsif ($thisexte eq "dd") {
6879 open FH, "<$abs" or $CPAN::Frontend->mydie("Could not open '$abs': $!");
6885 $CPAN::Frontend->mydie("Error in distroprefs file $_\: $@");
6888 while (${"VAR".$i}) {
6889 push @distropref, ${"VAR".$i};
6892 } elsif ($thisexte eq "st") {
6893 # eval because Storable is never forward compatible
6894 eval { @distropref = @{scalar Storable::retrieve($abs)}; };
6896 $CPAN::Frontend->mywarn("Error reading distroprefs file ".
6897 "$_, skipping\: $@");
6898 $CPAN::Frontend->mysleep(4);
6903 ELEMENT: for my $y (0..$#distropref) {
6904 my $distropref = $distropref[$y];
6905 $self->_validate_distropref($distropref,$abs,$y);
6906 my $match = $distropref->{match};
6908 CPAN->debug("no 'match' in abs[$abs], skipping");
6912 for my $sub_attribute (keys %$match) {
6913 my $qr = eval "qr{$distropref->{match}{$sub_attribute}}";
6914 if ($sub_attribute eq "module") {
6916 CPAN->debug(sprintf "abs[%s]distropref[%d]", $abs, scalar @distropref) if $CPAN::DEBUG;
6917 my @modules = $self->containsmods;
6918 CPAN->debug(sprintf "abs[%s]distropref[%d]modules[%s]", $abs, scalar @distropref, join(",",@modules)) if $CPAN::DEBUG;
6919 MODULE: for my $module (@modules) {
6920 $okm ||= $module =~ /$qr/;
6921 last MODULE if $okm;
6924 } elsif ($sub_attribute eq "distribution") {
6925 my $okd = $distroid =~ /$qr/;
6927 } elsif ($sub_attribute eq "perl") {
6928 my $okp = $^X =~ /$qr/;
6931 $CPAN::Frontend->mydie("Nonconforming .$thisexte file '$abs': ".
6932 "unknown sub_attribut '$sub_attribute'. ".
6934 "remove, cannot continue.");
6937 CPAN->debug(sprintf "abs[%s]distropref[%d]ok[%d]", $abs, scalar @distropref, $ok) if $CPAN::DEBUG;
6940 prefs => $distropref,
6942 prefs_file_doc => $y,
6953 # CPAN::Distribution::prefs
6956 if (exists $self->{prefs}) {
6957 return $self->{prefs}; # XXX comment out during debugging
6959 if ($CPAN::Config->{prefs_dir}) {
6960 CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG;
6961 my $prefs = $self->_find_prefs();
6963 for my $x (qw(prefs prefs_file prefs_file_doc)) {
6964 $self->{$x} = $prefs->{$x};
6968 File::Basename::basename($self->{prefs_file}),
6969 $self->{prefs_file_doc},
6971 my $filler1 = "_" x 22;
6972 my $filler2 = int(66 - length($bs))/2;
6973 $filler2 = 0 if $filler2 < 0;
6974 $filler2 = " " x $filler2;
6975 $CPAN::Frontend->myprint("
6976 $filler1 D i s t r o P r e f s $filler1
6977 $filler2 $bs $filler2
6979 $CPAN::Frontend->mysleep(1);
6980 return $self->{prefs};
6986 # CPAN::Distribution::make_x_arg
6988 my($self, $whixh) = @_;
6990 my $prefs = $self->prefs;
6993 && exists $prefs->{$whixh}
6994 && exists $prefs->{$whixh}{args}
6995 && $prefs->{$whixh}{args}
6997 $make_x_arg = join(" ",
6998 map {CPAN::HandleConfig
6999 ->safe_quote($_)} @{$prefs->{$whixh}{args}},
7002 my $what = sprintf "make%s_arg", $whixh eq "make" ? "" : $whixh;
7003 $make_x_arg ||= $CPAN::Config->{$what};
7007 # CPAN::Distribution::_make_command
7014 CPAN::HandleConfig->prefs_lookup($self,
7016 || $Config::Config{make}
7020 # Old style call, without object. Deprecated
7021 Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
7024 CPAN::HandleConfig->prefs_lookup($self,q{make})
7025 || $CPAN::Config->{make}
7026 || $Config::Config{make}
7031 #-> sub CPAN::Distribution::follow_prereqs ;
7032 sub follow_prereqs {
7034 my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_;
7035 return unless @prereq_tuples;
7036 my @prereq = map { $_->[0] } @prereq_tuples;
7037 my $pretty_id = $self->pretty_id;
7039 b => "build_requires",
7043 my($filler1,$filler2,$filler3,$filler4);
7044 my $unsat = "Unsatisfied dependencies detected during";
7045 my $w = length($unsat) > length($pretty_id) ? length($unsat) : length($pretty_id);
7047 my $r = int(($w - length($unsat))/2);
7048 my $l = $w - length($unsat) - $r;
7049 $filler1 = "-"x4 . " "x$l;
7050 $filler2 = " "x$r . "-"x4 . "\n";
7053 my $r = int(($w - length($pretty_id))/2);
7054 my $l = $w - length($pretty_id) - $r;
7055 $filler3 = "-"x4 . " "x$l;
7056 $filler4 = " "x$r . "-"x4 . "\n";
7059 myprint("$filler1 $unsat $filler2".
7060 "$filler3 $pretty_id $filler4".
7061 join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @prereq_tuples),
7064 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
7066 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
7067 my $answer = CPAN::Shell::colorable_makemaker_prompt(
7068 "Shall I follow them and prepend them to the queue
7069 of modules we are processing right now?", "yes");
7070 $follow = $answer =~ /^\s*y/i;
7074 myprint(" Ignoring dependencies on modules @prereq\n");
7078 # color them as dirty
7079 for my $p (@prereq) {
7080 # warn "calling color_cmd_tmps(0,1)";
7081 my $any = CPAN::Shell->expandany($p);
7083 $any->color_cmd_tmps(0,1);
7085 $CPAN::Frontend->mywarn("Warning (maybe a bug): Cannot expand prereq '$p'\n");
7086 $CPAN::Frontend->mysleep(2);
7089 # queue them and re-queue yourself
7090 CPAN::Queue->jumpqueue([$id,$self->{reqtype}],
7091 reverse @prereq_tuples);
7092 $self->{later} = "Delayed until after prerequisites";
7093 return 1; # signal success to the queuerunner
7097 #-> sub CPAN::Distribution::unsat_prereq ;
7098 # return ([Foo=>1],[Bar=>1.2]) for normal modules
7099 # return ([perl=>5.008]) if we need a newer perl than we are running under
7102 my $prereq_pm = $self->prereq_pm or return;
7104 my %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
7105 NEED: while (my($need_module, $need_version) = each %merged) {
7106 my($have_version,$inst_file);
7107 if ($need_module eq "perl") {
7111 my $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
7112 next if $nmo->uptodate;
7113 $inst_file = $nmo->inst_file;
7115 # if they have not specified a version, we accept any installed one
7116 if (not defined $need_version or
7117 $need_version eq "0" or
7118 $need_version eq "undef") {
7119 next if defined $inst_file;
7122 $have_version = $nmo->inst_version;
7125 # We only want to install prereqs if either they're not installed
7126 # or if the installed version is too old. We cannot omit this
7127 # check, because if 'force' is in effect, nobody else will check.
7128 if (defined $inst_file) {
7129 my(@all_requirements) = split /\s*,\s*/, $need_version;
7132 RQ: for my $rq (@all_requirements) {
7133 if ($rq =~ s|>=\s*||) {
7134 } elsif ($rq =~ s|>\s*||) {
7136 if (CPAN::Version->vgt($have_version,$rq)){
7140 } elsif ($rq =~ s|!=\s*||) {
7142 if (CPAN::Version->vcmp($have_version,$rq)){
7148 } elsif ($rq =~ m|<=?\s*|) {
7150 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])\n");
7154 if (! CPAN::Version->vgt($rq, $have_version)){
7157 CPAN->debug(sprintf("need_module[%s]inst_file[%s]".
7158 "inst_version[%s]rq[%s]ok[%d]",
7162 CPAN::Version->readable($rq),
7166 next NEED if $ok == @all_requirements;
7169 if ($need_module eq "perl") {
7170 return ["perl", $need_version];
7172 if ($self->{sponsored_mods}{$need_module}++){
7173 # We have already sponsored it and for some reason it's still
7174 # not available. So we do nothing. Or what should we do?
7175 # if we push it again, we have a potential infinite loop
7178 my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
7179 push @need, [$need_module,$needed_as];
7184 #-> sub CPAN::Distribution::read_yaml ;
7187 return $self->{yaml_content} if exists $self->{yaml_content};
7188 my $build_dir = $self->{build_dir};
7189 my $yaml = File::Spec->catfile($build_dir,"META.yml");
7190 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
7191 return unless -f $yaml;
7192 eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml)->[0]; };
7194 $CPAN::Frontend->mywarn("Warning (probably harmless): Could not read ".
7195 "'$yaml'. Falling back to other ".
7196 "methods to determine prerequisites\n");
7197 return; # if we die, then we cannot read YAML's own META.yml
7199 if (not exists $self->{yaml_content}{dynamic_config}
7200 or $self->{yaml_content}{dynamic_config}
7202 $self->{yaml_content} = undef;
7204 $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
7206 return $self->{yaml_content};
7209 #-> sub CPAN::Distribution::prereq_pm ;
7212 $self->{prereq_pm_detected} ||= 0;
7213 CPAN->debug("prereq_pm_detected[$self->{prereq_pm_detected}]") if $CPAN::DEBUG;
7214 return $self->{prereq_pm} if $self->{prereq_pm_detected};
7215 return unless $self->{writemakefile} # no need to have succeeded
7216 # but we must have run it
7217 || $self->{modulebuild};
7218 CPAN->debug(sprintf "writemakefile[%s]modulebuild[%s]",
7219 $self->{writemakefile}||"",
7220 $self->{modulebuild}||"",
7223 if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
7224 $req = $yaml->{requires} || {};
7225 $breq = $yaml->{build_requires} || {};
7226 undef $req unless ref $req eq "HASH" && %$req;
7228 if ($yaml->{generated_by} &&
7229 $yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
7230 my $eummv = do { local $^W = 0; $1+0; };
7231 if ($eummv < 6.2501) {
7232 # thanks to Slaven for digging that out: MM before
7233 # that could be wrong because it could reflect a
7240 while (my($k,$v) = each %{$req||{}}) {
7243 } elsif ($k =~ /[A-Za-z]/ &&
7245 $CPAN::META->exists("Module",$v)
7247 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
7248 "requires hash: $k => $v; I'll take both ".
7249 "key and value as a module name\n");
7250 $CPAN::Frontend->mysleep(1);
7256 $req = $areq if $do_replace;
7259 unless ($req || $breq) {
7260 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
7261 my $makefile = File::Spec->catfile($build_dir,"Makefile");
7265 $fh = FileHandle->new("<$makefile\0")) {
7266 CPAN->debug("Getting prereq from Makefile") if $CPAN::DEBUG;
7269 last if /MakeMaker post_initialize section/;
7271 \s+PREREQ_PM\s+=>\s+(.+)
7274 # warn "Found prereq expr[$p]";
7276 # Regexp modified by A.Speer to remember actual version of file
7277 # PREREQ_PM hash key wants, then add to
7278 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){
7279 # In case a prereq is mentioned twice, complain.
7280 if ( defined $req->{$1} ) {
7281 warn "Warning: PREREQ_PM mentions $1 more than once, ".
7282 "last mention wins";
7290 unless ($req || $breq) {
7291 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
7292 my $buildfile = File::Spec->catfile($build_dir,"Build");
7293 if (-f $buildfile) {
7294 CPAN->debug("Found '$buildfile'") if $CPAN::DEBUG;
7295 my $build_prereqs = File::Spec->catfile($build_dir,"_build","prereqs");
7296 if (-f $build_prereqs) {
7297 CPAN->debug("Getting prerequisites from '$build_prereqs'") if $CPAN::DEBUG;
7298 my $content = do { local *FH;
7299 open FH, $build_prereqs
7300 or $CPAN::Frontend->mydie("Could not open ".
7301 "'$build_prereqs': $!");
7305 my $bphash = eval $content;
7308 $req = $bphash->{requires} || +{};
7309 $breq = $bphash->{build_requires} || +{};
7315 && ! -f "Makefile.PL"
7316 && ! exists $req->{"Module::Build"}
7317 && ! $CPAN::META->has_inst("Module::Build")) {
7318 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
7319 "undeclared prerequisite.\n".
7320 " Adding it now as such.\n"
7322 $CPAN::Frontend->mysleep(5);
7323 $req->{"Module::Build"} = 0;
7324 delete $self->{writemakefile};
7326 if ($req || $breq) {
7327 $self->{prereq_pm_detected}++;
7328 return $self->{prereq_pm} = { requires => $req, build_requires => $breq };
7332 #-> sub CPAN::Distribution::test ;
7335 if (my $goto = $self->prefs->{goto}) {
7336 return $self->goto($goto);
7340 delete $self->{force_update};
7343 # warn "XDEBUG: checking for notest: $self->{notest} $self";
7344 if ($self->{notest}) {
7345 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
7349 my $make = $self->{modulebuild} ? "Build" : "make";
7351 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
7353 : ($ENV{PERLLIB} || "");
7355 $CPAN::META->set_perl5lib;
7356 local $ENV{MAKEFLAGS}; # protect us from outer make calls
7358 $CPAN::Frontend->myprint("Running $make test\n");
7359 if (my @prereq = $self->unsat_prereq){
7360 unless ($prereq[0][0] eq "perl") {
7361 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
7366 unless (exists $self->{make} or exists $self->{later}) {
7368 "Make had some problems, won't test";
7371 exists $self->{make} and
7373 UNIVERSAL::can($self->{make},"failed") ?
7374 $self->{make}->failed :
7375 $self->{make} =~ /^NO/
7376 ) and push @e, "Can't test without successful make";
7378 $self->{badtestcnt} ||= 0;
7379 $self->{badtestcnt} > 0 and
7380 push @e, "Won't repeat unsuccessful test during this command";
7382 exists $self->{later} and length($self->{later}) and
7383 push @e, $self->{later};
7385 if (exists $self->{build_dir}) {
7386 if ($CPAN::META->{is_tested}{$self->{build_dir}}
7388 exists $self->{make_test}
7391 UNIVERSAL::can($self->{make_test},"failed") ?
7392 $self->{make_test}->failed :
7393 $self->{make_test} =~ /^NO/
7396 push @e, "Already tested successfully";
7399 push @e, "Has no own directory";
7402 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
7404 chdir $self->{'build_dir'} or
7405 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
7406 $self->debug("Changed directory to $self->{'build_dir'}")
7409 if ($^O eq 'MacOS') {
7410 Mac::BuildTools::make_test($self);
7414 if ($self->{modulebuild}) {
7415 my $v = CPAN::Shell->expand("Module","Test::Harness")->inst_version;
7416 if (CPAN::Version->vlt($v,2.62)) {
7417 $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only
7418 '$v', you need at least '2.62'. Please upgrade your Test::Harness.\n});
7419 $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old");
7425 if (my $commandline = $self->prefs->{test}{commandline}) {
7426 $system = $commandline;
7428 } elsif ($self->{modulebuild}) {
7429 $system = sprintf "%s test", $self->_build_command();
7431 $system = join " ", $self->_make_command(), "test";
7435 while (my($k,$v) = each %ENV) {
7436 next unless defined $v;
7440 if (my $env = $self->prefs->{test}{env}) {
7441 for my $e (keys %$env) {
7442 $ENV{$e} = $env->{$e};
7445 my $expect_model = $self->_prefs_with_expect("test");
7446 my $want_expect = 0;
7447 if ( $expect_model && @{$expect_model->{talk}} ) {
7448 my $can_expect = $CPAN::META->has_inst("Expect");
7452 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
7453 "testing without\n");
7456 my $test_report = CPAN::HandleConfig->prefs_lookup($self,
7460 my $can_report = $CPAN::META->has_inst("CPAN::Reporter");
7464 $CPAN::Frontend->mywarn("CPAN::Reporter not installed, falling back to ".
7465 "testing without\n");
7468 my $ready_to_report = $want_report;
7469 if ($ready_to_report
7471 substr($self->id,-1,1) eq "."
7473 $self->author->id eq "LOCAL"
7476 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
7477 "for local directories\n");
7478 $ready_to_report = 0;
7480 if ($ready_to_report
7482 $self->prefs->{patches}
7484 @{$self->prefs->{patches}}
7488 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
7489 "when the source has been patched\n");
7490 $ready_to_report = 0;
7493 if ($ready_to_report) {
7494 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is currently ".
7495 "not supported when distroprefs specify ".
7496 "an interactive test\n");
7498 $tests_ok = $self->_run_via_expect($system,$expect_model) == 0;
7499 } elsif ( $ready_to_report ) {
7500 $tests_ok = CPAN::Reporter::test($self, $system);
7502 $tests_ok = system($system) == 0;
7504 $self->introduce_myself;
7509 for my $m (keys %{$self->{sponsored_mods}}) {
7510 my $m_obj = CPAN::Shell->expand("Module",$m);
7511 # XXX we need available_version which reflects
7512 # $ENV{PERL5LIB} so that already tested but not yet
7513 # installed modules are counted.
7514 my $available_version = $m_obj->available_version;
7515 if ($available_version &&
7516 !CPAN::Version->vlt($available_version,$self->{PREREQ_PM}{$m})
7518 CPAN->debug("m[$m] good enough available_version[$available_version]")
7526 my $which = join ",", @prereq;
7527 my $but = $cnt == 1 ? "one dependency not OK ($which)" :
7528 "$cnt dependencies missing ($which)";
7529 $CPAN::Frontend->mywarn("Tests succeeded but $but\n");
7530 $self->{make_test} = CPAN::Distrostatus->new("NO $but");
7531 $self->store_persistent_state;
7536 $CPAN::Frontend->myprint(" $system -- OK\n");
7537 $CPAN::META->is_tested($self->{'build_dir'});
7538 $self->{make_test} = CPAN::Distrostatus->new("YES");
7540 $self->{make_test} = CPAN::Distrostatus->new("NO");
7541 $self->{badtestcnt}++;
7542 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
7544 $self->store_persistent_state;
7547 sub _prefs_with_expect {
7548 my($self,$where) = @_;
7549 return unless my $prefs = $self->prefs;
7550 return unless my $where_prefs = $prefs->{$where};
7551 if ($where_prefs->{expect}) {
7553 mode => "deterministic",
7555 talk => $where_prefs->{expect},
7557 } elsif ($where_prefs->{"eexpect"}) {
7558 return $where_prefs->{"eexpect"};
7563 #-> sub CPAN::Distribution::clean ;
7566 my $make = $self->{modulebuild} ? "Build" : "make";
7567 $CPAN::Frontend->myprint("Running $make clean\n");
7568 unless (exists $self->{archived}) {
7569 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
7570 "/untarred, nothing done\n");
7573 unless (exists $self->{build_dir}) {
7574 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
7579 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
7580 push @e, "make clean already called once";
7581 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
7583 chdir $self->{'build_dir'} or
7584 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
7585 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
7587 if ($^O eq 'MacOS') {
7588 Mac::BuildTools::make_clean($self);
7593 if ($self->{modulebuild}) {
7594 unless (-f "Build") {
7595 my $cwd = CPAN::anycwd();
7596 $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}".
7597 " in cwd[$cwd]. Danger, Will Robinson!");
7598 $CPAN::Frontend->mysleep(5);
7600 $system = sprintf "%s clean", $self->_build_command();
7602 $system = join " ", $self->_make_command(), "clean";
7604 my $system_ok = system($system) == 0;
7605 $self->introduce_myself;
7607 $CPAN::Frontend->myprint(" $system -- OK\n");
7611 # Jost Krieger pointed out that this "force" was wrong because
7612 # it has the effect that the next "install" on this distribution
7613 # will untar everything again. Instead we should bring the
7614 # object's state back to where it is after untarring.
7625 $self->{make_clean} = CPAN::Distrostatus->new("YES");
7628 # Hmmm, what to do if make clean failed?
7630 $self->{make_clean} = CPAN::Distrostatus->new("NO");
7631 $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n});
7633 # 2006-02-27: seems silly to me to force a make now
7634 # $self->force("make"); # so that this directory won't be used again
7637 $self->store_persistent_state;
7640 #-> sub CPAN::Distribution::goto ;
7642 my($self,$goto) = @_;
7643 $goto = $self->normalize($goto);
7645 # inject into the queue
7647 CPAN::Queue->delete($self->id);
7648 CPAN::Queue->jumpqueue([$goto,$self->{reqtype}]);
7650 # and run where we left off
7652 my($method) = (caller(1))[3];
7653 CPAN->instance("CPAN::Distribution",$goto)->$method;
7657 #-> sub CPAN::Distribution::install ;
7660 if (my $goto = $self->prefs->{goto}) {
7661 return $self->goto($goto);
7665 delete $self->{force_update};
7668 my $make = $self->{modulebuild} ? "Build" : "make";
7669 $CPAN::Frontend->myprint("Running $make install\n");
7672 unless (exists $self->{make} or exists $self->{later}) {
7674 "Make had some problems, won't install";
7677 exists $self->{make} and
7679 UNIVERSAL::can($self->{make},"failed") ?
7680 $self->{make}->failed :
7681 $self->{make} =~ /^NO/
7683 push @e, "Make had returned bad status, install seems impossible";
7685 if (exists $self->{build_dir}) {
7687 push @e, "Has no own directory";
7690 if (exists $self->{make_test} and
7692 UNIVERSAL::can($self->{make_test},"failed") ?
7693 $self->{make_test}->failed :
7694 $self->{make_test} =~ /^NO/
7696 if ($self->{force_update}) {
7697 $self->{make_test}->text("FAILED but failure ignored because ".
7698 "'force' in effect");
7700 push @e, "make test had returned bad status, ".
7701 "won't install without force"
7704 if (exists $self->{install}) {
7705 if (UNIVERSAL::can($self->{install},"text") ?
7706 $self->{install}->text eq "YES" :
7707 $self->{install} =~ /^YES/
7709 push @e, "Already done";
7711 # comment in Todo on 2006-02-11; maybe retry?
7712 push @e, "Already tried without success";
7716 exists $self->{later} and length($self->{later}) and
7717 push @e, $self->{later};
7719 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
7721 chdir $self->{'build_dir'} or
7722 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
7723 $self->debug("Changed directory to $self->{'build_dir'}")
7726 if ($^O eq 'MacOS') {
7727 Mac::BuildTools::make_install($self);
7732 if (my $commandline = $self->prefs->{install}{commandline}) {
7733 $system = $commandline;
7735 } elsif ($self->{modulebuild}) {
7736 my($mbuild_install_build_command) =
7737 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
7738 $CPAN::Config->{mbuild_install_build_command} ?
7739 $CPAN::Config->{mbuild_install_build_command} :
7740 $self->_build_command();
7741 $system = sprintf("%s install %s",
7742 $mbuild_install_build_command,
7743 $CPAN::Config->{mbuild_install_arg},
7746 my($make_install_make_command) =
7747 CPAN::HandleConfig->prefs_lookup($self,
7748 q{make_install_make_command})
7749 || $self->_make_command();
7750 $system = sprintf("%s install %s",
7751 $make_install_make_command,
7752 $CPAN::Config->{make_install_arg},
7756 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
7757 my $brip = CPAN::HandleConfig->prefs_lookup($self,
7758 q{build_requires_install_policy});
7761 my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command
7762 my $want_install = "yes";
7763 if ($reqtype eq "b") {
7764 if ($brip eq "no") {
7765 $want_install = "no";
7766 } elsif ($brip =~ m|^ask/(.+)|) {
7768 $default = "yes" unless $default =~ /^(y|n)/i;
7770 CPAN::Shell::colorable_makemaker_prompt
7771 ("$id is just needed temporarily during building or testing. ".
7772 "Do you want to install it permanently? (Y/n)",
7776 unless ($want_install =~ /^y/i) {
7777 my $is_only = "is only 'build_requires'";
7778 $CPAN::Frontend->mywarn("Not installing because $is_only\n");
7779 $self->{install} = CPAN::Distrostatus->new("NO -- $is_only");
7780 delete $self->{force_update};
7783 my($pipe) = FileHandle->new("$system $stderr |");
7786 print $_; # intentionally NOT use Frontend->myprint because it
7787 # looks irritating when we markup in color what we
7788 # just pass through from an external program
7792 my $close_ok = $? == 0;
7793 $self->introduce_myself;
7795 $CPAN::Frontend->myprint(" $system -- OK\n");
7796 $CPAN::META->is_installed($self->{build_dir});
7797 return $self->{install} = CPAN::Distrostatus->new("YES");
7799 $self->{install} = CPAN::Distrostatus->new("NO");
7800 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
7802 CPAN::HandleConfig->prefs_lookup($self,
7803 q{make_install_make_command});
7805 $makeout =~ /permission/s
7809 || $mimc eq (CPAN::HandleConfig->prefs_lookup($self,
7813 $CPAN::Frontend->myprint(
7815 qq{ You may have to su }.
7816 qq{to root to install the package\n}.
7817 qq{ (Or you may want to run something like\n}.
7818 qq{ o conf make_install_make_command 'sudo make'\n}.
7819 qq{ to raise your permissions.}
7823 delete $self->{force_update};
7824 $self->store_persistent_state;
7827 sub introduce_myself {
7829 $CPAN::Frontend->myprint(sprintf(" %s\n",$self->pretty_id));
7832 #-> sub CPAN::Distribution::dir ;
7834 shift->{'build_dir'};
7837 #-> sub CPAN::Distribution::perldoc ;
7841 my($dist) = $self->id;
7842 my $package = $self->called_for;
7844 $self->_display_url( $CPAN::Defaultdocs . $package );
7847 #-> sub CPAN::Distribution::_check_binary ;
7849 my ($dist,$shell,$binary) = @_;
7852 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
7855 if ($CPAN::META->has_inst("File::Which")) {
7856 return File::Which::which($binary);
7859 $pid = open README, "which $binary|"
7860 or $CPAN::Frontend->mywarn(qq{Could not fork 'which $binary': $!\n});
7866 or $CPAN::Frontend->mywarn("Could not run 'which $binary': $!\n")
7870 $CPAN::Frontend->myprint(qq{ + $out \n})
7871 if $CPAN::DEBUG && $out;
7876 #-> sub CPAN::Distribution::_display_url ;
7878 my($self,$url) = @_;
7879 my($res,$saved_file,$pid,$out);
7881 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
7884 # should we define it in the config instead?
7885 my $html_converter = "html2text";
7887 my $web_browser = $CPAN::Config->{'lynx'} || undef;
7888 my $web_browser_out = $web_browser
7889 ? CPAN::Distribution->_check_binary($self,$web_browser)
7892 if ($web_browser_out) {
7893 # web browser found, run the action
7894 my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
7895 $CPAN::Frontend->myprint(qq{system[$browser $url]})
7897 $CPAN::Frontend->myprint(qq{
7900 with browser $browser
7902 $CPAN::Frontend->mysleep(1);
7903 system("$browser $url");
7904 if ($saved_file) { 1 while unlink($saved_file) }
7906 # web browser not found, let's try text only
7907 my $html_converter_out =
7908 CPAN::Distribution->_check_binary($self,$html_converter);
7909 $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
7911 if ($html_converter_out ) {
7912 # html2text found, run it
7913 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
7914 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
7915 unless defined($saved_file);
7918 $pid = open README, "$html_converter $saved_file |"
7919 or $CPAN::Frontend->mydie(qq{
7920 Could not fork '$html_converter $saved_file': $!});
7922 if ($CPAN::META->has_inst("File::Temp")) {
7923 $fh = File::Temp->new(
7924 template => 'cpan_htmlconvert_XXXX',
7928 $filename = $fh->filename;
7930 $filename = "cpan_htmlconvert_$$.txt";
7931 $fh = FileHandle->new();
7932 open $fh, ">$filename" or die;
7938 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
7939 my $tmpin = $fh->filename;
7940 $CPAN::Frontend->myprint(sprintf(qq{
7942 saved output to %s\n},
7950 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
7951 my $fh_pager = FileHandle->new;
7952 local($SIG{PIPE}) = "IGNORE";
7953 my $pager = $CPAN::Config->{'pager'} || "cat";
7954 $fh_pager->open("|$pager")
7955 or $CPAN::Frontend->mydie(qq{
7956 Could not open pager '$pager': $!});
7957 $CPAN::Frontend->myprint(qq{
7962 $CPAN::Frontend->mysleep(1);
7963 $fh_pager->print(<FH>);
7966 # coldn't find the web browser or html converter
7967 $CPAN::Frontend->myprint(qq{
7968 You need to install lynx or $html_converter to use this feature.});
7973 #-> sub CPAN::Distribution::_getsave_url ;
7975 my($dist, $shell, $url) = @_;
7977 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
7981 if ($CPAN::META->has_inst("File::Temp")) {
7982 $fh = File::Temp->new(
7983 template => "cpan_getsave_url_XXXX",
7987 $filename = $fh->filename;
7989 $fh = FileHandle->new;
7990 $filename = "cpan_getsave_url_$$.html";
7992 my $tmpin = $filename;
7993 if ($CPAN::META->has_usable('LWP')) {
7994 $CPAN::Frontend->myprint("Fetching with LWP:
7998 CPAN::LWP::UserAgent->config;
7999 eval { $Ua = CPAN::LWP::UserAgent->new; };
8001 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
8005 $Ua->proxy('http', $var)
8006 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
8008 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
8011 my $req = HTTP::Request->new(GET => $url);
8012 $req->header('Accept' => 'text/html');
8013 my $res = $Ua->request($req);
8014 if ($res->is_success) {
8015 $CPAN::Frontend->myprint(" + request successful.\n")
8017 print $fh $res->content;
8019 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
8023 $CPAN::Frontend->myprint(sprintf(
8024 "LWP failed with code[%s], message[%s]\n",
8031 $CPAN::Frontend->mywarn(" LWP not available\n");
8036 # sub CPAN::Distribution::_build_command
8037 sub _build_command {
8039 if ($^O eq "MSWin32") { # special code needed at least up to
8040 # Module::Build 0.2611 and 0.2706; a fix
8041 # in M:B has been promised 2006-01-30
8042 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
8043 return "$perl ./Build";
8048 package CPAN::Bundle;
8053 $CPAN::Frontend->myprint($self->as_string);
8058 delete $self->{later};
8059 for my $c ( $self->contains ) {
8060 my $obj = CPAN::Shell->expandany($c) or next;
8065 # mark as dirty/clean
8066 #-> sub CPAN::Bundle::color_cmd_tmps ;
8067 sub color_cmd_tmps {
8069 my($depth) = shift || 0;
8070 my($color) = shift || 0;
8071 my($ancestors) = shift || [];
8072 # a module needs to recurse to its cpan_file, a distribution needs
8073 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
8075 return if exists $self->{incommandcolor}
8076 && $self->{incommandcolor}==$color;
8078 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
8080 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
8082 for my $c ( $self->contains ) {
8083 my $obj = CPAN::Shell->expandany($c) or next;
8084 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
8085 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
8088 delete $self->{badtestcnt};
8090 $self->{incommandcolor} = $color;
8093 #-> sub CPAN::Bundle::as_string ;
8097 # following line must be "=", not "||=" because we have a moving target
8098 $self->{INST_VERSION} = $self->inst_version;
8099 return $self->SUPER::as_string;
8102 #-> sub CPAN::Bundle::contains ;
8105 my($inst_file) = $self->inst_file || "";
8106 my($id) = $self->id;
8107 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
8108 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
8111 unless ($inst_file) {
8112 # Try to get at it in the cpan directory
8113 $self->debug("no inst_file") if $CPAN::DEBUG;
8115 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
8116 $cpan_file = $self->cpan_file;
8117 if ($cpan_file eq "N/A") {
8118 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
8119 Maybe stale symlink? Maybe removed during session? Giving up.\n");
8121 my $dist = $CPAN::META->instance('CPAN::Distribution',
8124 $self->debug("id[$dist->{ID}]") if $CPAN::DEBUG;
8125 my($todir) = $CPAN::Config->{'cpan_home'};
8126 my(@me,$from,$to,$me);
8127 @me = split /::/, $self->id;
8129 $me = File::Spec->catfile(@me);
8130 $from = $self->find_bundle_file($dist->{'build_dir'},join('/',@me));
8131 $to = File::Spec->catfile($todir,$me);
8132 File::Path::mkpath(File::Basename::dirname($to));
8133 File::Copy::copy($from, $to)
8134 or Carp::confess("Couldn't copy $from to $to: $!");
8138 my $fh = FileHandle->new;
8140 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
8142 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
8144 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
8145 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
8146 next unless $in_cont;
8151 push @result, (split " ", $_, 2)[0];
8154 delete $self->{STATUS};
8155 $self->{CONTAINS} = \@result;
8156 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
8158 $CPAN::Frontend->mywarn(qq{
8159 The bundle file "$inst_file" may be a broken
8160 bundlefile. It seems not to contain any bundle definition.
8161 Please check the file and if it is bogus, please delete it.
8162 Sorry for the inconvenience.
8168 #-> sub CPAN::Bundle::find_bundle_file
8169 # $where is in local format, $what is in unix format
8170 sub find_bundle_file {
8171 my($self,$where,$what) = @_;
8172 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
8173 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
8174 ### my $bu = File::Spec->catfile($where,$what);
8175 ### return $bu if -f $bu;
8176 my $manifest = File::Spec->catfile($where,"MANIFEST");
8177 unless (-f $manifest) {
8178 require ExtUtils::Manifest;
8179 my $cwd = CPAN::anycwd();
8180 $self->safe_chdir($where);
8181 ExtUtils::Manifest::mkmanifest();
8182 $self->safe_chdir($cwd);
8184 my $fh = FileHandle->new($manifest)
8185 or Carp::croak("Couldn't open $manifest: $!");
8187 my $bundle_filename = $what;
8188 $bundle_filename =~ s|Bundle.*/||;
8189 my $bundle_unixpath;
8192 my($file) = /(\S+)/;
8193 if ($file =~ m|\Q$what\E$|) {
8194 $bundle_unixpath = $file;
8195 # return File::Spec->catfile($where,$bundle_unixpath); # bad
8198 # retry if she managed to have no Bundle directory
8199 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
8201 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
8202 if $bundle_unixpath;
8203 Carp::croak("Couldn't find a Bundle file in $where");
8206 # needs to work quite differently from Module::inst_file because of
8207 # cpan_home/Bundle/ directory and the possibility that we have
8208 # shadowing effect. As it makes no sense to take the first in @INC for
8209 # Bundles, we parse them all for $VERSION and take the newest.
8211 #-> sub CPAN::Bundle::inst_file ;
8216 @me = split /::/, $self->id;
8219 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
8220 my $bfile = File::Spec->catfile($incdir, @me);
8221 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
8222 next unless -f $bfile;
8223 my $foundv = MM->parse_version($bfile);
8224 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
8225 $self->{INST_FILE} = $bfile;
8226 $self->{INST_VERSION} = $bestv = $foundv;
8232 #-> sub CPAN::Bundle::inst_version ;
8235 $self->inst_file; # finds INST_VERSION as side effect
8236 $self->{INST_VERSION};
8239 #-> sub CPAN::Bundle::rematein ;
8241 my($self,$meth) = @_;
8242 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
8243 my($id) = $self->id;
8244 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
8245 unless $self->inst_file || $self->cpan_file;
8247 for $s ($self->contains) {
8248 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
8249 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
8250 if ($type eq 'CPAN::Distribution') {
8251 $CPAN::Frontend->mywarn(qq{
8252 The Bundle }.$self->id.qq{ contains
8253 explicitly a file '$s'.
8254 Going to $meth that.
8256 $CPAN::Frontend->mysleep(5);
8258 # possibly noisy action:
8259 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
8260 my $obj = $CPAN::META->instance($type,$s);
8261 $obj->{reqtype} = $self->{reqtype};
8263 if ($obj->isa('CPAN::Bundle')
8265 exists $obj->{install_failed}
8267 ref($obj->{install_failed}) eq "HASH"
8269 for (keys %{$obj->{install_failed}}) {
8270 $self->{install_failed}{$_} = undef; # propagate faiure up
8273 $fail{$s} = 1; # the bundle itself may have succeeded but
8278 $success = $obj->can("uptodate") ? $obj->uptodate : 0;
8279 $success ||= $obj->{install} && $obj->{install} eq "YES";
8281 delete $self->{install_failed}{$s};
8288 # recap with less noise
8289 if ( $meth eq "install" ) {
8292 my $raw = sprintf(qq{Bundle summary:
8293 The following items in bundle %s had installation problems:},
8296 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
8297 $CPAN::Frontend->myprint("\n");
8300 for $s ($self->contains) {
8302 $paragraph .= "$s ";
8303 $self->{install_failed}{$s} = undef;
8304 $reported{$s} = undef;
8307 my $report_propagated;
8308 for $s (sort keys %{$self->{install_failed}}) {
8309 next if exists $reported{$s};
8310 $paragraph .= "and the following items had problems
8311 during recursive bundle calls: " unless $report_propagated++;
8312 $paragraph .= "$s ";
8314 $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
8315 $CPAN::Frontend->myprint("\n");
8317 $self->{install} = 'YES';
8322 # If a bundle contains another that contains an xs_file we have here,
8323 # we just don't bother I suppose
8324 #-> sub CPAN::Bundle::xs_file
8329 #-> sub CPAN::Bundle::force ;
8330 sub force { shift->rematein('force',@_); }
8331 #-> sub CPAN::Bundle::notest ;
8332 sub notest { shift->rematein('notest',@_); }
8333 #-> sub CPAN::Bundle::get ;
8334 sub get { shift->rematein('get',@_); }
8335 #-> sub CPAN::Bundle::make ;
8336 sub make { shift->rematein('make',@_); }
8337 #-> sub CPAN::Bundle::test ;
8340 $self->{badtestcnt} ||= 0;
8341 $self->rematein('test',@_);
8343 #-> sub CPAN::Bundle::install ;
8346 $self->rematein('install',@_);
8348 #-> sub CPAN::Bundle::clean ;
8349 sub clean { shift->rematein('clean',@_); }
8351 #-> sub CPAN::Bundle::uptodate ;
8354 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
8356 foreach $c ($self->contains) {
8357 my $obj = CPAN::Shell->expandany($c);
8358 return 0 unless $obj->uptodate;
8363 #-> sub CPAN::Bundle::readme ;
8366 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
8367 No File found for bundle } . $self->id . qq{\n}), return;
8368 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
8369 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
8372 package CPAN::Module;
8376 # sub CPAN::Module::userid
8381 return $ro->{userid} || $ro->{CPAN_USERID};
8383 # sub CPAN::Module::description
8386 my $ro = $self->ro or return "";
8392 CPAN::Shell->expand("Distribution",$self->cpan_file);
8395 # sub CPAN::Module::undelay
8398 delete $self->{later};
8399 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
8404 # mark as dirty/clean
8405 #-> sub CPAN::Module::color_cmd_tmps ;
8406 sub color_cmd_tmps {
8408 my($depth) = shift || 0;
8409 my($color) = shift || 0;
8410 my($ancestors) = shift || [];
8411 # a module needs to recurse to its cpan_file
8413 return if exists $self->{incommandcolor}
8414 && $self->{incommandcolor}==$color;
8415 return if $depth>=1 && $self->uptodate;
8417 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
8419 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
8421 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
8422 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
8425 delete $self->{badtestcnt};
8427 $self->{incommandcolor} = $color;
8430 #-> sub CPAN::Module::as_glimpse ;
8434 my $class = ref($self);
8435 $class =~ s/^CPAN:://;
8439 $CPAN::Shell::COLOR_REGISTERED
8441 $CPAN::META->has_inst("Term::ANSIColor")
8445 $color_on = Term::ANSIColor::color("green");
8446 $color_off = Term::ANSIColor::color("reset");
8448 my $uptodateness = " ";
8449 if ($class eq "Bundle") {
8450 } elsif ($self->uptodate) {
8451 $uptodateness = "=";
8452 } elsif ($self->inst_version) {
8453 $uptodateness = "<";
8455 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
8461 ($self->distribution ?
8462 $self->distribution->pretty_id :
8469 #-> sub CPAN::Module::dslip_status
8473 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
8474 pre-alpha alpha beta released
8476 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
8477 developer comp.lang.perl.*
8479 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
8480 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
8482 object-oriented pragma
8484 @{$stat->{P}}{qw,p g l b a o d r n,} = qw,Standard-Perl
8488 distribution_allowed
8489 restricted_distribution
8491 for my $x (qw(d s l i p)) {
8492 $stat->{$x}{' '} = 'unknown';
8493 $stat->{$x}{'?'} = 'unknown';
8496 return +{} unless $ro && $ro->{statd};
8503 DV => $stat->{D}{$ro->{statd}},
8504 SV => $stat->{S}{$ro->{stats}},
8505 LV => $stat->{L}{$ro->{statl}},
8506 IV => $stat->{I}{$ro->{stati}},
8507 PV => $stat->{P}{$ro->{statp}},
8511 #-> sub CPAN::Module::as_string ;
8515 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
8516 my $class = ref($self);
8517 $class =~ s/^CPAN:://;
8519 push @m, $class, " id = $self->{ID}\n";
8520 my $sprintf = " %-12s %s\n";
8521 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
8522 if $self->description;
8523 my $sprintf2 = " %-12s %s (%s)\n";
8525 $userid = $self->userid;
8528 if ($author = CPAN::Shell->expand('Author',$userid)) {
8531 if ($m = $author->email) {
8538 $author->fullname . $email
8542 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
8543 if $self->cpan_version;
8544 if (my $cpan_file = $self->cpan_file){
8545 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
8546 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
8547 my $upload_date = $dist->upload_date;
8549 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
8553 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
8554 my $dslip = $self->dslip_status;
8558 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
8560 my $local_file = $self->inst_file;
8561 unless ($self->{MANPAGE}) {
8564 $manpage = $self->manpage_headline($local_file);
8566 # If we have already untarred it, we should look there
8567 my $dist = $CPAN::META->instance('CPAN::Distribution',
8569 # warn "dist[$dist]";
8570 # mff=manifest file; mfh=manifest handle
8575 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
8577 $mfh = FileHandle->new($mff)
8579 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
8580 my $lfre = $self->id; # local file RE
8583 my($lfl); # local file file
8585 my(@mflines) = <$mfh>;
8590 while (length($lfre)>5 and !$lfl) {
8591 ($lfl) = grep /$lfre/, @mflines;
8592 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
8595 $lfl =~ s/\s.*//; # remove comments
8596 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
8597 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
8598 # warn "lfl_abs[$lfl_abs]";
8600 $manpage = $self->manpage_headline($lfl_abs);
8604 $self->{MANPAGE} = $manpage if $manpage;
8607 for $item (qw/MANPAGE/) {
8608 push @m, sprintf($sprintf, $item, $self->{$item})
8609 if exists $self->{$item};
8611 for $item (qw/CONTAINS/) {
8612 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
8613 if exists $self->{$item} && @{$self->{$item}};
8615 push @m, sprintf($sprintf, 'INST_FILE',
8616 $local_file || "(not installed)");
8617 push @m, sprintf($sprintf, 'INST_VERSION',
8618 $self->inst_version) if $local_file;
8622 sub manpage_headline {
8623 my($self,$local_file) = @_;
8624 my(@local_file) = $local_file;
8625 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
8626 push @local_file, $local_file;
8628 for $locf (@local_file) {
8629 next unless -f $locf;
8630 my $fh = FileHandle->new($locf)
8631 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
8635 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
8636 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
8653 #-> sub CPAN::Module::cpan_file ;
8654 # Note: also inherited by CPAN::Bundle
8657 # CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
8658 unless ($self->ro) {
8659 CPAN::Index->reload;
8662 if ($ro && defined $ro->{CPAN_FILE}){
8663 return $ro->{CPAN_FILE};
8665 my $userid = $self->userid;
8667 if ($CPAN::META->exists("CPAN::Author",$userid)) {
8668 my $author = $CPAN::META->instance("CPAN::Author",
8670 my $fullname = $author->fullname;
8671 my $email = $author->email;
8672 unless (defined $fullname && defined $email) {
8673 return sprintf("Contact Author %s",
8677 return "Contact Author $fullname <$email>";
8679 return "Contact Author $userid (Email address not available)";
8687 #-> sub CPAN::Module::cpan_version ;
8693 # Can happen with modules that are not on CPAN
8696 $ro->{CPAN_VERSION} = 'undef'
8697 unless defined $ro->{CPAN_VERSION};
8698 $ro->{CPAN_VERSION};
8701 #-> sub CPAN::Module::force ;
8704 $self->{'force_update'}++;
8709 # warn "XDEBUG: set notest for Module";
8710 $self->{'notest'}++;
8713 #-> sub CPAN::Module::rematein ;
8715 my($self,$meth) = @_;
8716 $CPAN::Frontend->myprint(sprintf("Running %s for module '%s'\n",
8719 my $cpan_file = $self->cpan_file;
8720 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
8721 $CPAN::Frontend->mywarn(sprintf qq{
8722 The module %s isn\'t available on CPAN.
8724 Either the module has not yet been uploaded to CPAN, or it is
8725 temporary unavailable. Please contact the author to find out
8726 more about the status. Try 'i %s'.
8733 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
8734 $pack->called_for($self->id);
8735 $pack->force($meth) if exists $self->{'force_update'};
8736 $pack->notest($meth) if exists $self->{'notest'};
8738 $pack->{reqtype} ||= "";
8739 CPAN->debug("dist-reqtype[$pack->{reqtype}]".
8740 "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG;
8741 if ($pack->{reqtype}) {
8742 if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) {
8743 $pack->{reqtype} = $self->{reqtype};
8745 exists $pack->{install}
8748 UNIVERSAL::can($pack->{install},"failed") ?
8749 $pack->{install}->failed :
8750 $pack->{install} =~ /^NO/
8753 delete $pack->{install};
8754 $CPAN::Frontend->mywarn
8755 ("Promoting $pack->{ID} from 'build_requires' to 'requires'");
8759 $pack->{reqtype} = $self->{reqtype};
8766 $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
8767 $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
8768 delete $self->{'force_update'};
8769 delete $self->{'notest'};
8775 #-> sub CPAN::Module::perldoc ;
8776 sub perldoc { shift->rematein('perldoc') }
8777 #-> sub CPAN::Module::readme ;
8778 sub readme { shift->rematein('readme') }
8779 #-> sub CPAN::Module::look ;
8780 sub look { shift->rematein('look') }
8781 #-> sub CPAN::Module::cvs_import ;
8782 sub cvs_import { shift->rematein('cvs_import') }
8783 #-> sub CPAN::Module::get ;
8784 sub get { shift->rematein('get',@_) }
8785 #-> sub CPAN::Module::make ;
8786 sub make { shift->rematein('make') }
8787 #-> sub CPAN::Module::test ;
8790 $self->{badtestcnt} ||= 0;
8791 $self->rematein('test',@_);
8793 #-> sub CPAN::Module::uptodate ;
8796 local($_); # protect against a bug in MakeMaker 6.17
8797 my($latest) = $self->cpan_version;
8799 my($inst_file) = $self->inst_file;
8801 if (defined $inst_file) {
8802 $have = $self->inst_version;
8807 ! CPAN::Version->vgt($latest, $have)
8809 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
8810 "latest[$latest] have[$have]") if $CPAN::DEBUG;
8815 #-> sub CPAN::Module::install ;
8821 not exists $self->{'force_update'}
8823 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
8825 $self->inst_version,
8831 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
8832 $CPAN::Frontend->mywarn(qq{
8833 \n\n\n ***WARNING***
8834 The module $self->{ID} has no active maintainer.\n\n\n
8836 $CPAN::Frontend->mysleep(5);
8838 $self->rematein('install') if $doit;
8840 #-> sub CPAN::Module::clean ;
8841 sub clean { shift->rematein('clean') }
8843 #-> sub CPAN::Module::inst_file ;
8846 $self->_file_in_path([@INC]);
8849 #-> sub CPAN::Module::available_file ;
8850 sub available_file {
8852 my $sep = $Config::Config{path_sep};
8853 my $perllib = $ENV{PERL5LIB};
8854 $perllib = $ENV{PERLLIB} unless defined $perllib;
8855 my @perllib = split(/$sep/,$perllib) if defined $perllib;
8856 $self->_file_in_path([@perllib,@INC]);
8859 #-> sub CPAN::Module::file_in_path ;
8861 my($self,$path) = @_;
8863 @packpath = split /::/, $self->{ID};
8864 $packpath[-1] .= ".pm";
8865 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
8866 unshift @packpath, "Term", "ReadLine"; # historical reasons
8868 foreach $dir (@$path) {
8869 my $pmfile = File::Spec->catfile($dir,@packpath);
8877 #-> sub CPAN::Module::xs_file ;
8881 @packpath = split /::/, $self->{ID};
8882 push @packpath, $packpath[-1];
8883 $packpath[-1] .= "." . $Config::Config{'dlext'};
8884 foreach $dir (@INC) {
8885 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
8893 #-> sub CPAN::Module::inst_version ;
8896 my $parsefile = $self->inst_file or return;
8897 my $have = $self->parse_version($parsefile);
8901 #-> sub CPAN::Module::inst_version ;
8902 sub available_version {
8904 my $parsefile = $self->available_file or return;
8905 my $have = $self->parse_version($parsefile);
8909 #-> sub CPAN::Module::parse_version ;
8911 my($self,$parsefile) = @_;
8912 my $have = MM->parse_version($parsefile);
8913 $have = "undef" unless defined $have && length $have;
8914 $have =~ s/^ //; # since the %vd hack these two lines here are needed
8915 $have =~ s/ $//; # trailing whitespace happens all the time
8917 $have = CPAN::Version->readable($have);
8919 $have =~ s/\s*//g; # stringify to float around floating point issues
8920 $have; # no stringify needed, \s* above matches always
8933 CPAN - query, download and build perl modules from CPAN sites
8939 perl -MCPAN -e shell;
8947 cpan> install Acme::Meta # in the shell
8949 CPAN::Shell->install("Acme::Meta"); # in perl
8953 cpan> install NWCLARK/Acme-Meta-0.02.tar.gz # in the shell
8956 install("NWCLARK/Acme-Meta-0.02.tar.gz"); # in perl
8960 $mo = CPAN::Shell->expandany($mod);
8961 $mo = CPAN::Shell->expand("Module",$mod); # same thing
8963 # distribution objects:
8965 $do = CPAN::Shell->expand("Module",$mod)->distribution;
8966 $do = CPAN::Shell->expandany($distro); # same thing
8967 $do = CPAN::Shell->expand("Distribution",
8968 $distro); # same thing
8972 This module and its competitor, the CPANPLUS module, are both much
8973 cooler than the other.
8975 =head1 COMPATIBILITY
8977 CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
8978 newer versions. It is getting more and more difficult to get the
8979 minimal prerequisites working on older perls. It is close to
8980 impossible to get the whole Bundle::CPAN working there. If you're in
8981 the position to have only these old versions, be advised that CPAN is
8982 designed to work fine without the Bundle::CPAN installed.
8984 To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
8985 compatible with ancient perls and that File::Temp is listed as a
8986 prerequisite but CPAN has reasonable workarounds if it is missing.
8990 The CPAN module is designed to automate the make and install of perl
8991 modules and extensions. It includes some primitive searching
8992 capabilities and knows how to use Net::FTP or LWP (or some external
8993 download clients) to fetch the raw data from the net.
8995 Modules are fetched from one or more of the mirrored CPAN
8996 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
8999 The CPAN module also supports the concept of named and versioned
9000 I<bundles> of modules. Bundles simplify the handling of sets of
9001 related modules. See Bundles below.
9003 The package contains a session manager and a cache manager. There is
9004 no status retained between sessions. The session manager keeps track
9005 of what has been fetched, built and installed in the current
9006 session. The cache manager keeps track of the disk space occupied by
9007 the make processes and deletes excess space according to a simple FIFO
9010 All methods provided are accessible in a programmer style and in an
9011 interactive shell style.
9013 =head2 CPAN::shell([$prompt, $command]) Starting Interactive Mode
9015 The interactive mode is entered by running
9017 perl -MCPAN -e shell
9019 which puts you into a readline interface. You will have the most fun if
9020 you install Term::ReadKey and Term::ReadLine to enjoy both history and
9023 Once you are on the command line, type 'h' and the rest should be
9026 The function call C<shell> takes two optional arguments, one is the
9027 prompt, the second is the default initial command line (the latter
9028 only works if a real ReadLine interface module is installed).
9030 The most common uses of the interactive modes are
9034 =item Searching for authors, bundles, distribution files and modules
9036 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
9037 for each of the four categories and another, C<i> for any of the
9038 mentioned four. Each of the four entities is implemented as a class
9039 with slightly differing methods for displaying an object.
9041 Arguments you pass to these commands are either strings exactly matching
9042 the identification string of an object or regular expressions that are
9043 then matched case-insensitively against various attributes of the
9044 objects. The parser recognizes a regular expression only if you
9045 enclose it between two slashes.
9047 The principle is that the number of found objects influences how an
9048 item is displayed. If the search finds one item, the result is
9049 displayed with the rather verbose method C<as_string>, but if we find
9050 more than one, we display each object with the terse method
9053 =item make, test, install, clean modules or distributions
9055 These commands take any number of arguments and investigate what is
9056 necessary to perform the action. If the argument is a distribution
9057 file name (recognized by embedded slashes), it is processed. If it is
9058 a module, CPAN determines the distribution file in which this module
9059 is included and processes that, following any dependencies named in
9060 the module's META.yml or Makefile.PL (this behavior is controlled by
9061 the configuration parameter C<prerequisites_policy>.)
9063 Any C<make> or C<test> are run unconditionally. An
9065 install <distribution_file>
9067 also is run unconditionally. But for
9071 CPAN checks if an install is actually needed for it and prints
9072 I<module up to date> in the case that the distribution file containing
9073 the module doesn't need to be updated.
9075 CPAN also keeps track of what it has done within the current session
9076 and doesn't try to build a package a second time regardless if it
9077 succeeded or not. The C<force> pragma may precede another command
9078 (currently: C<make>, C<test>, or C<install>) and executes the
9079 command from scratch and tries to continue in case of some errors.
9083 cpan> install OpenGL
9084 OpenGL is up to date.
9085 cpan> force install OpenGL
9088 OpenGL-0.4/COPYRIGHT
9091 The C<notest> pragma may be set to skip the test part in the build
9096 cpan> notest install Tk
9098 A C<clean> command results in a
9102 being executed within the distribution file's working directory.
9104 =item get, readme, perldoc, look module or distribution
9106 C<get> downloads a distribution file without further action. C<readme>
9107 displays the README file of the associated distribution. C<Look> gets
9108 and untars (if not yet done) the distribution file, changes to the
9109 appropriate directory and opens a subshell process in that directory.
9110 C<perldoc> displays the pod documentation of the module in html or
9115 =item ls globbing_expression
9117 The first form lists all distribution files in and below an author's
9118 CPAN directory as they are stored in the CHECKUMS files distributed on
9119 CPAN. The listing goes recursive into all subdirectories.
9121 The second form allows to limit or expand the output with shell
9122 globbing as in the following examples:
9128 The last example is very slow and outputs extra progress indicators
9129 that break the alignment of the result.
9131 Note that globbing only lists directories explicitly asked for, for
9132 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
9133 regarded as a bug and may be changed in future versions.
9137 The C<failed> command reports all distributions that failed on one of
9138 C<make>, C<test> or C<install> for some reason in the currently
9139 running shell session.
9143 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>.
9144 Batch jobs can run without a lockfile and do not disturb each other.
9146 The shell offers to run in I<degraded mode> when another process is
9147 holding the lockfile. This is an experimental feature that is not yet
9148 tested very well. This second shell then does not write the history
9149 file, does not use the metadata file and has a different prompt.
9153 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
9154 in the cpan-shell it is intended that you can press C<^C> anytime and
9155 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
9156 to clean up and leave the shell loop. You can emulate the effect of a
9157 SIGTERM by sending two consecutive SIGINTs, which usually means by
9158 pressing C<^C> twice.
9160 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
9161 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
9162 Build.PL> subprocess.
9168 The commands that are available in the shell interface are methods in
9169 the package CPAN::Shell. If you enter the shell command, all your
9170 input is split by the Text::ParseWords::shellwords() routine which
9171 acts like most shells do. The first word is being interpreted as the
9172 method to be called and the rest of the words are treated as arguments
9173 to this method. Continuation lines are supported if a line ends with a
9178 C<autobundle> writes a bundle file into the
9179 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
9180 a list of all modules that are both available from CPAN and currently
9181 installed within @INC. The name of the bundle file is based on the
9182 current date and a counter.
9186 This commands provides a statistical overview over recent download
9187 activities. The data for this is collected in the YAML file
9188 C<FTPstats.yml> in your C<cpan_home> directory. If no YAML module is
9189 configured or YAML not installed, then no stats are provided.
9193 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
9194 directory so that you can save your own preferences instead of the
9199 recompile() is a very special command in that it takes no argument and
9200 runs the make/test/install cycle with brute force over all installed
9201 dynamically loadable extensions (aka XS modules) with 'force' in
9202 effect. The primary purpose of this command is to finish a network
9203 installation. Imagine, you have a common source tree for two different
9204 architectures. You decide to do a completely independent fresh
9205 installation. You start on one architecture with the help of a Bundle
9206 file produced earlier. CPAN installs the whole Bundle for you, but
9207 when you try to repeat the job on the second architecture, CPAN
9208 responds with a C<"Foo up to date"> message for all modules. So you
9209 invoke CPAN's recompile on the second architecture and you're done.
9211 Another popular use for C<recompile> is to act as a rescue in case your
9212 perl breaks binary compatibility. If one of the modules that CPAN uses
9213 is in turn depending on binary compatibility (so you cannot run CPAN
9214 commands), then you should try the CPAN::Nox module for recovery.
9216 =head2 report Bundle|Distribution|Module
9218 The C<report> command temporarily turns on the C<test_report> config
9219 variable, then runs the C<force test> command with the given
9220 arguments. The C<force> pragma is used to re-run the tests and repeat
9221 every step that might have failed before.
9223 =head2 upgrade [Module|/Regex/]...
9225 The C<upgrade> command first runs an C<r> command with the given
9226 arguments and then installs the newest versions of all modules that
9227 were listed by that.
9229 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
9231 Although it may be considered internal, the class hierarchy does matter
9232 for both users and programmer. CPAN.pm deals with above mentioned four
9233 classes, and all those classes share a set of methods. A classical
9234 single polymorphism is in effect. A metaclass object registers all
9235 objects of all kinds and indexes them with a string. The strings
9236 referencing objects have a separated namespace (well, not completely
9241 words containing a "/" (slash) Distribution
9242 words starting with Bundle:: Bundle
9243 everything else Module or Author
9245 Modules know their associated Distribution objects. They always refer
9246 to the most recent official release. Developers may mark their releases
9247 as unstable development versions (by inserting an underbar into the
9248 module version number which will also be reflected in the distribution
9249 name when you run 'make dist'), so the really hottest and newest
9250 distribution is not always the default. If a module Foo circulates
9251 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
9252 way to install version 1.23 by saying
9256 This would install the complete distribution file (say
9257 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
9258 like to install version 1.23_90, you need to know where the
9259 distribution file resides on CPAN relative to the authors/id/
9260 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
9261 so you would have to say
9263 install BAR/Foo-1.23_90.tar.gz
9265 The first example will be driven by an object of the class
9266 CPAN::Module, the second by an object of class CPAN::Distribution.
9268 =head2 Integrating local directories
9270 Distribution objects are normally distributions from the CPAN, but
9271 there is a slightly degenerate case for Distribution objects, too,
9272 normally only needed by developers. If a distribution object ends with
9273 a dot or is a dot by itself, then it represents a local directory and
9274 all actions such as C<make>, C<test>, and C<install> are applied
9275 directly to that directory. This gives the command C<cpan .> an
9276 interesting touch: while the normal mantra of installing a CPAN module
9277 without CPAN.pm is one of
9279 perl Makefile.PL perl Build.PL
9280 ( go and get prerequisites )
9282 make test ./Build test
9283 make install ./Build install
9285 the command C<cpan .> does all of this at once. It figures out which
9286 of the two mantras is appropriate, fetches and installs all
9287 prerequisites, cares for them recursively and finally finishes the
9288 installation of the module in the current directory, be it a CPAN
9291 =head1 PROGRAMMER'S INTERFACE
9293 If you do not enter the shell, the available shell commands are both
9294 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
9295 functions in the calling package (C<install(...)>). Before calling low-level
9296 commands it makes sense to initialize components of CPAN you need, e.g.:
9298 CPAN::HandleConfig->load;
9299 CPAN::Shell::setup_output;
9300 CPAN::Index->reload;
9302 High-level commands do such initializations automatically.
9304 There's currently only one class that has a stable interface -
9305 CPAN::Shell. All commands that are available in the CPAN shell are
9306 methods of the class CPAN::Shell. Each of the commands that produce
9307 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
9308 the IDs of all modules within the list.
9312 =item expand($type,@things)
9314 The IDs of all objects available within a program are strings that can
9315 be expanded to the corresponding real objects with the
9316 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
9317 list of CPAN::Module objects according to the C<@things> arguments
9318 given. In scalar context it only returns the first element of the
9321 =item expandany(@things)
9323 Like expand, but returns objects of the appropriate type, i.e.
9324 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
9325 CPAN::Distribution objects for distributions. Note: it does not expand
9326 to CPAN::Author objects.
9328 =item Programming Examples
9330 This enables the programmer to do operations that combine
9331 functionalities that are available in the shell.
9333 # install everything that is outdated on my disk:
9334 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
9336 # install my favorite programs if necessary:
9337 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
9338 CPAN::Shell->install($mod);
9341 # list all modules on my disk that have no VERSION number
9342 for $mod (CPAN::Shell->expand("Module","/./")){
9343 next unless $mod->inst_file;
9344 # MakeMaker convention for undefined $VERSION:
9345 next unless $mod->inst_version eq "undef";
9346 print "No VERSION in ", $mod->id, "\n";
9349 # find out which distribution on CPAN contains a module:
9350 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
9352 Or if you want to write a cronjob to watch The CPAN, you could list
9353 all modules that need updating. First a quick and dirty way:
9355 perl -e 'use CPAN; CPAN::Shell->r;'
9357 If you don't want to get any output in the case that all modules are
9358 up to date, you can parse the output of above command for the regular
9359 expression //modules are up to date// and decide to mail the output
9360 only if it doesn't match. Ick?
9362 If you prefer to do it more in a programmer style in one single
9363 process, maybe something like this suits you better:
9365 # list all modules on my disk that have newer versions on CPAN
9366 for $mod (CPAN::Shell->expand("Module","/./")){
9367 next unless $mod->inst_file;
9368 next if $mod->uptodate;
9369 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
9370 $mod->id, $mod->inst_version, $mod->cpan_version;
9373 If that gives you too much output every day, you maybe only want to
9374 watch for three modules. You can write
9376 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
9378 as the first line instead. Or you can combine some of the above
9381 # watch only for a new mod_perl module
9382 $mod = CPAN::Shell->expand("Module","mod_perl");
9383 exit if $mod->uptodate;
9384 # new mod_perl arrived, let me know all update recommendations
9389 =head2 Methods in the other Classes
9393 =item CPAN::Author::as_glimpse()
9395 Returns a one-line description of the author
9397 =item CPAN::Author::as_string()
9399 Returns a multi-line description of the author
9401 =item CPAN::Author::email()
9403 Returns the author's email address
9405 =item CPAN::Author::fullname()
9407 Returns the author's name
9409 =item CPAN::Author::name()
9411 An alias for fullname
9413 =item CPAN::Bundle::as_glimpse()
9415 Returns a one-line description of the bundle
9417 =item CPAN::Bundle::as_string()
9419 Returns a multi-line description of the bundle
9421 =item CPAN::Bundle::clean()
9423 Recursively runs the C<clean> method on all items contained in the bundle.
9425 =item CPAN::Bundle::contains()
9427 Returns a list of objects' IDs contained in a bundle. The associated
9428 objects may be bundles, modules or distributions.
9430 =item CPAN::Bundle::force($method,@args)
9432 Forces CPAN to perform a task that it normally would have refused to
9433 do. Force takes as arguments a method name to be called and any number
9434 of additional arguments that should be passed to the called method.
9435 The internals of the object get the needed changes so that CPAN.pm
9436 does not refuse to take the action. The C<force> is passed recursively
9437 to all contained objects.
9439 =item CPAN::Bundle::get()
9441 Recursively runs the C<get> method on all items contained in the bundle
9443 =item CPAN::Bundle::inst_file()
9445 Returns the highest installed version of the bundle in either @INC or
9446 C<$CPAN::Config->{cpan_home}>. Note that this is different from
9447 CPAN::Module::inst_file.
9449 =item CPAN::Bundle::inst_version()
9451 Like CPAN::Bundle::inst_file, but returns the $VERSION
9453 =item CPAN::Bundle::uptodate()
9455 Returns 1 if the bundle itself and all its members are uptodate.
9457 =item CPAN::Bundle::install()
9459 Recursively runs the C<install> method on all items contained in the bundle
9461 =item CPAN::Bundle::make()
9463 Recursively runs the C<make> method on all items contained in the bundle
9465 =item CPAN::Bundle::readme()
9467 Recursively runs the C<readme> method on all items contained in the bundle
9469 =item CPAN::Bundle::test()
9471 Recursively runs the C<test> method on all items contained in the bundle
9473 =item CPAN::Distribution::as_glimpse()
9475 Returns a one-line description of the distribution
9477 =item CPAN::Distribution::as_string()
9479 Returns a multi-line description of the distribution
9481 =item CPAN::Distribution::author
9483 Returns the CPAN::Author object of the maintainer who uploaded this
9486 =item CPAN::Distribution::clean()
9488 Changes to the directory where the distribution has been unpacked and
9489 runs C<make clean> there.
9491 =item CPAN::Distribution::containsmods()
9493 Returns a list of IDs of modules contained in a distribution file.
9494 Only works for distributions listed in the 02packages.details.txt.gz
9495 file. This typically means that only the most recent version of a
9496 distribution is covered.
9498 =item CPAN::Distribution::cvs_import()
9500 Changes to the directory where the distribution has been unpacked and
9503 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
9507 =item CPAN::Distribution::dir()
9509 Returns the directory into which this distribution has been unpacked.
9511 =item CPAN::Distribution::force($method,@args)
9513 Forces CPAN to perform a task that normally would have failed. Force
9514 takes as arguments a method name to be called and any number of
9515 additional arguments that should be passed to the called method. The
9516 internals of the object get the needed changes so that CPAN.pm does
9517 not refuse to take the action.
9519 =item CPAN::Distribution::get()
9521 Downloads the distribution from CPAN and unpacks it. Does nothing if
9522 the distribution has already been downloaded and unpacked within the
9525 =item CPAN::Distribution::install()
9527 Changes to the directory where the distribution has been unpacked and
9528 runs the external command C<make install> there. If C<make> has not
9529 yet been run, it will be run first. A C<make test> will be issued in
9530 any case and if this fails, the install will be canceled. The
9531 cancellation can be avoided by letting C<force> run the C<install> for
9534 This install method has only the power to install the distribution if
9535 there are no dependencies in the way. To install an object and all of
9536 its dependencies, use CPAN::Shell->install.
9538 Note that install() gives no meaningful return value. See uptodate().
9540 =item CPAN::Distribution::isa_perl()
9542 Returns 1 if this distribution file seems to be a perl distribution.
9543 Normally this is derived from the file name only, but the index from
9544 CPAN can contain a hint to achieve a return value of true for other
9547 =item CPAN::Distribution::look()
9549 Changes to the directory where the distribution has been unpacked and
9550 opens a subshell there. Exiting the subshell returns.
9552 =item CPAN::Distribution::make()
9554 First runs the C<get> method to make sure the distribution is
9555 downloaded and unpacked. Changes to the directory where the
9556 distribution has been unpacked and runs the external commands C<perl
9557 Makefile.PL> or C<perl Build.PL> and C<make> there.
9559 =item CPAN::Distribution::perldoc()
9561 Downloads the pod documentation of the file associated with a
9562 distribution (in html format) and runs it through the external
9563 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
9564 isn't available, it converts it to plain text with external
9565 command html2text and runs it through the pager specified
9566 in C<$CPAN::Config->{pager}>
9568 =item CPAN::Distribution::prefs()
9570 Returns the hash reference from the first matching YAML file that the
9571 user has deposited in the C<prefs_dir/> directory. The first
9572 succeeding match wins. The files in the C<prefs_dir/> are processed
9573 alphabetically and the canonical distroname (e.g.
9574 AUTHOR/Foo-Bar-3.14.tar.gz) is matched against the regular expressions
9575 stored in the $root->{match}{distribution} attribute value.
9576 Additionally all module names contained in a distribution are matched
9577 agains the regular expressions in the $root->{match}{module} attribute
9578 value. The two match values are ANDed together. Each of the two
9579 attributes are optional.
9581 =item CPAN::Distribution::prereq_pm()
9583 Returns the hash reference that has been announced by a distribution
9584 as the merge of the C<requires> element and the C<build_requires>
9585 element of the META.yml or the C<PREREQ_PM> hash in the
9586 C<Makefile.PL>. Note: works only after an attempt has been made to
9587 C<make> the distribution. Returns undef otherwise.
9589 =item CPAN::Distribution::readme()
9591 Downloads the README file associated with a distribution and runs it
9592 through the pager specified in C<$CPAN::Config->{pager}>.
9594 =item CPAN::Distribution::read_yaml()
9596 Returns the content of the META.yml of this distro as a hashref. Note:
9597 works only after an attempt has been made to C<make> the distribution.
9598 Returns undef otherwise. Also returns undef if the content of META.yml
9601 =item CPAN::Distribution::test()
9603 Changes to the directory where the distribution has been unpacked and
9604 runs C<make test> there.
9606 =item CPAN::Distribution::uptodate()
9608 Returns 1 if all the modules contained in the distribution are
9609 uptodate. Relies on containsmods.
9611 =item CPAN::Index::force_reload()
9613 Forces a reload of all indices.
9615 =item CPAN::Index::reload()
9617 Reloads all indices if they have not been read for more than
9618 C<$CPAN::Config->{index_expire}> days.
9620 =item CPAN::InfoObj::dump()
9622 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
9623 inherit this method. It prints the data structure associated with an
9624 object. Useful for debugging. Note: the data structure is considered
9625 internal and thus subject to change without notice.
9627 =item CPAN::Module::as_glimpse()
9629 Returns a one-line description of the module in four columns: The
9630 first column contains the word C<Module>, the second column consists
9631 of one character: an equals sign if this module is already installed
9632 and uptodate, a less-than sign if this module is installed but can be
9633 upgraded, and a space if the module is not installed. The third column
9634 is the name of the module and the fourth column gives maintainer or
9635 distribution information.
9637 =item CPAN::Module::as_string()
9639 Returns a multi-line description of the module
9641 =item CPAN::Module::clean()
9643 Runs a clean on the distribution associated with this module.
9645 =item CPAN::Module::cpan_file()
9647 Returns the filename on CPAN that is associated with the module.
9649 =item CPAN::Module::cpan_version()
9651 Returns the latest version of this module available on CPAN.
9653 =item CPAN::Module::cvs_import()
9655 Runs a cvs_import on the distribution associated with this module.
9657 =item CPAN::Module::description()
9659 Returns a 44 character description of this module. Only available for
9660 modules listed in The Module List (CPAN/modules/00modlist.long.html
9661 or 00modlist.long.txt.gz)
9663 =item CPAN::Module::distribution()
9665 Returns the CPAN::Distribution object that contains the current
9666 version of this module.
9668 =item CPAN::Module::dslip_status()
9670 Returns a hash reference. The keys of the hash are the letters C<D>,
9671 C<S>, C<L>, C<I>, and <P>, for development status, support level,
9672 language, interface and public licence respectively. The data for the
9673 DSLIP status are collected by pause.perl.org when authors register
9674 their namespaces. The values of the 5 hash elements are one-character
9675 words whose meaning is described in the table below. There are also 5
9676 hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
9677 verbose value of the 5 status variables.
9679 Where the 'DSLIP' characters have the following meanings:
9681 D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
9682 i - Idea, listed to gain consensus or as a placeholder
9683 c - under construction but pre-alpha (not yet released)
9684 a/b - Alpha/Beta testing
9686 M - Mature (no rigorous definition)
9687 S - Standard, supplied with Perl 5
9692 u - Usenet newsgroup comp.lang.perl.modules
9693 n - None known, try comp.lang.perl.modules
9694 a - abandoned; volunteers welcome to take over maintainance
9697 p - Perl-only, no compiler needed, should be platform independent
9698 c - C and perl, a C compiler will be needed
9699 h - Hybrid, written in perl with optional C code, no compiler needed
9700 + - C++ and perl, a C++ compiler will be needed
9701 o - perl and another language other than C or C++
9704 f - plain Functions, no references used
9705 h - hybrid, object and function interfaces available
9706 n - no interface at all (huh?)
9707 r - some use of unblessed References or ties
9708 O - Object oriented using blessed references and/or inheritance
9711 p - Standard-Perl: user may choose between GPL and Artistic
9712 g - GPL: GNU General Public License
9713 l - LGPL: "GNU Lesser General Public License" (previously known as
9714 "GNU Library General Public License")
9715 b - BSD: The BSD License
9716 a - Artistic license alone
9717 o - open source: appoved by www.opensource.org
9718 d - allows distribution without restrictions
9719 r - restricted distribtion
9720 n - no license at all
9722 =item CPAN::Module::force($method,@args)
9724 Forces CPAN to perform a task that normally would have failed. Force
9725 takes as arguments a method name to be called and any number of
9726 additional arguments that should be passed to the called method. The
9727 internals of the object get the needed changes so that CPAN.pm does
9728 not refuse to take the action.
9730 =item CPAN::Module::get()
9732 Runs a get on the distribution associated with this module.
9734 =item CPAN::Module::inst_file()
9736 Returns the filename of the module found in @INC. The first file found
9737 is reported just like perl itself stops searching @INC when it finds a
9740 =item CPAN::Module::available_file()
9742 Returns the filename of the module found in PERL5LIB or @INC. The
9743 first file found is reported. The advantage of this method over
9744 C<inst_file> is that modules that have been tested but not yet
9745 installed are included because PERL5LIB keeps track of tested modules.
9747 =item CPAN::Module::inst_version()
9749 Returns the version number of the installed module in readable format.
9751 =item CPAN::Module::available_version()
9753 Returns the version number of the available module in readable format.
9755 =item CPAN::Module::install()
9757 Runs an C<install> on the distribution associated with this module.
9759 =item CPAN::Module::look()
9761 Changes to the directory where the distribution associated with this
9762 module has been unpacked and opens a subshell there. Exiting the
9765 =item CPAN::Module::make()
9767 Runs a C<make> on the distribution associated with this module.
9769 =item CPAN::Module::manpage_headline()
9771 If module is installed, peeks into the module's manpage, reads the
9772 headline and returns it. Moreover, if the module has been downloaded
9773 within this session, does the equivalent on the downloaded module even
9774 if it is not installed.
9776 =item CPAN::Module::perldoc()
9778 Runs a C<perldoc> on this module.
9780 =item CPAN::Module::readme()
9782 Runs a C<readme> on the distribution associated with this module.
9784 =item CPAN::Module::test()
9786 Runs a C<test> on the distribution associated with this module.
9788 =item CPAN::Module::uptodate()
9790 Returns 1 if the module is installed and up-to-date.
9792 =item CPAN::Module::userid()
9794 Returns the author's ID of the module.
9798 =head2 Cache Manager
9800 Currently the cache manager only keeps track of the build directory
9801 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
9802 deletes complete directories below C<build_dir> as soon as the size of
9803 all directories there gets bigger than $CPAN::Config->{build_cache}
9804 (in MB). The contents of this cache may be used for later
9805 re-installations that you intend to do manually, but will never be
9806 trusted by CPAN itself. This is due to the fact that the user might
9807 use these directories for building modules on different architectures.
9809 There is another directory ($CPAN::Config->{keep_source_where}) where
9810 the original distribution files are kept. This directory is not
9811 covered by the cache manager and must be controlled by the user. If
9812 you choose to have the same directory as build_dir and as
9813 keep_source_where directory, then your sources will be deleted with
9814 the same fifo mechanism.
9818 A bundle is just a perl module in the namespace Bundle:: that does not
9819 define any functions or methods. It usually only contains documentation.
9821 It starts like a perl module with a package declaration and a $VERSION
9822 variable. After that the pod section looks like any other pod with the
9823 only difference being that I<one special pod section> exists starting with
9828 In this pod section each line obeys the format
9830 Module_Name [Version_String] [- optional text]
9832 The only required part is the first field, the name of a module
9833 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
9834 of the line is optional. The comment part is delimited by a dash just
9835 as in the man page header.
9837 The distribution of a bundle should follow the same convention as
9838 other distributions.
9840 Bundles are treated specially in the CPAN package. If you say 'install
9841 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
9842 the modules in the CONTENTS section of the pod. You can install your
9843 own Bundles locally by placing a conformant Bundle file somewhere into
9844 your @INC path. The autobundle() command which is available in the
9845 shell interface does that for you by including all currently installed
9846 modules in a snapshot bundle file.
9848 =head1 PREREQUISITES
9850 If you have a local mirror of CPAN and can access all files with
9851 "file:" URLs, then you only need a perl better than perl5.003 to run
9852 this module. Otherwise Net::FTP is strongly recommended. LWP may be
9853 required for non-UNIX systems or if your nearest CPAN site is
9854 associated with a URL that is not C<ftp:>.
9856 If you have neither Net::FTP nor LWP, there is a fallback mechanism
9857 implemented for an external ftp command or for an external lynx
9862 =head2 Finding packages and VERSION
9864 This module presumes that all packages on CPAN
9870 declare their $VERSION variable in an easy to parse manner. This
9871 prerequisite can hardly be relaxed because it consumes far too much
9872 memory to load all packages into the running program just to determine
9873 the $VERSION variable. Currently all programs that are dealing with
9874 version use something like this
9876 perl -MExtUtils::MakeMaker -le \
9877 'print MM->parse_version(shift)' filename
9879 If you are author of a package and wonder if your $VERSION can be
9880 parsed, please try the above method.
9884 come as compressed or gzipped tarfiles or as zip files and contain a
9885 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
9886 without much enthusiasm).
9892 The debugging of this module is a bit complex, because we have
9893 interferences of the software producing the indices on CPAN, of the
9894 mirroring process on CPAN, of packaging, of configuration, of
9895 synchronicity, and of bugs within CPAN.pm.
9897 For debugging the code of CPAN.pm itself in interactive mode some more
9898 or less useful debugging aid can be turned on for most packages within
9903 =item o debug package...
9905 sets debug mode for packages.
9907 =item o debug -package...
9909 unsets debug mode for packages.
9913 turns debugging on for all packages.
9915 =item o debug number
9919 which sets the debugging packages directly. Note that C<o debug 0>
9920 turns debugging off.
9922 What seems quite a successful strategy is the combination of C<reload
9923 cpan> and the debugging switches. Add a new debug statement while
9924 running in the shell and then issue a C<reload cpan> and see the new
9925 debugging messages immediately without losing the current context.
9927 C<o debug> without an argument lists the valid package names and the
9928 current set of packages in debugging mode. C<o debug> has built-in
9931 For debugging of CPAN data there is the C<dump> command which takes
9932 the same arguments as make/test/install and outputs each object's
9933 Data::Dumper dump. If an argument looks like a perl variable and
9934 contains one of C<$>, C<@> or C<%>, it is eval()ed and fed to
9935 Data::Dumper directly.
9937 =head2 Floppy, Zip, Offline Mode
9939 CPAN.pm works nicely without network too. If you maintain machines
9940 that are not networked at all, you should consider working with file:
9941 URLs. Of course, you have to collect your modules somewhere first. So
9942 you might use CPAN.pm to put together all you need on a networked
9943 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
9944 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
9945 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
9946 with this floppy. See also below the paragraph about CD-ROM support.
9948 =head2 Basic Utilities for Programmers
9952 =item has_inst($module)
9954 Returns true if the module is installed. See the source for details.
9956 =item has_usable($module)
9958 Returns true if the module is installed and several and is in a usable
9959 state. Only useful for a handful of modules that are used internally.
9960 See the source for details.
9962 =item instance($module)
9964 The constructor for all the singletons used to represent modules,
9965 distributions, authors and bundles. If the object already exists, this
9966 method returns the object, otherwise it calls the constructor.
9970 =head1 CONFIGURATION
9972 When the CPAN module is used for the first time, a configuration
9973 dialog tries to determine a couple of site specific options. The
9974 result of the dialog is stored in a hash reference C< $CPAN::Config >
9975 in a file CPAN/Config.pm.
9977 The default values defined in the CPAN/Config.pm file can be
9978 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
9979 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
9980 added to the search path of the CPAN module before the use() or
9981 require() statements. The mkmyconfig command writes this file for you.
9983 The C<o conf> command has various bells and whistles:
9987 =item completion support
9989 If you have a ReadLine module installed, you can hit TAB at any point
9990 of the commandline and C<o conf> will offer you completion for the
9991 built-in subcommands and/or config variable names.
9993 =item displaying some help: o conf help
9995 Displays a short help
9997 =item displaying current values: o conf [KEY]
9999 Displays the current value(s) for this config variable. Without KEY
10000 displays all subcommands and config variables.
10006 =item changing of scalar values: o conf KEY VALUE
10008 Sets the config variable KEY to VALUE. The empty string can be
10009 specified as usual in shells, with C<''> or C<"">
10013 o conf wget /usr/bin/wget
10015 =item changing of list values: o conf KEY SHIFT|UNSHIFT|PUSH|POP|SPLICE|LIST
10017 If a config variable name ends with C<list>, it is a list. C<o conf
10018 KEY shift> removes the first element of the list, C<o conf KEY pop>
10019 removes the last element of the list. C<o conf KEYS unshift LIST>
10020 prepends a list of values to the list, C<o conf KEYS push LIST>
10021 appends a list of valued to the list.
10023 Likewise, C<o conf KEY splice LIST> passes the LIST to the according
10026 Finally, any other list of arguments is taken as a new list value for
10027 the KEY variable discarding the previous value.
10031 o conf urllist unshift http://cpan.dev.local/CPAN
10032 o conf urllist splice 3 1
10033 o conf urllist http://cpan1.local http://cpan2.local ftp://ftp.perl.org
10035 =item interactive editing: o conf init [MATCH|LIST]
10037 Runs an interactive configuration dialog for matching variables.
10038 Without argument runs the dialog over all supported config variables.
10039 To specify a MATCH the argument must be enclosed by slashes.
10043 o conf init ftp_passive ftp_proxy
10044 o conf init /color/
10046 =item reverting to saved: o conf defaults
10048 Reverts all config variables to the state in the saved config file.
10050 =item saving the config: o conf commit
10052 Saves all config variables to the current config file (CPAN/Config.pm
10053 or CPAN/MyConfig.pm that was loaded at start).
10057 The configuration dialog can be started any time later again by
10058 issuing the command C< o conf init > in the CPAN shell. A subset of
10059 the configuration dialog can be run by issuing C<o conf init WORD>
10060 where WORD is any valid config variable or a regular expression.
10062 =head2 Config Variables
10064 Currently the following keys in the hash reference $CPAN::Config are
10067 build_cache size of cache for directories to build modules
10068 build_dir locally accessible directory to build modules
10069 build_dir_reuse boolean if distros in build_dir are persistent
10070 build_requires_install_policy
10071 to install or not to install: when a module is
10072 only needed for building. yes|no|ask/yes|ask/no
10073 bzip2 path to external prg
10074 cache_metadata use serializer to cache metadata
10075 commands_quote prefered character to use for quoting external
10076 commands when running them. Defaults to double
10077 quote on Windows, single tick everywhere else;
10078 can be set to space to disable quoting
10079 check_sigs if signatures should be verified
10080 colorize_output boolean if Term::ANSIColor should colorize output
10081 colorize_print Term::ANSIColor attributes for normal output
10082 colorize_warn Term::ANSIColor attributes for warnings
10083 commandnumber_in_prompt
10084 boolean if you want to see current command number
10085 cpan_home local directory reserved for this package
10086 curl path to external prg
10087 dontload_hash DEPRECATED
10088 dontload_list arrayref: modules in the list will not be
10089 loaded by the CPAN::has_inst() routine
10090 ftp path to external prg
10091 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
10092 ftp_proxy proxy host for ftp requests
10094 gpg path to external prg
10095 gzip location of external program gzip
10096 histfile file to maintain history between sessions
10097 histsize maximum number of lines to keep in histfile
10098 http_proxy proxy host for http requests
10099 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
10100 after this many seconds inactivity. Set to 0 to
10102 index_expire after this many days refetch index files
10103 inhibit_startup_message
10104 if true, does not print the startup message
10105 keep_source_where directory in which to keep the source (if we do)
10106 lynx path to external prg
10107 make location of external make program
10108 make_arg arguments that should always be passed to 'make'
10109 make_install_make_command
10110 the make command for running 'make install', for
10111 example 'sudo make'
10112 make_install_arg same as make_arg for 'make install'
10113 makepl_arg arguments passed to 'perl Makefile.PL'
10114 mbuild_arg arguments passed to './Build'
10115 mbuild_install_arg arguments passed to './Build install'
10116 mbuild_install_build_command
10117 command to use instead of './Build' when we are
10118 in the install stage, for example 'sudo ./Build'
10119 mbuildpl_arg arguments passed to 'perl Build.PL'
10120 ncftp path to external prg
10121 ncftpget path to external prg
10122 no_proxy don't proxy to these hosts/domains (comma separated list)
10123 pager location of external program more (or any pager)
10124 password your password if you CPAN server wants one
10125 patch path to external prg
10126 prefer_installer legal values are MB and EUMM: if a module comes
10127 with both a Makefile.PL and a Build.PL, use the
10128 former (EUMM) or the latter (MB); if the module
10129 comes with only one of the two, that one will be
10131 prerequisites_policy
10132 what to do if you are missing module prerequisites
10133 ('follow' automatically, 'ask' me, or 'ignore')
10134 prefs_dir local directory to store per-distro build options
10135 proxy_user username for accessing an authenticating proxy
10136 proxy_pass password for accessing an authenticating proxy
10137 randomize_urllist add some randomness to the sequence of the urllist
10138 scan_cache controls scanning of cache ('atstart' or 'never')
10139 shell your favorite shell
10140 show_upload_date boolean if commands should try to determine upload date
10141 tar location of external program tar
10142 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
10143 (and nonsense for characters outside latin range)
10144 term_ornaments boolean to turn ReadLine ornamenting on/off
10145 test_report email test reports (if CPAN::Reporter is installed)
10146 unzip location of external program unzip
10147 urllist arrayref to nearby CPAN sites (or equivalent locations)
10148 use_sqlite use CPAN::SQLite for metadata storage (fast and lean)
10149 username your username if you CPAN server wants one
10150 wait_list arrayref to a wait server to try (See CPAN::WAIT)
10151 wget path to external prg
10152 yaml_module which module to use to read/write YAML files
10154 You can set and query each of these options interactively in the cpan
10155 shell with the command set defined within the C<o conf> command:
10159 =item C<o conf E<lt>scalar optionE<gt>>
10161 prints the current value of the I<scalar option>
10163 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
10165 Sets the value of the I<scalar option> to I<value>
10167 =item C<o conf E<lt>list optionE<gt>>
10169 prints the current value of the I<list option> in MakeMaker's
10172 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
10174 shifts or pops the array in the I<list option> variable
10176 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
10178 works like the corresponding perl commands.
10182 =head2 CPAN::anycwd($path): Note on config variable getcwd
10184 CPAN.pm changes the current working directory often and needs to
10185 determine its own current working directory. Per default it uses
10186 Cwd::cwd but if this doesn't work on your system for some reason,
10187 alternatives can be configured according to the following table:
10205 Calls the external command cwd.
10209 =head2 Note on the format of the urllist parameter
10211 urllist parameters are URLs according to RFC 1738. We do a little
10212 guessing if your URL is not compliant, but if you have problems with
10213 C<file> URLs, please try the correct format. Either:
10215 file://localhost/whatever/ftp/pub/CPAN/
10219 file:///home/ftp/pub/CPAN/
10221 =head2 urllist parameter has CD-ROM support
10223 The C<urllist> parameter of the configuration table contains a list of
10224 URLs that are to be used for downloading. If the list contains any
10225 C<file> URLs, CPAN always tries to get files from there first. This
10226 feature is disabled for index files. So the recommendation for the
10227 owner of a CD-ROM with CPAN contents is: include your local, possibly
10228 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
10230 o conf urllist push file://localhost/CDROM/CPAN
10232 CPAN.pm will then fetch the index files from one of the CPAN sites
10233 that come at the beginning of urllist. It will later check for each
10234 module if there is a local copy of the most recent version.
10236 Another peculiarity of urllist is that the site that we could
10237 successfully fetch the last file from automatically gets a preference
10238 token and is tried as the first site for the next request. So if you
10239 add a new site at runtime it may happen that the previously preferred
10240 site will be tried another time. This means that if you want to disallow
10241 a site for the next transfer, it must be explicitly removed from
10244 =head2 Maintaining the urllist parameter
10246 If you have YAML.pm (or some other YAML module configured in
10247 C<yaml_module>) installed, CPAN.pm collects a few statistical data
10248 about recent downloads. You can view the statistics with the C<hosts>
10249 command or inspect them directly by looking into the C<FTPstats.yml>
10250 file in your C<cpan_home> directory.
10252 To get some interesting statistics it is recommended to set the
10253 C<randomize_urllist> parameter that introduces some amount of
10254 randomness into the URL selection.
10256 =head2 prefs_dir for avoiding interactive questions (ALPHA)
10258 (B<Note:> This feature has been introduced in CPAN.pm 1.8854 and is
10259 still considered experimental and may still be changed)
10261 The files in the directory specified in C<prefs_dir> are YAML files
10262 that specify how CPAN.pm shall treat distributions that deviate from
10263 the normal non-interactive model of building and installing CPAN
10266 Some modules try to get some data from the user interactively thus
10267 disturbing the installation of large bundles like Phalanx100 or
10268 modules like Plagger.
10270 CPAN.pm can use YAML files to either pass additional arguments to one
10271 of the four commands, set environment variables or instantiate an
10272 Expect object that reads from the console and enters answers on your
10273 behalf (latter option requires Expect.pm installed). A further option
10274 is to apply patches from the local disk or from CPAN.
10276 CPAN.pm comes with a couple of such YAML files. The structure is
10277 currently not documented because in flux. Please see the distroprefs
10278 directory of the CPAN distribution for examples and follow the README
10281 Please note that setting the environment variable PERL_MM_USE_DEFAULT
10282 to a true value can also get you a long way if you want to always pick
10283 the default answers. But this only works if the author of a package
10284 used the prompt function provided by ExtUtils::MakeMaker and if the
10285 defaults are OK for you.
10289 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
10290 install foreign, unmasked, unsigned code on your machine. We compare
10291 to a checksum that comes from the net just as the distribution file
10292 itself. But we try to make it easy to add security on demand:
10294 =head2 Cryptographically signed modules
10296 Since release 1.77 CPAN.pm has been able to verify cryptographically
10297 signed module distributions using Module::Signature. The CPAN modules
10298 can be signed by their authors, thus giving more security. The simple
10299 unsigned MD5 checksums that were used before by CPAN protect mainly
10300 against accidental file corruption.
10302 You will need to have Module::Signature installed, which in turn
10303 requires that you have at least one of Crypt::OpenPGP module or the
10304 command-line F<gpg> tool installed.
10306 You will also need to be able to connect over the Internet to the public
10307 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
10309 The configuration parameter check_sigs is there to turn signature
10310 checking on or off.
10314 Most functions in package CPAN are exported per default. The reason
10315 for this is that the primary use is intended for the cpan shell or for
10320 When the CPAN shell enters a subshell via the look command, it sets
10321 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
10324 When CPAN runs, it sets the environment variable PERL5_CPAN_IS_RUNNING.
10326 When the config variable ftp_passive is set, all downloads will be run
10327 with the environment variable FTP_PASSIVE set to this value. This is
10328 in general a good idea as it influences both Net::FTP and LWP based
10329 connections. The same effect can be achieved by starting the cpan
10330 shell with this environment variable set. For Net::FTP alone, one can
10331 also always set passive mode by running libnetcfg.
10333 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
10335 Populating a freshly installed perl with my favorite modules is pretty
10336 easy if you maintain a private bundle definition file. To get a useful
10337 blueprint of a bundle definition file, the command autobundle can be used
10338 on the CPAN shell command line. This command writes a bundle definition
10339 file for all modules that are installed for the currently running perl
10340 interpreter. It's recommended to run this command only once and from then
10341 on maintain the file manually under a private name, say
10342 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
10344 cpan> install Bundle::my_bundle
10346 then answer a few questions and then go out for a coffee.
10348 Maintaining a bundle definition file means keeping track of two
10349 things: dependencies and interactivity. CPAN.pm sometimes fails on
10350 calculating dependencies because not all modules define all MakeMaker
10351 attributes correctly, so a bundle definition file should specify
10352 prerequisites as early as possible. On the other hand, it's a bit
10353 annoying that many distributions need some interactive configuring. So
10354 what I try to accomplish in my private bundle file is to have the
10355 packages that need to be configured early in the file and the gentle
10356 ones later, so I can go out after a few minutes and leave CPAN.pm
10359 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
10361 Thanks to Graham Barr for contributing the following paragraphs about
10362 the interaction between perl, and various firewall configurations. For
10363 further information on firewalls, it is recommended to consult the
10364 documentation that comes with the ncftp program. If you are unable to
10365 go through the firewall with a simple Perl setup, it is very likely
10366 that you can configure ncftp so that it works for your firewall.
10368 =head2 Three basic types of firewalls
10370 Firewalls can be categorized into three basic types.
10374 =item http firewall
10376 This is where the firewall machine runs a web server and to access the
10377 outside world you must do it via the web server. If you set environment
10378 variables like http_proxy or ftp_proxy to a values beginning with http://
10379 or in your web browser you have to set proxy information then you know
10380 you are running an http firewall.
10382 To access servers outside these types of firewalls with perl (even for
10383 ftp) you will need to use LWP.
10387 This where the firewall machine runs an ftp server. This kind of
10388 firewall will only let you access ftp servers outside the firewall.
10389 This is usually done by connecting to the firewall with ftp, then
10390 entering a username like "user@outside.host.com"
10392 To access servers outside these type of firewalls with perl you
10393 will need to use Net::FTP.
10395 =item One way visibility
10397 I say one way visibility as these firewalls try to make themselves look
10398 invisible to the users inside the firewall. An FTP data connection is
10399 normally created by sending the remote server your IP address and then
10400 listening for the connection. But the remote server will not be able to
10401 connect to you because of the firewall. So for these types of firewall
10402 FTP connections need to be done in a passive mode.
10404 There are two that I can think off.
10410 If you are using a SOCKS firewall you will need to compile perl and link
10411 it with the SOCKS library, this is what is normally called a 'socksified'
10412 perl. With this executable you will be able to connect to servers outside
10413 the firewall as if it is not there.
10415 =item IP Masquerade
10417 This is the firewall implemented in the Linux kernel, it allows you to
10418 hide a complete network behind one IP address. With this firewall no
10419 special compiling is needed as you can access hosts directly.
10421 For accessing ftp servers behind such firewalls you usually need to
10422 set the environment variable C<FTP_PASSIVE> or the config variable
10423 ftp_passive to a true value.
10429 =head2 Configuring lynx or ncftp for going through a firewall
10431 If you can go through your firewall with e.g. lynx, presumably with a
10434 /usr/local/bin/lynx -pscott:tiger
10436 then you would configure CPAN.pm with the command
10438 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
10440 That's all. Similarly for ncftp or ftp, you would configure something
10443 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
10445 Your mileage may vary...
10453 I installed a new version of module X but CPAN keeps saying,
10454 I have the old version installed
10456 Most probably you B<do> have the old version installed. This can
10457 happen if a module installs itself into a different directory in the
10458 @INC path than it was previously installed. This is not really a
10459 CPAN.pm problem, you would have the same problem when installing the
10460 module manually. The easiest way to prevent this behaviour is to add
10461 the argument C<UNINST=1> to the C<make install> call, and that is why
10462 many people add this argument permanently by configuring
10464 o conf make_install_arg UNINST=1
10468 So why is UNINST=1 not the default?
10470 Because there are people who have their precise expectations about who
10471 may install where in the @INC path and who uses which @INC array. In
10472 fine tuned environments C<UNINST=1> can cause damage.
10476 I want to clean up my mess, and install a new perl along with
10477 all modules I have. How do I go about it?
10479 Run the autobundle command for your old perl and optionally rename the
10480 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
10481 with the Configure option prefix, e.g.
10483 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
10485 Install the bundle file you produced in the first step with something like
10487 cpan> install Bundle::mybundle
10493 When I install bundles or multiple modules with one command
10494 there is too much output to keep track of.
10496 You may want to configure something like
10498 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
10499 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
10501 so that STDOUT is captured in a file for later inspection.
10506 I am not root, how can I install a module in a personal directory?
10508 First of all, you will want to use your own configuration, not the one
10509 that your root user installed. If you do not have permission to write
10510 in the cpan directory that root has configured, you will be asked if
10511 you want to create your own config. Answering "yes" will bring you into
10512 CPAN's configuration stage, using the system config for all defaults except
10513 things that have to do with CPAN's work directory, saving your choices to
10514 your MyConfig.pm file.
10516 You can also manually initiate this process with the following command:
10518 % perl -MCPAN -e 'mkmyconfig'
10524 from the CPAN shell.
10526 You will most probably also want to configure something like this:
10528 o conf makepl_arg "LIB=~/myperl/lib \
10529 INSTALLMAN1DIR=~/myperl/man/man1 \
10530 INSTALLMAN3DIR=~/myperl/man/man3"
10532 You can make this setting permanent like all C<o conf> settings with
10535 You will have to add ~/myperl/man to the MANPATH environment variable
10536 and also tell your perl programs to look into ~/myperl/lib, e.g. by
10539 use lib "$ENV{HOME}/myperl/lib";
10541 or setting the PERL5LIB environment variable.
10543 While we're speaking about $ENV{HOME}, it might be worth mentioning,
10544 that for Windows we use the File::HomeDir module that provides an
10545 equivalent to the concept of the home directory on Unix.
10547 Another thing you should bear in mind is that the UNINST parameter can
10548 be dnagerous when you are installing into a private area because you
10549 might accidentally remove modules that other people depend on that are
10550 not using the private area.
10554 How to get a package, unwrap it, and make a change before building it?
10556 Have a look at the C<look> (!) command.
10560 I installed a Bundle and had a couple of fails. When I
10561 retried, everything resolved nicely. Can this be fixed to work
10564 The reason for this is that CPAN does not know the dependencies of all
10565 modules when it starts out. To decide about the additional items to
10566 install, it just uses data found in the META.yml file or the generated
10567 Makefile. An undetected missing piece breaks the process. But it may
10568 well be that your Bundle installs some prerequisite later than some
10569 depending item and thus your second try is able to resolve everything.
10570 Please note, CPAN.pm does not know the dependency tree in advance and
10571 cannot sort the queue of things to install in a topologically correct
10572 order. It resolves perfectly well IF all modules declare the
10573 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
10574 the C<requires> stanza of Module::Build. For bundles which fail and
10575 you need to install often, it is recommended to sort the Bundle
10576 definition file manually.
10580 In our intranet we have many modules for internal use. How
10581 can I integrate these modules with CPAN.pm but without uploading
10582 the modules to CPAN?
10584 Have a look at the CPAN::Site module.
10588 When I run CPAN's shell, I get an error message about things in my
10589 /etc/inputrc (or ~/.inputrc) file.
10591 These are readline issues and can only be fixed by studying readline
10592 configuration on your architecture and adjusting the referenced file
10593 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
10594 and edit them. Quite often harmless changes like uppercasing or
10595 lowercasing some arguments solves the problem.
10599 Some authors have strange characters in their names.
10601 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
10602 expecting ISO-8859-1 charset, a converter can be activated by setting
10603 term_is_latin to a true value in your config file. One way of doing so
10606 cpan> o conf term_is_latin 1
10608 If other charset support is needed, please file a bugreport against
10609 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
10610 the support or maybe UTF-8 terminals become widely available.
10614 When an install fails for some reason and then I correct the error
10615 condition and retry, CPAN.pm refuses to install the module, saying
10616 C<Already tried without success>.
10618 Use the force pragma like so
10620 force install Foo::Bar
10622 This does a bit more than really needed because it untars the
10623 distribution again and runs make and test and only then install.
10625 Or, if you find this is too fast and you would prefer to do smaller
10630 first and then continue as always. C<Force get> I<forgets> previous
10637 and then 'make install' directly in the subshell.
10639 Or you leave the CPAN shell and start it again.
10641 For the really curious, by accessing internals directly, you I<could>
10643 !delete CPAN::Shell->expandany("Foo::Bar")->distribution->{install}
10645 but this is neither guaranteed to work in the future nor is it a
10650 How do I install a "DEVELOPER RELEASE" of a module?
10652 By default, CPAN will install the latest non-developer release of a
10653 module. If you want to install a dev release, you have to specify the
10654 partial path starting with the author id to the tarball you wish to
10657 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
10659 Note that you can use the C<ls> command to get this path listed.
10663 How do I install a module and all its dependencies from the commandline,
10664 without being prompted for anything, despite my CPAN configuration
10667 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
10668 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
10669 asked any questions at all (assuming the modules you are installing are
10670 nice about obeying that variable as well):
10672 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
10676 How do I create a Module::Build based Build.PL derived from an
10677 ExtUtils::MakeMaker focused Makefile.PL?
10679 http://search.cpan.org/search?query=Module::Build::Convert
10681 http://accognoscere.org/papers/perl-module-build-convert/module-build-convert.html
10685 What's the best CPAN site for me?
10687 The urllist config parameter is yours. You can add and remove sites at
10688 will. You should find out which sites have the best uptodateness,
10689 bandwidth, reliability, etc. and are topologically close to you. Some
10690 people prefer fast downloads, others uptodateness, others reliability.
10691 You decide which to try in which order.
10693 Henk P. Penning maintains a site that collects data about CPAN sites:
10695 http://www.cs.uu.nl/people/henkp/mirmon/cpan.html
10701 Please report bugs via http://rt.cpan.org/
10703 Before submitting a bug, please make sure that the traditional method
10704 of building a Perl module package from a shell by following the
10705 installation instructions of that package still works in your
10708 =head1 SECURITY ADVICE
10710 This software enables you to upgrade software on your computer and so
10711 is inherently dangerous because the newly installed software may
10712 contain bugs and may alter the way your computer works or even make it
10713 unusable. Please consider backing up your data before every upgrade.
10717 Andreas Koenig C<< <andk@cpan.org> >>
10721 This program is free software; you can redistribute it and/or
10722 modify it under the same terms as Perl itself.
10724 See L<http://www.perl.com/perl/misc/Artistic.html>
10726 =head1 TRANSLATIONS
10728 Kawai,Takanori provides a Japanese translation of this manpage at
10729 http://homepage3.nifty.com/hippo2000/perltips/CPAN.htm
10733 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)