1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 $CPAN::VERSION = '1.88_62';
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';
45 END { $CPAN::End++; &cleanup; }
48 $CPAN::Frontend ||= "CPAN::Shell";
49 unless (@CPAN::Defaultsites){
50 @CPAN::Defaultsites = map {
51 CPAN::URL->new(TEXT => $_, FROM => "DEF")
53 "http://www.perl.org/CPAN/",
54 "ftp://ftp.perl.org/pub/CPAN/";
56 # $CPAN::iCwd (i for initial) is going to be initialized during find_perl
57 $CPAN::Perl ||= CPAN::find_perl();
58 $CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
59 $CPAN::Defaultrecent ||= "http://search.cpan.org/recent";
61 # our globals are getting a mess
84 @CPAN::ISA = qw(CPAN::Debug Exporter);
86 # note that these functions live in CPAN::Shell and get executed via
87 # AUTOLOAD when called directly
111 sub soft_chdir_with_alternatives ($);
114 $autoload_recursion ||= 0;
116 #-> sub CPAN::AUTOLOAD ;
118 $autoload_recursion++;
122 warn "Refusing to autoload '$l' while signal pending";
123 $autoload_recursion--;
126 if ($autoload_recursion > 1) {
127 my $fullcommand = join " ", map { "'$_'" } $l, @_;
128 warn "Refusing to autoload $fullcommand in recursion\n";
129 $autoload_recursion--;
133 @export{@EXPORT} = '';
134 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
135 if (exists $export{$l}){
138 die(qq{Unknown CPAN command "$AUTOLOAD". }.
139 qq{Type ? for help.\n});
141 $autoload_recursion--;
145 #-> sub CPAN::shell ;
148 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
149 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
151 my $oprompt = shift || CPAN::Prompt->new;
152 my $prompt = $oprompt;
153 my $commandline = shift || "";
154 $CPAN::CurrentCommandId ||= 1;
157 unless ($Suppress_readline) {
158 require Term::ReadLine;
161 $term->ReadLine eq "Term::ReadLine::Stub"
163 $term = Term::ReadLine->new('CPAN Monitor');
165 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
166 my $attribs = $term->Attribs;
167 $attribs->{attempted_completion_function} = sub {
168 &CPAN::Complete::gnu_cpl;
171 $readline::rl_completion_function =
172 $readline::rl_completion_function = 'CPAN::Complete::cpl';
174 if (my $histfile = $CPAN::Config->{'histfile'}) {{
175 unless ($term->can("AddHistory")) {
176 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
179 my($fh) = FileHandle->new;
180 open $fh, "<$histfile" or last;
184 $term->AddHistory($_);
188 for ($CPAN::Config->{term_ornaments}) { # alias
189 local $Term::ReadLine::termcap_nowarn = 1;
190 $term->ornaments($_) if defined;
192 # $term->OUT is autoflushed anyway
193 my $odef = select STDERR;
200 # no strict; # I do not recall why no strict was here (2000-09-03)
202 my @cwd = grep { defined $_ and length $_ }
204 File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
205 File::Spec->rootdir();
206 my $try_detect_readline;
207 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
208 my $rl_avail = $Suppress_readline ? "suppressed" :
209 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
210 "available (try 'install Bundle::CPAN')";
212 unless ($CPAN::Config->{'inhibit_startup_message'}){
213 $CPAN::Frontend->myprint(
215 cpan shell -- CPAN exploration and modules installation (v%s)
223 my($continuation) = "";
224 my $last_term_ornaments;
225 SHELLCOMMAND: while () {
226 if ($Suppress_readline) {
228 last SHELLCOMMAND unless defined ($_ = <> );
231 last SHELLCOMMAND unless
232 defined ($_ = $term->readline($prompt, $commandline));
234 $_ = "$continuation$_" if $continuation;
236 next SHELLCOMMAND if /^$/;
237 $_ = 'h' if /^\s*\?/;
238 if (/^(?:q(?:uit)?|bye|exit)$/i) {
249 use vars qw($import_done);
250 CPAN->import(':DEFAULT') unless $import_done++;
251 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
258 eval { @line = Text::ParseWords::shellwords($_) };
259 warn($@), next SHELLCOMMAND if $@;
260 warn("Text::Parsewords could not parse the line [$_]"),
261 next SHELLCOMMAND unless @line;
262 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
263 my $command = shift @line;
264 eval { CPAN::Shell->$command(@line) };
269 if ($command =~ /^(make|test|install|force|notest|clean|report|upgrade)$/) {
270 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
272 soft_chdir_with_alternatives(\@cwd);
273 $CPAN::Frontend->myprint("\n");
275 $CPAN::CurrentCommandId++;
279 $commandline = ""; # I do want to be able to pass a default to
280 # shell, but on the second command I see no
283 CPAN::Queue->nullify_queue;
284 if ($try_detect_readline) {
285 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
287 $CPAN::META->has_inst("Term::ReadLine::Perl")
289 delete $INC{"Term/ReadLine.pm"};
291 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
292 require Term::ReadLine;
293 $CPAN::Frontend->myprint("\n$redef subroutines in ".
294 "Term::ReadLine redefined\n");
298 if ($term and $term->can("ornaments")) {
299 for ($CPAN::Config->{term_ornaments}) { # alias
301 if (not defined $last_term_ornaments
302 or $_ != $last_term_ornaments
304 local $Term::ReadLine::termcap_nowarn = 1;
305 $term->ornaments($_);
306 $last_term_ornaments = $_;
309 undef $last_term_ornaments;
313 for my $class (qw(Module Distribution)) {
314 # again unsafe meta access?
315 for my $dm (keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) {
316 next unless $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
317 CPAN->debug("BUG: $class '$dm' was in command state, resetting");
318 delete $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
322 $GOTOSHELL = 0; # not too often
323 $META->savehist if $CPAN::term && $CPAN::term->can("GetHistory");
328 soft_chdir_with_alternatives(\@cwd);
331 sub soft_chdir_with_alternatives ($) {
334 my $root = File::Spec->rootdir();
335 $CPAN::Frontend->mywarn(qq{Warning: no good directory to chdir to!
336 Trying '$root' as temporary haven.
341 if (chdir $cwd->[0]) {
345 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
346 Trying to chdir to "$cwd->[1]" instead.
350 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
357 my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
359 $yaml_module ne "YAML"
361 !$CPAN::META->has_inst($yaml_module)
363 # $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back to 'YAML'\n");
364 $yaml_module = "YAML";
369 # CPAN::_yaml_loadfile
371 my($self,$local_file) = @_;
372 return +[] unless -s $local_file;
373 my $yaml_module = $self->_yaml_module;
374 if ($CPAN::META->has_inst($yaml_module)) {
375 my $code = UNIVERSAL::can($yaml_module, "LoadFile");
377 eval { @yaml = $code->($local_file); };
379 $CPAN::Frontend->mydie("Alert: While trying to parse YAML file\n".
381 "with $yaml_module the following error was encountered:\n".
387 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot parse '$local_file'\n");
392 # CPAN::_yaml_dumpfile
394 my($self,$to_local_file,@what) = @_;
395 my $yaml_module = $self->_yaml_module;
396 if ($CPAN::META->has_inst($yaml_module)) {
397 if (UNIVERSAL::isa($to_local_file, "FileHandle")) {
398 my $code = UNIVERSAL::can($yaml_module, "Dump");
399 eval { print $to_local_file $code->(@what) };
401 my $code = UNIVERSAL::can($yaml_module, "DumpFile");
402 eval { $code->($to_local_file,@what); };
405 $CPAN::Frontend->mydie("Alert: While trying to dump YAML file\n".
407 "with $yaml_module the following error was encountered:\n".
412 $CPAN::Frontend->myprint("Note (usually harmless): '$yaml_module' not installed, not dumping to '$to_local_file'\n");
416 package CPAN::CacheMgr;
418 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
423 use Fcntl qw(:flock);
424 use vars qw($Ua $Thesite $ThesiteURL $Themethod);
425 @CPAN::FTP::ISA = qw(CPAN::Debug);
427 package CPAN::LWP::UserAgent;
429 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
430 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
432 package CPAN::Complete;
434 @CPAN::Complete::ISA = qw(CPAN::Debug);
435 # Q: where is the "How do I add a new command" HOWTO?
436 # A: svn diff -r 1048:1049 where andk added the report command
437 @CPAN::Complete::COMMANDS = sort qw(
438 ! a b d h i m o q r u
465 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED);
466 @CPAN::Index::ISA = qw(CPAN::Debug);
469 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
472 package CPAN::InfoObj;
474 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
476 package CPAN::Author;
478 @CPAN::Author::ISA = qw(CPAN::InfoObj);
480 package CPAN::Distribution;
482 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
484 package CPAN::Bundle;
486 @CPAN::Bundle::ISA = qw(CPAN::Module);
488 package CPAN::Module;
490 @CPAN::Module::ISA = qw(CPAN::InfoObj);
492 package CPAN::Exception::RecursiveDependency;
494 use overload '""' => "as_string";
501 for my $dep (@$deps) {
503 last if $seen{$dep}++;
505 bless { deps => \@deps }, $class;
510 "\nRecursive dependency detected:\n " .
511 join("\n => ", @{$self->{deps}}) .
512 ".\nCannot continue.\n";
515 package CPAN::Prompt; use overload '""' => "as_string";
516 use vars qw($prompt);
518 $CPAN::CurrentCommandId ||= 0;
524 unless ($CPAN::META->{LOCK}) {
525 $word = "nolock_cpan";
527 if ($CPAN::Config->{commandnumber_in_prompt}) {
528 sprintf "$word\[%d]> ", $CPAN::CurrentCommandId;
534 package CPAN::URL; use overload '""' => "as_string", fallback => 1;
535 # accessors: TEXT(the url string), FROM(DEF=>defaultlist,USER=>urllist),
536 # planned are things like age or quality
538 my($class,%args) = @_;
550 $self->{TEXT} = $set;
555 package CPAN::Distrostatus;
556 use overload '""' => "as_string",
559 my($class,$arg) = @_;
562 FAILED => substr($arg,0,2) eq "NO",
563 COMMANDID => $CPAN::CurrentCommandId,
566 sub commandid { shift->{COMMANDID} }
567 sub failed { shift->{FAILED} }
571 $self->{TEXT} = $set;
590 @CPAN::Shell::ISA = qw(CPAN::Debug);
591 $COLOR_REGISTERED ||= 0;
594 $autoload_recursion ||= 0;
596 #-> sub CPAN::Shell::AUTOLOAD ;
598 $autoload_recursion++;
600 my $class = shift(@_);
601 # warn "autoload[$l] class[$class]";
604 warn "Refusing to autoload '$l' while signal pending";
605 $autoload_recursion--;
608 if ($autoload_recursion > 1) {
609 my $fullcommand = join " ", map { "'$_'" } $l, @_;
610 warn "Refusing to autoload $fullcommand in recursion\n";
611 $autoload_recursion--;
615 # XXX needs to be reconsidered
616 if ($CPAN::META->has_inst('CPAN::WAIT')) {
619 $CPAN::Frontend->mywarn(qq{
620 Commands starting with "w" require CPAN::WAIT to be installed.
621 Please consider installing CPAN::WAIT to use the fulltext index.
622 For this you just need to type
627 $CPAN::Frontend->mywarn(qq{Unknown shell command '$l'. }.
631 $autoload_recursion--;
638 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
640 # from here on only subs.
641 ################################################################################
643 sub _perl_fingerprint {
644 my($self,$other_fingerprint) = @_;
645 my $dll = eval {OS2::DLLname()};
648 $mtime_dll = (-f $dll ? (stat(_))[9] : '-1');
650 my $this_fingerprint = {
652 sitearchexp => $Config::Config{sitearchexp},
653 'mtime_$^X' => (stat $^X)[9],
654 'mtime_dll' => $mtime_dll,
656 if ($other_fingerprint) {
657 if (exists $other_fingerprint->{'stat($^X)'}) { # repair fp from rev. 1.88_57
658 $other_fingerprint->{'mtime_$^X'} = $other_fingerprint->{'stat($^X)'}[9];
660 # mandatory keys since 1.88_57
661 for my $key (qw($^X sitearchexp mtime_dll mtime_$^X)) {
662 return unless $other_fingerprint->{$key} eq $this_fingerprint->{$key};
666 return $this_fingerprint;
670 sub suggest_myconfig () {
671 SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
672 $CPAN::Frontend->myprint("You don't seem to have a user ".
673 "configuration (MyConfig.pm) yet.\n");
674 my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ".
675 "user configuration now? (Y/n)",
678 CPAN::Shell->mkmyconfig();
681 $CPAN::Frontend->mydie("OK, giving up.");
686 #-> sub CPAN::all_objects ;
688 my($mgr,$class) = @_;
689 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
690 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
692 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
695 # Called by shell, not in batch mode. In batch mode I see no risk in
696 # having many processes updating something as installations are
697 # continually checked at runtime. In shell mode I suspect it is
698 # unintentional to open more than one shell at a time
700 #-> sub CPAN::checklock ;
703 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
704 if (-f $lockfile && -M _ > 0) {
705 my $fh = FileHandle->new($lockfile) or
706 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
707 my $otherpid = <$fh>;
708 my $otherhost = <$fh>;
710 if (defined $otherpid && $otherpid) {
713 if (defined $otherhost && $otherhost) {
716 my $thishost = hostname();
717 if (defined $otherhost && defined $thishost &&
718 $otherhost ne '' && $thishost ne '' &&
719 $otherhost ne $thishost) {
720 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
721 "reports other host $otherhost and other ".
722 "process $otherpid.\n".
723 "Cannot proceed.\n"));
724 } elsif ($RUN_DEGRADED) {
725 $CPAN::Frontend->mywarn("Running in degraded mode (experimental)\n");
726 } elsif (defined $otherpid && $otherpid) {
727 return if $$ == $otherpid; # should never happen
728 $CPAN::Frontend->mywarn(
730 There seems to be running another CPAN process (pid $otherpid). Contacting...
732 if (kill 0, $otherpid) {
733 $CPAN::Frontend->mywarn(qq{Other job is running.\n});
735 CPAN::Shell::colorable_makemaker_prompt
736 (qq{Shall I try to run in degraded }.
737 qq{mode? (Y/n)},"y");
739 $CPAN::Frontend->mywarn("Running in degraded mode (experimental).
740 Please report if something unexpected happens\n");
742 for ($CPAN::Config) {
743 $_->{build_dir_reuse} = 0;
744 $_->{commandnumber_in_prompt} = 0;
746 $_->{cache_metadata} = 0;
749 $CPAN::Frontend->mydie("
750 You may want to kill the other job and delete the lockfile. On UNIX try:
755 } elsif (-w $lockfile) {
757 CPAN::Shell::colorable_makemaker_prompt
758 (qq{Other job not responding. Shall I overwrite }.
759 qq{the lockfile '$lockfile'? (Y/n)},"y");
760 $CPAN::Frontend->myexit("Ok, bye\n")
761 unless $ans =~ /^y/i;
764 qq{Lockfile '$lockfile' not writeable by you. }.
765 qq{Cannot proceed.\n}.
767 qq{ rm '$lockfile'\n}.
768 qq{ and then rerun us.\n}
772 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Found invalid lockfile ".
773 "'$lockfile', please remove. Cannot proceed.\n"));
776 my $dotcpan = $CPAN::Config->{cpan_home};
777 eval { File::Path::mkpath($dotcpan);};
779 # A special case at least for Jarkko.
784 $symlinkcpan = readlink $dotcpan;
785 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
786 eval { File::Path::mkpath($symlinkcpan); };
790 $CPAN::Frontend->mywarn(qq{
791 Working directory $symlinkcpan created.
795 unless (-d $dotcpan) {
797 Your configuration suggests "$dotcpan" as your
798 CPAN.pm working directory. I could not create this directory due
799 to this error: $firsterror\n};
801 As "$dotcpan" is a symlink to "$symlinkcpan",
802 I tried to create that, but I failed with this error: $seconderror
805 Please make sure the directory exists and is writable.
807 $CPAN::Frontend->myprint($mess);
808 return suggest_myconfig;
810 } # $@ after eval mkpath $dotcpan
811 if (0) { # to test what happens when a race condition occurs
812 for (reverse 1..10) {
818 if (!$RUN_DEGRADED && !$self->{LOCKFH}) {
820 unless ($fh = FileHandle->new("+>>$lockfile")) {
821 if ($! =~ /Permission/) {
822 $CPAN::Frontend->myprint(qq{
824 Your configuration suggests that CPAN.pm should use a working
826 $CPAN::Config->{cpan_home}
827 Unfortunately we could not create the lock file
829 due to permission problems.
831 Please make sure that the configuration variable
832 \$CPAN::Config->{cpan_home}
833 points to a directory where you can write a .lock file. You can set
834 this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
837 return suggest_myconfig;
841 while (!flock $fh, LOCK_EX|LOCK_NB) {
843 $CPAN::Frontend->mydie("Giving up\n");
845 $CPAN::Frontend->mysleep($sleep++);
846 $CPAN::Frontend->mywarn("Could not lock lockfile with flock: $!; retrying\n");
851 $fh->print($$, "\n");
852 $fh->print(hostname(), "\n");
853 $self->{LOCK} = $lockfile;
854 $self->{LOCKFH} = $fh;
859 $CPAN::Frontend->mydie("Got SIG$sig, leaving");
865 die "Got yet another signal" if $Signal > 1;
866 $CPAN::Frontend->mydie("Got another SIG$sig") if $Signal;
867 $CPAN::Frontend->mywarn("Caught SIG$sig, trying to continue\n");
871 # From: Larry Wall <larry@wall.org>
872 # Subject: Re: deprecating SIGDIE
873 # To: perl5-porters@perl.org
874 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
876 # The original intent of __DIE__ was only to allow you to substitute one
877 # kind of death for another on an application-wide basis without respect
878 # to whether you were in an eval or not. As a global backstop, it should
879 # not be used any more lightly (or any more heavily :-) than class
880 # UNIVERSAL. Any attempt to build a general exception model on it should
881 # be politely squashed. Any bug that causes every eval {} to have to be
882 # modified should be not so politely squashed.
884 # Those are my current opinions. It is also my optinion that polite
885 # arguments degenerate to personal arguments far too frequently, and that
886 # when they do, it's because both people wanted it to, or at least didn't
887 # sufficiently want it not to.
891 # global backstop to cleanup if we should really die
892 $SIG{__DIE__} = \&cleanup;
893 $self->debug("Signal handler set.") if $CPAN::DEBUG;
896 #-> sub CPAN::DESTROY ;
898 &cleanup; # need an eval?
901 #-> sub CPAN::anycwd ;
904 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
909 sub cwd {Cwd::cwd();}
911 #-> sub CPAN::getcwd ;
912 sub getcwd {Cwd::getcwd();}
914 #-> sub CPAN::fastcwd ;
915 sub fastcwd {Cwd::fastcwd();}
917 #-> sub CPAN::backtickcwd ;
918 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
920 #-> sub CPAN::find_perl ;
922 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
923 my $pwd = $CPAN::iCwd = CPAN::anycwd();
924 my $candidate = File::Spec->catfile($pwd,$^X);
925 $perl ||= $candidate if MM->maybe_command($candidate);
928 my ($component,$perl_name);
929 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
930 PATH_COMPONENT: foreach $component (File::Spec->path(),
931 $Config::Config{'binexp'}) {
932 next unless defined($component) && $component;
933 my($abs) = File::Spec->catfile($component,$perl_name);
934 if (MM->maybe_command($abs)) {
946 #-> sub CPAN::exists ;
948 my($mgr,$class,$id) = @_;
949 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
951 ### Carp::croak "exists called without class argument" unless $class;
953 $id =~ s/:+/::/g if $class eq "CPAN::Module";
954 exists $META->{readonly}{$class}{$id} or
955 exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
958 #-> sub CPAN::delete ;
960 my($mgr,$class,$id) = @_;
961 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
962 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
965 #-> sub CPAN::has_usable
966 # has_inst is sometimes too optimistic, we should replace it with this
967 # has_usable whenever a case is given
969 my($self,$mod,$message) = @_;
970 return 1 if $HAS_USABLE->{$mod};
971 my $has_inst = $self->has_inst($mod,$message);
972 return unless $has_inst;
975 LWP => [ # we frequently had "Can't locate object
976 # method "new" via package "LWP::UserAgent" at
977 # (eval 69) line 2006
979 sub {require LWP::UserAgent},
980 sub {require HTTP::Request},
981 sub {require URI::URL},
984 sub {require Net::FTP},
985 sub {require Net::Config},
988 sub {require File::HomeDir;
989 unless (File::HomeDir::->VERSION >= 0.52){
990 for ("Will not use File::HomeDir, need 0.52\n") {
991 $CPAN::Frontend->mywarn($_);
998 if ($usable->{$mod}) {
999 for my $c (0..$#{$usable->{$mod}}) {
1000 my $code = $usable->{$mod}[$c];
1001 my $ret = eval { &$code() };
1002 $ret = "" unless defined $ret;
1004 # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
1009 return $HAS_USABLE->{$mod} = 1;
1012 #-> sub CPAN::has_inst
1014 my($self,$mod,$message) = @_;
1015 Carp::croak("CPAN->has_inst() called without an argument")
1016 unless defined $mod;
1017 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
1018 keys %{$CPAN::Config->{dontload_hash}||{}},
1019 @{$CPAN::Config->{dontload_list}||[]};
1020 if (defined $message && $message eq "no" # afair only used by Nox
1024 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
1032 # checking %INC is wrong, because $INC{LWP} may be true
1033 # although $INC{"URI/URL.pm"} may have failed. But as
1034 # I really want to say "bla loaded OK", I have to somehow
1036 ### warn "$file in %INC"; #debug
1038 } elsif (eval { require $file }) {
1039 # eval is good: if we haven't yet read the database it's
1040 # perfect and if we have installed the module in the meantime,
1041 # it tries again. The second require is only a NOOP returning
1042 # 1 if we had success, otherwise it's retrying
1044 my $v = eval "\$$mod\::VERSION";
1045 $v = $v ? " (v$v)" : "";
1046 $CPAN::Frontend->myprint("CPAN: $mod loaded ok$v\n");
1047 if ($mod eq "CPAN::WAIT") {
1048 push @CPAN::Shell::ISA, 'CPAN::WAIT';
1051 } elsif ($mod eq "Net::FTP") {
1052 $CPAN::Frontend->mywarn(qq{
1053 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
1055 install Bundle::libnet
1057 }) unless $Have_warned->{"Net::FTP"}++;
1058 $CPAN::Frontend->mysleep(3);
1059 } elsif ($mod eq "Digest::SHA"){
1060 if ($Have_warned->{"Digest::SHA"}++) {
1061 $CPAN::Frontend->myprint(qq{CPAN: checksum security checks disabled}.
1062 qq{because Digest::SHA not installed.\n});
1064 $CPAN::Frontend->mywarn(qq{
1065 CPAN: checksum security checks disabled because Digest::SHA not installed.
1066 Please consider installing the Digest::SHA module.
1069 $CPAN::Frontend->mysleep(2);
1071 } elsif ($mod eq "Module::Signature"){
1072 if (not $CPAN::Config->{check_sigs}) {
1073 # they do not want us:-(
1074 } elsif (not $Have_warned->{"Module::Signature"}++) {
1075 # No point in complaining unless the user can
1076 # reasonably install and use it.
1077 if (eval { require Crypt::OpenPGP; 1 } ||
1079 defined $CPAN::Config->{'gpg'}
1081 $CPAN::Config->{'gpg'} =~ /\S/
1084 $CPAN::Frontend->mywarn(qq{
1085 CPAN: Module::Signature security checks disabled because Module::Signature
1086 not installed. Please consider installing the Module::Signature module.
1087 You may also need to be able to connect over the Internet to the public
1088 keyservers like pgp.mit.edu (port 11371).
1091 $CPAN::Frontend->mysleep(2);
1095 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
1100 #-> sub CPAN::instance ;
1102 my($mgr,$class,$id) = @_;
1103 CPAN::Index->reload;
1105 # unsafe meta access, ok?
1106 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
1107 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
1115 #-> sub CPAN::cleanup ;
1117 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
1118 local $SIG{__DIE__} = '';
1123 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
1124 $ineval = 1, last if
1125 $subroutine eq '(eval)';
1127 return if $ineval && !$CPAN::End;
1128 return unless defined $META->{LOCK};
1129 return unless -f $META->{LOCK};
1131 unlink $META->{LOCK};
1133 # Carp::cluck("DEBUGGING");
1134 if ( $CPAN::CONFIG_DIRTY ) {
1135 $CPAN::Frontend->mywarn("Warning: Configuration not saved.\n");
1137 $CPAN::Frontend->myprint("Lockfile removed.\n");
1140 #-> sub CPAN::savehist
1143 my($histfile,$histsize);
1144 unless ($histfile = $CPAN::Config->{'histfile'}){
1145 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
1148 $histsize = $CPAN::Config->{'histsize'} || 100;
1150 unless ($CPAN::term->can("GetHistory")) {
1151 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
1157 my @h = $CPAN::term->GetHistory;
1158 splice @h, 0, @h-$histsize if @h>$histsize;
1159 my($fh) = FileHandle->new;
1160 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
1161 local $\ = local $, = "\n";
1166 #-> sub CPAN::is_tested
1168 my($self,$what) = @_;
1169 $self->{is_tested}{$what} = 1;
1172 #-> sub CPAN::is_installed
1173 # unsets the is_tested flag: as soon as the thing is installed, it is
1174 # not needed in set_perl5lib anymore
1176 my($self,$what) = @_;
1177 delete $self->{is_tested}{$what};
1180 #-> sub CPAN::set_perl5lib
1182 my($self,$for) = @_;
1184 (undef,undef,undef,$for) = caller(1);
1187 $self->{is_tested} ||= {};
1188 return unless %{$self->{is_tested}};
1189 my $env = $ENV{PERL5LIB};
1190 $env = $ENV{PERLLIB} unless defined $env;
1192 push @env, $env if defined $env and length $env;
1193 #my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1194 #$CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1195 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} sort keys %{$self->{is_tested}};
1197 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB for $for\n");
1199 my @d = map {s/^\Q$CPAN::Config->{'build_dir'}/%BUILDDIR%/; $_ }
1200 sort keys %{$self->{is_tested}};
1201 $CPAN::Frontend->myprint("Prepending blib/arch and blib/lib subdirs of ".
1203 "%BUILDDIR%=$CPAN::Config->{'build_dir'} ".
1208 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1211 package CPAN::CacheMgr;
1214 #-> sub CPAN::CacheMgr::as_string ;
1216 eval { require Data::Dumper };
1218 return shift->SUPER::as_string;
1220 return Data::Dumper::Dumper(shift);
1224 #-> sub CPAN::CacheMgr::cachesize ;
1229 #-> sub CPAN::CacheMgr::tidyup ;
1232 return unless -d $self->{ID};
1233 while ($self->{DU} > $self->{'MAX'} ) {
1234 my($toremove) = shift @{$self->{FIFO}};
1235 $CPAN::Frontend->myprint(sprintf(
1236 "Deleting from cache".
1237 ": $toremove (%.1f>%.1f MB)\n",
1238 $self->{DU}, $self->{'MAX'})
1240 return if $CPAN::Signal;
1241 $self->force_clean_cache($toremove);
1242 return if $CPAN::Signal;
1246 #-> sub CPAN::CacheMgr::dir ;
1251 #-> sub CPAN::CacheMgr::entries ;
1253 my($self,$dir) = @_;
1254 return unless defined $dir;
1255 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1256 $dir ||= $self->{ID};
1257 my($cwd) = CPAN::anycwd();
1258 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1259 my $dh = DirHandle->new(File::Spec->curdir)
1260 or Carp::croak("Couldn't opendir $dir: $!");
1263 next if $_ eq "." || $_ eq "..";
1265 push @entries, File::Spec->catfile($dir,$_);
1267 push @entries, File::Spec->catdir($dir,$_);
1269 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1272 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1273 sort { -M $b <=> -M $a} @entries;
1276 #-> sub CPAN::CacheMgr::disk_usage ;
1278 my($self,$dir) = @_;
1279 return if exists $self->{SIZE}{$dir};
1280 return if $CPAN::Signal;
1284 unless (chmod 0755, $dir) {
1285 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1286 "permission to change the permission; cannot ".
1287 "estimate disk usage of '$dir'\n");
1288 $CPAN::Frontend->mysleep(5);
1293 $CPAN::Frontend->mywarn("Directory '$dir' has gone. Cannot continue.\n");
1298 $File::Find::prune++ if $CPAN::Signal;
1300 if ($^O eq 'MacOS') {
1302 my $cat = Mac::Files::FSpGetCatInfo($_);
1303 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1307 unless (chmod 0755, $_) {
1308 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1309 "the permission to change the permission; ".
1310 "can only partially estimate disk usage ".
1312 $CPAN::Frontend->mysleep(5);
1323 return if $CPAN::Signal;
1324 $self->{SIZE}{$dir} = $Du/1024/1024;
1325 push @{$self->{FIFO}}, $dir;
1326 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1327 $self->{DU} += $Du/1024/1024;
1331 #-> sub CPAN::CacheMgr::force_clean_cache ;
1332 sub force_clean_cache {
1333 my($self,$dir) = @_;
1334 return unless -e $dir;
1335 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1337 File::Path::rmtree($dir);
1338 unlink "$dir.yml"; # may fail
1339 $self->{DU} -= $self->{SIZE}{$dir};
1340 delete $self->{SIZE}{$dir};
1343 #-> sub CPAN::CacheMgr::new ;
1350 ID => $CPAN::Config->{'build_dir'},
1351 MAX => $CPAN::Config->{'build_cache'},
1352 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1355 File::Path::mkpath($self->{ID});
1356 my $dh = DirHandle->new($self->{ID});
1357 bless $self, $class;
1360 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1362 CPAN->debug($debug) if $CPAN::DEBUG;
1366 #-> sub CPAN::CacheMgr::scan_cache ;
1369 return if $self->{SCAN} eq 'never';
1370 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1371 unless $self->{SCAN} eq 'atstart';
1372 $CPAN::Frontend->myprint(
1373 sprintf("Scanning cache %s for sizes\n",
1376 for $e ($self->entries($self->{ID})) {
1377 next if $e eq ".." || $e eq ".";
1378 $self->disk_usage($e);
1379 return if $CPAN::Signal;
1384 package CPAN::Shell;
1387 #-> sub CPAN::Shell::h ;
1389 my($class,$about) = @_;
1390 if (defined $about) {
1391 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1393 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1394 $CPAN::Frontend->myprint(qq{
1395 Display Information $filler (ver $CPAN::VERSION)
1396 command argument description
1397 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1398 i WORD or /REGEXP/ about any of the above
1399 ls AUTHOR or GLOB about files in the author's directory
1400 (with WORD being a module, bundle or author name or a distribution
1401 name of the form AUTHOR/DISTRIBUTION)
1403 Download, Test, Make, Install...
1404 get download clean make clean
1405 make make (implies get) look open subshell in dist directory
1406 test make test (implies make) readme display these README files
1407 install make install (implies test) perldoc display POD documentation
1410 r WORDs or /REGEXP/ or NONE report updates for some/matching/all modules
1411 upgrade WORDs or /REGEXP/ or NONE upgrade some/matching/all modules
1414 force COMMAND unconditionally do command
1415 notest COMMAND skip testing
1418 h,? display this menu ! perl-code eval a perl command
1419 o conf [opt] set and query options q quit the cpan shell
1420 reload cpan load CPAN.pm again reload index load newer indices
1421 autobundle Snapshot recent latest CPAN uploads});
1427 #-> sub CPAN::Shell::a ;
1429 my($self,@arg) = @_;
1430 # authors are always UPPERCASE
1432 $_ = uc $_ unless /=/;
1434 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1437 #-> sub CPAN::Shell::globls ;
1439 my($self,$s,$pragmas) = @_;
1440 # ls is really very different, but we had it once as an ordinary
1441 # command in the Shell (upto rev. 321) and we could not handle
1443 my(@accept,@preexpand);
1444 if ($s =~ /[\*\?\/]/) {
1445 if ($CPAN::META->has_inst("Text::Glob")) {
1446 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1447 my $rau = Text::Glob::glob_to_regex(uc $au);
1448 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1450 push @preexpand, map { $_->id . "/" . $pathglob }
1451 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1453 my $rau = Text::Glob::glob_to_regex(uc $s);
1454 push @preexpand, map { $_->id }
1455 CPAN::Shell->expand_by_method('CPAN::Author',
1460 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1463 push @preexpand, uc $s;
1466 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1467 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1472 my $silent = @accept>1;
1473 my $last_alpha = "";
1475 for my $a (@accept){
1476 my($author,$pathglob);
1477 if ($a =~ m|(.*?)/(.*)|) {
1480 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1482 $a2) or die "No author found for $a2";
1484 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1486 $a) or die "No author found for $a";
1489 my $alpha = substr $author->id, 0, 1;
1491 if ($alpha eq $last_alpha) {
1495 $last_alpha = $alpha;
1497 $CPAN::Frontend->myprint($ad);
1499 for my $pragma (@$pragmas) {
1500 if ($author->can($pragma)) {
1504 push @results, $author->ls($pathglob,$silent); # silent if
1507 for my $pragma (@$pragmas) {
1508 my $unpragma = "un$pragma";
1509 if ($author->can($unpragma)) {
1510 $author->$unpragma();
1517 #-> sub CPAN::Shell::local_bundles ;
1519 my($self,@which) = @_;
1520 my($incdir,$bdir,$dh);
1521 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1522 my @bbase = "Bundle";
1523 while (my $bbase = shift @bbase) {
1524 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1525 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1526 if ($dh = DirHandle->new($bdir)) { # may fail
1528 for $entry ($dh->read) {
1529 next if $entry =~ /^\./;
1530 next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
1531 if (-d File::Spec->catdir($bdir,$entry)){
1532 push @bbase, "$bbase\::$entry";
1534 next unless $entry =~ s/\.pm(?!\n)\Z//;
1535 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1543 #-> sub CPAN::Shell::b ;
1545 my($self,@which) = @_;
1546 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1547 $self->local_bundles;
1548 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1551 #-> sub CPAN::Shell::d ;
1552 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1554 #-> sub CPAN::Shell::m ;
1555 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1557 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1560 #-> sub CPAN::Shell::i ;
1564 @args = '/./' unless @args;
1566 for my $type (qw/Bundle Distribution Module/) {
1567 push @result, $self->expand($type,@args);
1569 # Authors are always uppercase.
1570 push @result, $self->expand("Author", map { uc $_ } @args);
1572 my $result = @result == 1 ?
1573 $result[0]->as_string :
1575 "No objects found of any type for argument @args\n" :
1577 (map {$_->as_glimpse} @result),
1578 scalar @result, " items found\n",
1580 $CPAN::Frontend->myprint($result);
1583 #-> sub CPAN::Shell::o ;
1585 # CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o
1586 # conf' calls through to CPAN::HandleConfig::edit. 'o conf' should
1587 # probably have been called 'set' and 'o debug' maybe 'set debug' or
1588 # 'debug'; 'o conf ARGS' calls ->edit in CPAN/HandleConfig.pm
1590 my($self,$o_type,@o_what) = @_;
1592 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1593 if ($o_type eq 'conf') {
1594 if (!@o_what) { # print all things, "o conf"
1596 $CPAN::Frontend->myprint("\$CPAN::Config options from ");
1598 if (exists $INC{'CPAN/Config.pm'}) {
1599 push @from, $INC{'CPAN/Config.pm'};
1601 if (exists $INC{'CPAN/MyConfig.pm'}) {
1602 push @from, $INC{'CPAN/MyConfig.pm'};
1604 $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
1605 $CPAN::Frontend->myprint(":\n");
1606 for $k (sort keys %CPAN::HandleConfig::can) {
1607 $v = $CPAN::HandleConfig::can{$k};
1608 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
1610 $CPAN::Frontend->myprint("\n");
1611 for $k (sort keys %$CPAN::Config) {
1612 CPAN::HandleConfig->prettyprint($k);
1614 $CPAN::Frontend->myprint("\n");
1616 if (CPAN::HandleConfig->edit(@o_what)) {
1617 unless ($o_what[0] eq "init") {
1618 $CPAN::Frontend->myprint("Please use 'o conf commit' to ".
1619 "make the config permanent!\n\n");
1622 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
1626 } elsif ($o_type eq 'debug') {
1628 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1631 my($what) = shift @o_what;
1632 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1633 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1636 if ( exists $CPAN::DEBUG{$what} ) {
1637 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1638 } elsif ($what =~ /^\d/) {
1639 $CPAN::DEBUG = $what;
1640 } elsif (lc $what eq 'all') {
1642 for (values %CPAN::DEBUG) {
1645 $CPAN::DEBUG = $max;
1648 for (keys %CPAN::DEBUG) {
1649 next unless lc($_) eq lc($what);
1650 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1653 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1658 my $raw = "Valid options for debug are ".
1659 join(", ",sort(keys %CPAN::DEBUG), 'all').
1660 qq{ or a number. Completion works on the options. }.
1661 qq{Case is ignored.};
1663 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1664 $CPAN::Frontend->myprint("\n\n");
1667 $CPAN::Frontend->myprint("Options set for debugging ($CPAN::DEBUG):\n");
1669 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1670 $v = $CPAN::DEBUG{$k};
1671 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1672 if $v & $CPAN::DEBUG;
1675 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1678 $CPAN::Frontend->myprint(qq{
1680 conf set or get configuration variables
1681 debug set or get debugging options
1686 # CPAN::Shell::paintdots_onreload
1687 sub paintdots_onreload {
1690 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
1694 # $CPAN::Frontend->myprint(".($subr)");
1695 $CPAN::Frontend->myprint(".");
1696 if ($subr =~ /\bshell\b/i) {
1697 # warn "debug[$_[0]]";
1699 # It would be nice if we could detect that a
1700 # subroutine has actually changed, but for now we
1701 # practically always set the GOTOSHELL global
1711 #-> sub CPAN::Shell::hosts ;
1714 my $fullstats = CPAN::FTP->_ftp_statistics();
1715 my $history = $fullstats->{history} || [];
1717 while (my $last = pop @$history) {
1718 my $attempts = $last->{attempts} or next;
1721 $start = $attempts->[-1]{start};
1722 if ($#$attempts > 0) {
1723 for my $i (0..$#$attempts-1) {
1724 my $url = $attempts->[$i]{url} or next;
1729 $start = $last->{start};
1731 next unless $last->{thesiteurl}; # C-C? bad filenames?
1733 $S{end} ||= $last->{end};
1734 my $dltime = $last->{end} - $start;
1735 my $dlsize = $last->{filesize} || 0;
1736 my $url = $last->{thesiteurl}->text;
1737 my $s = $S{ok}{$url} ||= {};
1740 $s->{dlsize} += $dlsize/1024;
1742 $s->{dltime} += $dltime;
1745 for my $url (keys %{$S{ok}}) {
1746 next if $S{ok}{$url}{dltime} == 0; # div by zero
1747 push @{$res->{ok}}, [@{$S{ok}{$url}}{qw(n dlsize dltime)},
1748 $S{ok}{$url}{dlsize}/$S{ok}{$url}{dltime},
1752 for my $url (keys %{$S{no}}) {
1753 push @{$res->{no}}, [$S{no}{$url},
1757 my $R = ""; # report
1758 $R .= sprintf "Log starts: %s\n", scalar(localtime $S{start}) || "unknown";
1759 $R .= sprintf "Log ends : %s\n", scalar(localtime $S{end}) || "unknown";
1760 if ($res->{ok} && @{$res->{ok}}) {
1761 $R .= sprintf "\nSuccessful downloads:
1762 N kB secs kB/s url\n";
1763 for (sort { $b->[3] <=> $a->[3] } @{$res->{ok}}) {
1764 $R .= sprintf "%4d %8d %5d %9.1f %s\n", @$_;
1767 if ($res->{no} && @{$res->{no}}) {
1768 $R .= sprintf "\nUnsuccessful downloads:\n";
1769 for (sort { $b->[0] <=> $a->[0] } @{$res->{no}}) {
1770 $R .= sprintf "%4d %s\n", @$_;
1773 $CPAN::Frontend->myprint($R);
1776 #-> sub CPAN::Shell::reload ;
1778 my($self,$command,@arg) = @_;
1780 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1781 if ($command =~ /^cpan$/i) {
1783 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
1787 "CPAN/HandleConfig.pm",
1788 "CPAN/FirstTime.pm",
1795 MFILE: for my $f (@relo) {
1796 next unless exists $INC{$f};
1800 $CPAN::Frontend->myprint("($p");
1801 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
1802 $self->reload_this($f) or $failed++;
1803 my $v = eval "$p\::->VERSION";
1804 $CPAN::Frontend->myprint("v$v)");
1806 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1808 my $errors = $failed == 1 ? "error" : "errors";
1809 $CPAN::Frontend->mywarn("\n$failed $errors during reload. You better quit ".
1812 } elsif ($command =~ /^index$/i) {
1813 CPAN::Index->force_reload;
1815 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN modules
1816 index re-reads the index files\n});
1820 # reload means only load again what we have loaded before
1821 #-> sub CPAN::Shell::reload_this ;
1823 my($self,$f,$args) = @_;
1824 CPAN->debug("f[$f]") if $CPAN::DEBUG;
1825 return 1 unless $INC{$f}; # we never loaded this, so we do not
1827 my $pwd = CPAN::anycwd();
1828 CPAN->debug("pwd[$pwd]") if $CPAN::DEBUG;
1830 for my $inc (@INC) {
1831 $file = File::Spec->catfile($inc,split /\//, $f);
1835 CPAN->debug("file[$file]") if $CPAN::DEBUG;
1837 unless ($file && -f $file) {
1838 # this thingie is not in the INC path, maybe CPAN/MyConfig.pm?
1840 unless (CPAN->has_inst("File::Basename")) {
1841 @inc = File::Basename::dirname($file);
1843 # do we ever need this?
1844 @inc = substr($file,0,-length($f)-1); # bring in back to me!
1847 CPAN->debug("file[$file]inc[@inc]") if $CPAN::DEBUG;
1849 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
1852 my $mtime = (stat $file)[9];
1853 $reload->{$f} ||= $^T;
1854 my $must_reload = $mtime > $reload->{$f};
1856 $must_reload ||= $args->{force};
1858 my $fh = FileHandle->new($file) or
1859 $CPAN::Frontend->mydie("Could not open $file: $!");
1862 my $content = <$fh>;
1863 CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128)))
1867 eval "require '$f'";
1872 $reload->{$f} = time;
1874 $CPAN::Frontend->myprint("__unchanged__");
1879 #-> sub CPAN::Shell::mkmyconfig ;
1881 my($self, $cpanpm, %args) = @_;
1882 require CPAN::FirstTime;
1883 my $home = CPAN::HandleConfig::home;
1884 $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
1885 File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
1886 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
1887 CPAN::HandleConfig::require_myconfig_or_config;
1888 $CPAN::Config ||= {};
1893 keep_source_where => undef,
1896 CPAN::FirstTime::init($cpanpm, %args);
1899 #-> sub CPAN::Shell::_binary_extensions ;
1900 sub _binary_extensions {
1901 my($self) = shift @_;
1902 my(@result,$module,%seen,%need,$headerdone);
1903 for $module ($self->expand('Module','/./')) {
1904 my $file = $module->cpan_file;
1905 next if $file eq "N/A";
1906 next if $file =~ /^Contact Author/;
1907 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
1908 next if $dist->isa_perl;
1909 next unless $module->xs_file;
1911 $CPAN::Frontend->myprint(".");
1912 push @result, $module;
1914 # print join " | ", @result;
1915 $CPAN::Frontend->myprint("\n");
1919 #-> sub CPAN::Shell::recompile ;
1921 my($self) = shift @_;
1922 my($module,@module,$cpan_file,%dist);
1923 @module = $self->_binary_extensions();
1924 for $module (@module){ # we force now and compile later, so we
1926 $cpan_file = $module->cpan_file;
1927 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1929 $dist{$cpan_file}++;
1931 for $cpan_file (sort keys %dist) {
1932 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1933 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1935 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1936 # stop a package from recompiling,
1937 # e.g. IO-1.12 when we have perl5.003_10
1941 #-> sub CPAN::Shell::scripts ;
1943 my($self, $arg) = @_;
1944 $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n");
1946 for my $req (qw( HTML::LinkExtor Sort::Versions List::Util )) {
1947 unless ($CPAN::META->has_inst($req)) {
1948 $CPAN::Frontend->mywarn(" $req not available\n");
1951 my $p = HTML::LinkExtor->new();
1952 my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html";
1953 unless (-f $indexfile) {
1954 $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n");
1956 $p->parse_file($indexfile);
1959 if ($arg =~ s|^/(.+)/$|$1|) {
1960 $qrarg = eval 'qr/$arg/'; # hide construct from 5.004
1962 for my $l ($p->links) {
1963 my $tag = shift @$l;
1964 next unless $tag eq "a";
1966 my $href = $att{href};
1967 next unless $href =~ s|^\.\./authors/id/./../||;
1970 if ($href =~ $qrarg) {
1974 if ($href =~ /\Q$arg\E/) {
1982 # now filter for the latest version if there is more than one of a name
1988 $stems{$stem} ||= [];
1989 push @{$stems{$stem}}, $href;
1991 for (sort keys %stems) {
1993 if (@{$stems{$_}} > 1) {
1994 $highest = List::Util::reduce {
1995 Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b
1998 $highest = $stems{$_}[0];
2000 $CPAN::Frontend->myprint("$highest\n");
2004 #-> sub CPAN::Shell::report ;
2006 my($self,@args) = @_;
2007 unless ($CPAN::META->has_inst("CPAN::Reporter")) {
2008 $CPAN::Frontend->mydie("CPAN::Reporter not installed; cannot continue");
2010 local $CPAN::Config->{test_report} = 1;
2011 $self->force("test",@args); # force is there so that the test be
2012 # re-run (as documented)
2015 #-> sub CPAN::Shell::install_tested
2016 sub install_tested {
2017 my($self,@some) = @_;
2018 $CPAN::Frontend->mywarn("install_tested() requires no arguments.\n"),
2020 CPAN::Index->reload;
2022 for my $d (%{$CPAN::META->{readwrite}{'CPAN::Distribution'}}) {
2023 my $do = CPAN::Shell->expandany($d);
2024 next unless $do->{build_dir};
2028 $CPAN::Frontend->mywarn("No tested distributions found.\n"),
2029 return unless @some;
2031 @some = grep { $_->{make_test} && ! $_->{make_test}->failed } @some;
2032 $CPAN::Frontend->mywarn("No distributions tested with this build of perl found.\n"),
2033 return unless @some;
2035 @some = grep { not $_->uptodate } @some;
2036 $CPAN::Frontend->mywarn("No non-uptodate distributions tested with this build of perl found.\n"),
2037 return unless @some;
2039 CPAN->debug("some[@some]");
2041 my $id = $d->can("pretty_id") ? $d->pretty_id : $d->id;
2042 $CPAN::Frontend->myprint("install_tested: Running for $id\n");
2043 $CPAN::Frontend->sleep(1);
2048 #-> sub CPAN::Shell::upgrade ;
2050 my($self,@args) = @_;
2051 $self->install($self->r(@args));
2054 #-> sub CPAN::Shell::_u_r_common ;
2056 my($self) = shift @_;
2057 my($what) = shift @_;
2058 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
2059 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
2060 $what && $what =~ /^[aru]$/;
2062 @args = '/./' unless @args;
2063 my(@result,$module,%seen,%need,$headerdone,
2064 $version_undefs,$version_zeroes);
2065 $version_undefs = $version_zeroes = 0;
2066 my $sprintf = "%s%-25s%s %9s %9s %s\n";
2067 my @expand = $self->expand('Module',@args);
2068 my $expand = scalar @expand;
2069 if (0) { # Looks like noise to me, was very useful for debugging
2070 # for metadata cache
2071 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
2073 MODULE: for $module (@expand) {
2074 my $file = $module->cpan_file;
2075 next MODULE unless defined $file; # ??
2076 $file =~ s|^./../||;
2077 my($latest) = $module->cpan_version;
2078 my($inst_file) = $module->inst_file;
2080 return if $CPAN::Signal;
2083 $have = $module->inst_version;
2084 } elsif ($what eq "r") {
2085 $have = $module->inst_version;
2087 if ($have eq "undef"){
2089 } elsif ($have == 0){
2092 next MODULE unless CPAN::Version->vgt($latest, $have);
2093 # to be pedantic we should probably say:
2094 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
2095 # to catch the case where CPAN has a version 0 and we have a version undef
2096 } elsif ($what eq "u") {
2102 } elsif ($what eq "r") {
2104 } elsif ($what eq "u") {
2108 return if $CPAN::Signal; # this is sometimes lengthy
2111 push @result, sprintf "%s %s\n", $module->id, $have;
2112 } elsif ($what eq "r") {
2113 push @result, $module->id;
2114 next MODULE if $seen{$file}++;
2115 } elsif ($what eq "u") {
2116 push @result, $module->id;
2117 next MODULE if $seen{$file}++;
2118 next MODULE if $file =~ /^Contact/;
2120 unless ($headerdone++){
2121 $CPAN::Frontend->myprint("\n");
2122 $CPAN::Frontend->myprint(sprintf(
2125 "Package namespace",
2137 $CPAN::META->has_inst("Term::ANSIColor")
2139 $module->description
2141 $color_on = Term::ANSIColor::color("green");
2142 $color_off = Term::ANSIColor::color("reset");
2144 $CPAN::Frontend->myprint(sprintf $sprintf,
2151 $need{$module->id}++;
2155 $CPAN::Frontend->myprint("No modules found for @args\n");
2156 } elsif ($what eq "r") {
2157 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
2161 if ($version_zeroes) {
2162 my $s_has = $version_zeroes > 1 ? "s have" : " has";
2163 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
2164 qq{a version number of 0\n});
2166 if ($version_undefs) {
2167 my $s_has = $version_undefs > 1 ? "s have" : " has";
2168 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
2169 qq{parseable version number\n});
2175 #-> sub CPAN::Shell::r ;
2177 shift->_u_r_common("r",@_);
2180 #-> sub CPAN::Shell::u ;
2182 shift->_u_r_common("u",@_);
2185 #-> sub CPAN::Shell::failed ;
2187 my($self,$only_id,$silent) = @_;
2189 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
2191 NAY: for my $nosayer (
2200 next unless exists $d->{$nosayer};
2202 $d->{$nosayer}->can("failed") ?
2203 $d->{$nosayer}->failed :
2204 $d->{$nosayer} =~ /^NO/
2206 next NAY if $only_id && $only_id != (
2207 $d->{$nosayer}->can("commandid")
2209 $d->{$nosayer}->commandid
2211 $CPAN::CurrentCommandId
2216 next DIST unless $failed;
2220 # " %-45s: %s %s\n",
2223 $d->{$failed}->can("failed") ?
2225 $d->{$failed}->commandid,
2228 $d->{$failed}->text,
2238 my $scope = $only_id ? "command" : "session";
2240 my $print = join "",
2241 map { sprintf " %-45s: %s %s\n", @$_[1,2,3] }
2242 sort { $a->[0] <=> $b->[0] } @failed;
2243 $CPAN::Frontend->myprint("Failed during this $scope:\n$print");
2244 } elsif (!$only_id || !$silent) {
2245 $CPAN::Frontend->myprint("Nothing failed in this $scope\n");
2249 # XXX intentionally undocumented because completely bogus, unportable,
2252 #-> sub CPAN::Shell::status ;
2255 require Devel::Size;
2256 my $ps = FileHandle->new;
2257 open $ps, "/proc/$$/status";
2260 next unless /VmSize:\s+(\d+)/;
2264 $CPAN::Frontend->mywarn(sprintf(
2265 "%-27s %6d\n%-27s %6d\n",
2269 Devel::Size::total_size($CPAN::META)/1024,
2271 for my $k (sort keys %$CPAN::META) {
2272 next unless substr($k,0,4) eq "read";
2273 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
2274 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
2275 warn sprintf " %-25s %6d (keys: %6d)\n",
2277 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
2278 scalar keys %{$CPAN::META->{$k}{$k2}};
2283 #-> sub CPAN::Shell::autobundle ;
2286 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
2287 my(@bundle) = $self->_u_r_common("a",@_);
2288 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2289 File::Path::mkpath($todir);
2290 unless (-d $todir) {
2291 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
2294 my($y,$m,$d) = (localtime)[5,4,3];
2298 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
2299 my($to) = File::Spec->catfile($todir,"$me.pm");
2301 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
2302 $to = File::Spec->catfile($todir,"$me.pm");
2304 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
2306 "package Bundle::$me;\n\n",
2307 "\$VERSION = '0.01';\n\n",
2311 "Bundle::$me - Snapshot of installation on ",
2312 $Config::Config{'myhostname'},
2315 "\n\n=head1 SYNOPSIS\n\n",
2316 "perl -MCPAN -e 'install Bundle::$me'\n\n",
2317 "=head1 CONTENTS\n\n",
2318 join("\n", @bundle),
2319 "\n\n=head1 CONFIGURATION\n\n",
2321 "\n\n=head1 AUTHOR\n\n",
2322 "This Bundle has been generated automatically ",
2323 "by the autobundle routine in CPAN.pm.\n",
2326 $CPAN::Frontend->myprint("\nWrote bundle file
2330 #-> sub CPAN::Shell::expandany ;
2333 CPAN->debug("s[$s]") if $CPAN::DEBUG;
2334 if ($s =~ m|/| or substr($s,-1,1) eq ".") { # looks like a file or a directory
2335 $s = CPAN::Distribution->normalize($s);
2336 return $CPAN::META->instance('CPAN::Distribution',$s);
2337 # Distributions spring into existence, not expand
2338 } elsif ($s =~ m|^Bundle::|) {
2339 $self->local_bundles; # scanning so late for bundles seems
2340 # both attractive and crumpy: always
2341 # current state but easy to forget
2343 return $self->expand('Bundle',$s);
2345 return $self->expand('Module',$s)
2346 if $CPAN::META->exists('CPAN::Module',$s);
2351 #-> sub CPAN::Shell::expand ;
2354 my($type,@args) = @_;
2355 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
2356 my $class = "CPAN::$type";
2357 my $methods = ['id'];
2358 for my $meth (qw(name)) {
2359 next if $] < 5.00303; # no "can"
2360 next unless $class->can($meth);
2361 push @$methods, $meth;
2363 $self->expand_by_method($class,$methods,@args);
2366 #-> sub CPAN::Shell::expand_by_method ;
2367 sub expand_by_method {
2369 my($class,$methods,@args) = @_;
2372 my($regex,$command);
2373 if ($arg =~ m|^/(.*)/$|) {
2375 } elsif ($arg =~ m/=/) {
2379 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
2381 defined $regex ? $regex : "UNDEFINED",
2382 defined $command ? $command : "UNDEFINED",
2384 if (defined $regex) {
2386 $CPAN::META->all_objects($class)
2389 # BUG, we got an empty object somewhere
2390 require Data::Dumper;
2391 CPAN->debug(sprintf(
2392 "Bug in CPAN: Empty id on obj[%s][%s]",
2394 Data::Dumper::Dumper($obj)
2398 for my $method (@$methods) {
2399 my $match = eval {$obj->$method() =~ /$regex/i};
2401 my($err) = $@ =~ /^(.+) at .+? line \d+\.$/;
2402 $err ||= $@; # if we were too restrictive above
2403 $CPAN::Frontend->mydie("$err\n");
2410 } elsif ($command) {
2411 die "equal sign in command disabled (immature interface), ".
2413 ! \$CPAN::Shell::ADVANCED_QUERY=1
2414 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
2415 that may go away anytime.\n"
2416 unless $ADVANCED_QUERY;
2417 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
2418 my($matchcrit) = $criterion =~ m/^~(.+)/;
2422 $CPAN::META->all_objects($class)
2424 my $lhs = $self->$method() or next; # () for 5.00503
2426 push @m, $self if $lhs =~ m/$matchcrit/;
2428 push @m, $self if $lhs eq $criterion;
2433 if ( $class eq 'CPAN::Bundle' ) {
2434 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
2435 } elsif ($class eq "CPAN::Distribution") {
2436 $xarg = CPAN::Distribution->normalize($arg);
2440 if ($CPAN::META->exists($class,$xarg)) {
2441 $obj = $CPAN::META->instance($class,$xarg);
2442 } elsif ($CPAN::META->exists($class,$arg)) {
2443 $obj = $CPAN::META->instance($class,$arg);
2450 @m = sort {$a->id cmp $b->id} @m;
2451 if ( $CPAN::DEBUG ) {
2452 my $wantarray = wantarray;
2453 my $join_m = join ",", map {$_->id} @m;
2454 $self->debug("wantarray[$wantarray]join_m[$join_m]");
2456 return wantarray ? @m : $m[0];
2459 #-> sub CPAN::Shell::format_result ;
2462 my($type,@args) = @_;
2463 @args = '/./' unless @args;
2464 my(@result) = $self->expand($type,@args);
2465 my $result = @result == 1 ?
2466 $result[0]->as_string :
2468 "No objects of type $type found for argument @args\n" :
2470 (map {$_->as_glimpse} @result),
2471 scalar @result, " items found\n",
2476 #-> sub CPAN::Shell::report_fh ;
2478 my $installation_report_fh;
2479 my $previously_noticed = 0;
2482 return $installation_report_fh if $installation_report_fh;
2483 if ($CPAN::META->has_inst("File::Temp")) {
2484 $installation_report_fh
2486 template => 'cpan_install_XXXX',
2491 unless ( $installation_report_fh ) {
2492 warn("Couldn't open installation report file; " .
2493 "no report file will be generated."
2494 ) unless $previously_noticed++;
2500 # The only reason for this method is currently to have a reliable
2501 # debugging utility that reveals which output is going through which
2502 # channel. No, I don't like the colors ;-)
2504 # to turn colordebugging on, write
2505 # cpan> o conf colorize_output 1
2507 #-> sub CPAN::Shell::print_ornamented ;
2509 my $print_ornamented_have_warned = 0;
2510 sub colorize_output {
2511 my $colorize_output = $CPAN::Config->{colorize_output};
2512 if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) {
2513 unless ($print_ornamented_have_warned++) {
2514 # no myprint/mywarn within myprint/mywarn!
2515 warn "Colorize_output is set to true but Term::ANSIColor is not
2516 installed. To activate colorized output, please install Term::ANSIColor.\n\n";
2518 $colorize_output = 0;
2520 return $colorize_output;
2525 #-> sub CPAN::Shell::print_ornamented ;
2526 sub print_ornamented {
2527 my($self,$what,$ornament) = @_;
2528 return unless defined $what;
2530 local $| = 1; # Flush immediately
2531 if ( $CPAN::Be_Silent ) {
2532 print {report_fh()} $what;
2535 my $swhat = "$what"; # stringify if it is an object
2536 if ($CPAN::Config->{term_is_latin}){
2539 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
2541 if ($self->colorize_output) {
2542 if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) {
2543 # if you want to have this configurable, please file a bugreport
2544 $ornament = "black on_cyan";
2546 my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
2548 print "Term::ANSIColor rejects color[$ornament]: $@\n
2549 Please choose a different color (Hint: try 'o conf init color.*')\n";
2553 Term::ANSIColor::color("reset");
2559 #-> sub CPAN::Shell::myprint ;
2561 # where is myprint/mywarn/Frontend/etc. documented? We need guidelines
2562 # where to use what! I think, we send everything to STDOUT and use
2563 # print for normal/good news and warn for news that need more
2564 # attention. Yes, this is our working contract for now.
2566 my($self,$what) = @_;
2568 $self->print_ornamented($what, $CPAN::Config->{colorize_print}||'bold blue on_white');
2571 #-> sub CPAN::Shell::myexit ;
2573 my($self,$what) = @_;
2574 $self->myprint($what);
2578 #-> sub CPAN::Shell::mywarn ;
2580 my($self,$what) = @_;
2581 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2584 # only to be used for shell commands
2585 #-> sub CPAN::Shell::mydie ;
2587 my($self,$what) = @_;
2588 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2590 # If it is the shell, we want that the following die to be silent,
2591 # but if it is not the shell, we would need a 'die $what'. We need
2592 # to take care that only shell commands use mydie. Is this
2598 # sub CPAN::Shell::colorable_makemaker_prompt ;
2599 sub colorable_makemaker_prompt {
2601 if (CPAN::Shell->colorize_output) {
2602 my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white';
2603 my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
2606 my $ans = ExtUtils::MakeMaker::prompt($foo,$bar);
2607 if (CPAN::Shell->colorize_output) {
2608 print Term::ANSIColor::color('reset');
2613 # use this only for unrecoverable errors!
2614 #-> sub CPAN::Shell::unrecoverable_error ;
2615 sub unrecoverable_error {
2616 my($self,$what) = @_;
2617 my @lines = split /\n/, $what;
2619 for my $l (@lines) {
2620 $longest = length $l if length $l > $longest;
2622 $longest = 62 if $longest > 62;
2623 for my $l (@lines) {
2629 if (length $l < 66) {
2630 $l = pack "A66 A*", $l, "<==";
2634 unshift @lines, "\n";
2635 $self->mydie(join "", @lines);
2638 #-> sub CPAN::Shell::mysleep ;
2640 my($self, $sleep) = @_;
2644 #-> sub CPAN::Shell::setup_output ;
2646 return if -t STDOUT;
2647 my $odef = select STDERR;
2654 #-> sub CPAN::Shell::rematein ;
2655 # RE-adme||MA-ke||TE-st||IN-stall
2658 my($meth,@some) = @_;
2660 while($meth =~ /^(force|notest)$/) {
2661 push @pragma, $meth;
2662 $meth = shift @some or
2663 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
2667 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
2669 # Here is the place to set "test_count" on all involved parties to
2670 # 0. We then can pass this counter on to the involved
2671 # distributions and those can refuse to test if test_count > X. In
2672 # the first stab at it we could use a 1 for "X".
2674 # But when do I reset the distributions to start with 0 again?
2675 # Jost suggested to have a random or cycling interaction ID that
2676 # we pass through. But the ID is something that is just left lying
2677 # around in addition to the counter, so I'd prefer to set the
2678 # counter to 0 now, and repeat at the end of the loop. But what
2679 # about dependencies? They appear later and are not reset, they
2680 # enter the queue but not its copy. How do they get a sensible
2683 # construct the queue
2685 STHING: foreach $s (@some) {
2688 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
2690 } elsif ($s =~ m|[\$\@\%]|) { # looks like a perl variable
2691 } elsif ($s =~ m|^/|) { # looks like a regexp
2692 if (substr($s,-1,1) eq ".") {
2693 $obj = CPAN::Shell->expandany($s);
2695 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
2696 "not supported.\nRejecting argument '$s'\n");
2697 $CPAN::Frontend->mysleep(2);
2700 } elsif ($meth eq "ls") {
2701 $self->globls($s,\@pragma);
2704 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
2705 $obj = CPAN::Shell->expandany($s);
2708 } elsif (ref $obj) {
2709 $obj->color_cmd_tmps(0,1);
2710 CPAN::Queue->new(qmod => $obj->id, reqtype => "c");
2712 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
2713 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
2714 if ($meth =~ /^(dump|ls)$/) {
2717 $CPAN::Frontend->mywarn(
2719 "Don't be silly, you can't $meth ",
2723 $CPAN::Frontend->mysleep(2);
2725 } elsif ($s =~ m|[\$\@\%]| && $meth eq "dump") {
2726 CPAN::InfoObj->dump($s);
2729 ->mywarn(qq{Warning: Cannot $meth $s, }.
2730 qq{don't know what it is.
2735 to find objects with matching identifiers.
2737 $CPAN::Frontend->mysleep(2);
2741 # queuerunner (please be warned: when I started to change the
2742 # queue to hold objects instead of names, I made one or two
2743 # mistakes and never found which. I reverted back instead)
2744 while (my $q = CPAN::Queue->first) {
2746 my $s = $q->as_string;
2747 my $reqtype = $q->reqtype || "";
2748 $obj = CPAN::Shell->expandany($s);
2749 $obj->{reqtype} ||= "";
2750 CPAN->debug("obj-reqtype[$obj->{reqtype}]".
2751 "q-reqtype[$reqtype]") if $CPAN::DEBUG;
2752 if ($obj->{reqtype}) {
2753 if ($obj->{reqtype} eq "b" && $reqtype =~ /^[rc]$/) {
2754 $obj->{reqtype} = $reqtype;
2756 exists $obj->{install}
2759 $obj->{install}->can("failed") ?
2760 $obj->{install}->failed :
2761 $obj->{install} =~ /^NO/
2764 delete $obj->{install};
2765 $CPAN::Frontend->mywarn
2766 ("Promoting $obj->{ID} from 'build_requires' to 'requires'");
2770 $obj->{reqtype} = $reqtype;
2773 for my $pragma (@pragma) {
2776 $obj->can($pragma)){
2777 $obj->$pragma($meth);
2780 if ($obj->can('called_for')) {
2781 $obj->called_for($s);
2783 CPAN->debug(qq{pragma[@pragma]meth[$meth]}.
2784 qq{ID[$obj->{ID}]}) if $CPAN::DEBUG;
2788 CPAN::Queue->delete($s);
2790 CPAN->debug("failed");
2794 for my $pragma (@pragma) {
2795 my $unpragma = "un$pragma";
2796 if ($obj->can($unpragma)) {
2800 CPAN::Queue->delete_first($s);
2802 for my $obj (@qcopy) {
2803 $obj->color_cmd_tmps(0,0);
2807 #-> sub CPAN::Shell::recent ;
2811 CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
2816 # set up the dispatching methods
2818 for my $command (qw(
2833 *$command = sub { shift->rematein($command, @_); };
2837 package CPAN::LWP::UserAgent;
2841 return if $SETUPDONE;
2842 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2843 require LWP::UserAgent;
2844 @ISA = qw(Exporter LWP::UserAgent);
2847 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
2851 sub get_basic_credentials {
2852 my($self, $realm, $uri, $proxy) = @_;
2853 if ($USER && $PASSWD) {
2854 return ($USER, $PASSWD);
2857 ($USER,$PASSWD) = $self->get_proxy_credentials();
2859 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
2861 return($USER,$PASSWD);
2864 sub get_proxy_credentials {
2866 my ($user, $password);
2867 if ( defined $CPAN::Config->{proxy_user} &&
2868 defined $CPAN::Config->{proxy_pass}) {
2869 $user = $CPAN::Config->{proxy_user};
2870 $password = $CPAN::Config->{proxy_pass};
2871 return ($user, $password);
2873 my $username_prompt = "\nProxy authentication needed!
2874 (Note: to permanently configure username and password run
2875 o conf proxy_user your_username
2876 o conf proxy_pass your_password
2878 ($user, $password) =
2879 _get_username_and_password_from_user($username_prompt);
2880 return ($user,$password);
2883 sub get_non_proxy_credentials {
2885 my ($user,$password);
2886 if ( defined $CPAN::Config->{username} &&
2887 defined $CPAN::Config->{password}) {
2888 $user = $CPAN::Config->{username};
2889 $password = $CPAN::Config->{password};
2890 return ($user, $password);
2892 my $username_prompt = "\nAuthentication needed!
2893 (Note: to permanently configure username and password run
2894 o conf username your_username
2895 o conf password your_password
2898 ($user, $password) =
2899 _get_username_and_password_from_user($username_prompt);
2900 return ($user,$password);
2903 sub _get_username_and_password_from_user {
2904 my $username_message = shift;
2905 my ($username,$password);
2907 ExtUtils::MakeMaker->import(qw(prompt));
2908 $username = prompt($username_message);
2909 if ($CPAN::META->has_inst("Term::ReadKey")) {
2910 Term::ReadKey::ReadMode("noecho");
2913 $CPAN::Frontend->mywarn(
2914 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
2917 $password = prompt("Password:");
2919 if ($CPAN::META->has_inst("Term::ReadKey")) {
2920 Term::ReadKey::ReadMode("restore");
2922 $CPAN::Frontend->myprint("\n\n");
2923 return ($username,$password);
2926 # mirror(): Its purpose is to deal with proxy authentication. When we
2927 # call SUPER::mirror, we relly call the mirror method in
2928 # LWP::UserAgent. LWP::UserAgent will then call
2929 # $self->get_basic_credentials or some equivalent and this will be
2930 # $self->dispatched to our own get_basic_credentials method.
2932 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2934 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2935 # although we have gone through our get_basic_credentials, the proxy
2936 # server refuses to connect. This could be a case where the username or
2937 # password has changed in the meantime, so I'm trying once again without
2938 # $USER and $PASSWD to give the get_basic_credentials routine another
2939 # chance to set $USER and $PASSWD.
2941 # mirror(): Its purpose is to deal with proxy authentication. When we
2942 # call SUPER::mirror, we relly call the mirror method in
2943 # LWP::UserAgent. LWP::UserAgent will then call
2944 # $self->get_basic_credentials or some equivalent and this will be
2945 # $self->dispatched to our own get_basic_credentials method.
2947 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2949 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2950 # although we have gone through our get_basic_credentials, the proxy
2951 # server refuses to connect. This could be a case where the username or
2952 # password has changed in the meantime, so I'm trying once again without
2953 # $USER and $PASSWD to give the get_basic_credentials routine another
2954 # chance to set $USER and $PASSWD.
2957 my($self,$url,$aslocal) = @_;
2958 my $result = $self->SUPER::mirror($url,$aslocal);
2959 if ($result->code == 407) {
2962 $result = $self->SUPER::mirror($url,$aslocal);
2970 #-> sub CPAN::FTP::ftp_statistics
2971 # if they want to rewrite, they need to pass in a filehandle
2972 sub _ftp_statistics {
2974 my $locktype = $fh ? LOCK_EX : LOCK_SH;
2975 $fh ||= FileHandle->new;
2976 my $file = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
2977 open $fh, "+>>$file" or $CPAN::Frontend->mydie("Could not open '$file': $!");
2979 while (!flock $fh, $locktype|LOCK_NB) {
2983 $CPAN::Frontend->mysleep($sleep++);
2985 my $stats = CPAN->_yaml_loadfile($file);
2986 if ($locktype == LOCK_SH) {
2989 if (@$stats){ # no yaml no write
2997 if (CPAN->has_inst("Time::HiRes")) {
2998 return Time::HiRes::time();
3005 my($self,$file) = @_;
3014 sub _add_to_statistics {
3015 my($self,$stats) = @_;
3016 $stats->{thesiteurl} = $ThesiteURL;
3017 if (CPAN->has_inst("Time::HiRes")) {
3018 $stats->{end} = Time::HiRes::time();
3020 $stats->{end} = time;
3022 my $fh = FileHandle->new;
3023 my $fullstats = $self->_ftp_statistics($fh);
3024 push @{$fullstats->{history}}, $stats;
3026 shift @{$fullstats->{history}}
3027 while $time - $fullstats->{history}[0]{start} > 30*86400; # one month too much?
3028 CPAN->_yaml_dumpfile($fh,$fullstats);
3031 # if file is CHECKSUMS, suggest the place where we got the file to be
3032 # checked from, maybe only for young files?
3033 sub _recommend_url_for {
3034 my($self, $file) = @_;
3035 my $urllist = $self->_get_urllist;
3036 if ($file =~ s|/CHECKSUMS(.gz)?$||) {
3037 my $fullstats = $self->_ftp_statistics();
3038 my $history = $fullstats->{history} || [];
3039 while (my $last = pop @$history) {
3040 last if $last->{end} - time > 3600; # only young results are interesting
3041 next unless $file eq File::Basename::dirname($last->{file});
3042 return $last->{thesiteurl};
3045 if ($CPAN::Config->{randomize_urllist}
3047 rand(1) < $CPAN::Config->{randomize_urllist}
3049 $urllist->[int rand scalar @$urllist];
3057 $CPAN::Config->{urllist} ||= [];
3058 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
3059 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
3060 $CPAN::Config->{urllist} = [];
3062 my @urllist = grep { defined $_ and length $_ } @{$CPAN::Config->{urllist}};
3063 for my $u (@urllist) {
3064 CPAN->debug("u[$u]") if $CPAN::DEBUG;
3065 if (UNIVERSAL::can($u,"text")) {
3066 $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
3068 $u .= "/" unless substr($u,-1) eq "/";
3069 $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
3075 #-> sub CPAN::FTP::ftp_get ;
3077 my($class,$host,$dir,$file,$target) = @_;
3079 qq[Going to fetch file [$file] from dir [$dir]
3080 on host [$host] as local [$target]\n]
3082 my $ftp = Net::FTP->new($host);
3084 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
3087 return 0 unless defined $ftp;
3088 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
3089 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
3090 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
3091 my $msg = $ftp->message;
3092 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
3095 unless ( $ftp->cwd($dir) ){
3096 my $msg = $ftp->message;
3097 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
3101 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
3102 unless ( $ftp->get($file,$target) ){
3103 my $msg = $ftp->message;
3104 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
3107 $ftp->quit; # it's ok if this fails
3111 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
3113 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
3114 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
3116 # > *** 1562,1567 ****
3117 # > --- 1562,1580 ----
3118 # > return 1 if substr($url,0,4) eq "file";
3119 # > return 1 unless $url =~ m|://([^/]+)|;
3121 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
3123 # > + $proxy =~ m|://([^/:]+)|;
3125 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
3126 # > + if ($noproxy) {
3127 # > + if ($host !~ /$noproxy$/) {
3128 # > + $host = $proxy;
3131 # > + $host = $proxy;
3134 # > require Net::Ping;
3135 # > return 1 unless $Net::Ping::VERSION >= 2;
3139 #-> sub CPAN::FTP::localize ;
3141 my($self,$file,$aslocal,$force) = @_;
3143 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
3144 unless defined $aslocal;
3145 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
3148 if ($^O eq 'MacOS') {
3149 # Comment by AK on 2000-09-03: Uniq short filenames would be
3150 # available in CHECKSUMS file
3151 my($name, $path) = File::Basename::fileparse($aslocal, '');
3152 if (length($name) > 31) {
3163 my $size = 31 - length($suf);
3164 while (length($name) > $size) {
3168 $aslocal = File::Spec->catfile($path, $name);
3172 if (-f $aslocal && -r _ && !($force & 1)){
3174 if ($size = -s $aslocal) {
3175 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
3178 # empty file from a previous unsuccessful attempt to download it
3180 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
3181 "could not remove.");
3184 my($maybe_restore) = 0;
3186 rename $aslocal, "$aslocal.bak$$";
3190 my($aslocal_dir) = File::Basename::dirname($aslocal);
3191 File::Path::mkpath($aslocal_dir);
3192 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
3193 qq{directory "$aslocal_dir".
3194 I\'ll continue, but if you encounter problems, they may be due
3195 to insufficient permissions.\n}) unless -w $aslocal_dir;
3197 # Inheritance is not easier to manage than a few if/else branches
3198 if ($CPAN::META->has_usable('LWP::UserAgent')) {
3200 CPAN::LWP::UserAgent->config;
3201 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
3203 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
3207 $Ua->proxy('ftp', $var)
3208 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
3209 $Ua->proxy('http', $var)
3210 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
3213 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
3215 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
3216 # > use ones that require basic autorization.
3218 # > Example of when I use it manually in my own stuff:
3220 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
3221 # > $req->proxy_authorization_basic("username","password");
3222 # > $res = $ua->request($req);
3226 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
3230 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
3231 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
3234 # Try the list of urls for each single object. We keep a record
3235 # where we did get a file from
3236 my(@reordered,$last);
3237 my $ccurllist = $self->_get_urllist;
3238 $last = $#$ccurllist;
3239 if ($force & 2) { # local cpans probably out of date, don't reorder
3240 @reordered = (0..$last);
3244 (substr($ccurllist->[$b],0,4) eq "file")
3246 (substr($ccurllist->[$a],0,4) eq "file")
3248 defined($ThesiteURL)
3250 ($ccurllist->[$b] eq $ThesiteURL)
3252 ($ccurllist->[$a] eq $ThesiteURL)
3257 $self->debug("Themethod[$Themethod]reordered[@reordered]") if $CPAN::DEBUG;
3259 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
3261 @levels = qw/easy hard hardest/;
3263 @levels = qw/easy/ if $^O eq 'MacOS';
3265 local $ENV{FTP_PASSIVE} =
3266 exists $CPAN::Config->{ftp_passive} ?
3267 $CPAN::Config->{ftp_passive} : 1;
3269 my $stats = $self->_new_stats($file);
3270 LEVEL: for $levelno (0..$#levels) {
3271 my $level = $levels[$levelno];
3272 my $method = "host$level";
3273 my @host_seq = $level eq "easy" ?
3274 @reordered : 0..$last; # reordered has CDROM up front
3275 my @urllist = map { $ccurllist->[$_] } @host_seq;
3276 for my $u (@CPAN::Defaultsites) {
3277 push @urllist, $u unless grep { $_ eq $u } @urllist;
3279 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
3280 my $aslocal_tempfile = $aslocal . ".tmp" . $$;
3281 if (my $recommend = $self->_recommend_url_for($file)) {
3282 @urllist = grep { $_ ne $recommend } @urllist;
3283 unshift @urllist, $recommend;
3285 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
3286 $ret = $self->$method(\@urllist,$file,$aslocal_tempfile,$stats);
3288 CPAN->debug("ret[$ret]aslocal[$aslocal]") if $CPAN::DEBUG;
3289 if ($ret eq $aslocal_tempfile) {
3290 # if we got it exactly as we asked for, only then we
3292 rename $aslocal_tempfile, $aslocal
3293 or $CPAN::Frontend->mydie("Error while trying to rename ".
3294 "'$ret' to '$aslocal': $!");
3297 $Themethod = $level;
3299 # utime $now, $now, $aslocal; # too bad, if we do that, we
3300 # might alter a local mirror
3301 $self->debug("level[$level]") if $CPAN::DEBUG;
3304 unlink $aslocal_tempfile;
3305 last if $CPAN::Signal; # need to cleanup
3309 $stats->{filesize} = -s $ret;
3311 $self->_add_to_statistics($stats);
3315 unless ($CPAN::Signal) {
3318 if (@{$CPAN::Config->{urllist}}) {
3320 qq{Please check, if the URLs I found in your configuration file \(}.
3321 join(", ", @{$CPAN::Config->{urllist}}).
3324 push @mess, qq{Your urllist is empty!};
3326 push @mess, qq{The urllist can be edited.},
3327 qq{E.g. with 'o conf urllist push ftp://myurl/'};
3328 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
3329 $CPAN::Frontend->mywarn("Could not fetch $file\n");
3330 $CPAN::Frontend->mysleep(2);
3332 if ($maybe_restore) {
3333 rename "$aslocal.bak$$", $aslocal;
3334 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
3335 $self->ls($aslocal));
3342 my($self,$stats,$method,$url) = @_;
3343 push @{$stats->{attempts}}, {
3350 # package CPAN::FTP;
3352 my($self,$host_seq,$file,$aslocal,$stats) = @_;
3354 HOSTEASY: for $ro_url (@$host_seq) {
3355 $self->_set_attempt($stats,"easy",$ro_url);
3356 my $url .= "$ro_url$file";
3357 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
3358 if ($url =~ /^file:/) {
3360 if ($CPAN::META->has_inst('URI::URL')) {
3361 my $u = URI::URL->new($url);
3363 } else { # works only on Unix, is poorly constructed, but
3364 # hopefully better than nothing.
3365 # RFC 1738 says fileurl BNF is
3366 # fileurl = "file://" [ host | "localhost" ] "/" fpath
3367 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
3369 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
3370 $l =~ s|^file:||; # assume they
3374 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
3376 $self->debug("local file[$l]") if $CPAN::DEBUG;
3377 if ( -f $l && -r _) {
3378 $ThesiteURL = $ro_url;
3381 if ($l =~ /(.+)\.gz$/) {
3383 if ( -f $ungz && -r _) {
3384 $ThesiteURL = $ro_url;
3388 # Maybe mirror has compressed it?
3390 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
3391 CPAN::Tarzip->new("$l.gz")->gunzip($aslocal);
3393 $ThesiteURL = $ro_url;
3398 $self->debug("it was not a file URL") if $CPAN::DEBUG;
3399 if ($CPAN::META->has_usable('LWP')) {
3400 $CPAN::Frontend->myprint("Fetching with LWP:
3404 CPAN::LWP::UserAgent->config;
3405 eval { $Ua = CPAN::LWP::UserAgent->new; };
3407 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
3410 my $res = $Ua->mirror($url, $aslocal);
3411 if ($res->is_success) {
3412 $ThesiteURL = $ro_url;
3414 utime $now, $now, $aslocal; # download time is more
3415 # important than upload
3418 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3419 my $gzurl = "$url.gz";
3420 $CPAN::Frontend->myprint("Fetching with LWP:
3423 $res = $Ua->mirror($gzurl, "$aslocal.gz");
3424 if ($res->is_success &&
3425 CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)
3427 $ThesiteURL = $ro_url;
3431 $CPAN::Frontend->myprint(sprintf(
3432 "LWP failed with code[%s] message[%s]\n",
3436 # Alan Burlison informed me that in firewall environments
3437 # Net::FTP can still succeed where LWP fails. So we do not
3438 # skip Net::FTP anymore when LWP is available.
3441 $CPAN::Frontend->mywarn(" LWP not available\n");
3443 return if $CPAN::Signal;
3444 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3445 # that's the nice and easy way thanks to Graham
3446 $self->debug("recognized ftp") if $CPAN::DEBUG;
3447 my($host,$dir,$getfile) = ($1,$2,$3);
3448 if ($CPAN::META->has_usable('Net::FTP')) {
3450 $CPAN::Frontend->myprint("Fetching with Net::FTP:
3453 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
3454 "aslocal[$aslocal]") if $CPAN::DEBUG;
3455 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
3456 $ThesiteURL = $ro_url;
3459 if ($aslocal !~ /\.gz(?!\n)\Z/) {
3460 my $gz = "$aslocal.gz";
3461 $CPAN::Frontend->myprint("Fetching with Net::FTP
3464 if (CPAN::FTP->ftp_get($host,
3468 CPAN::Tarzip->new($gz)->gunzip($aslocal)
3470 $ThesiteURL = $ro_url;
3476 CPAN->debug("Net::FTP does not count as usable atm") if $CPAN::DEBUG;
3480 UNIVERSAL::can($ro_url,"text")
3482 $ro_url->{FROM} eq "USER"
3484 ##address #17973: default URLs should not try to override
3485 ##user-defined URLs just because LWP is not available
3486 my $ret = $self->hosthard([$ro_url],$file,$aslocal,$stats);
3487 return $ret if $ret;
3489 return if $CPAN::Signal;
3493 # package CPAN::FTP;
3495 my($self,$host_seq,$file,$aslocal,$stats) = @_;
3497 # Came back if Net::FTP couldn't establish connection (or
3498 # failed otherwise) Maybe they are behind a firewall, but they
3499 # gave us a socksified (or other) ftp program...
3502 my($devnull) = $CPAN::Config->{devnull} || "";
3504 my($aslocal_dir) = File::Basename::dirname($aslocal);
3505 File::Path::mkpath($aslocal_dir);
3506 HOSTHARD: for $ro_url (@$host_seq) {
3507 $self->_set_attempt($stats,"hard",$ro_url);
3508 my $url = "$ro_url$file";
3509 my($proto,$host,$dir,$getfile);
3511 # Courtesy Mark Conty mark_conty@cargill.com change from
3512 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3514 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
3515 # proto not yet used
3516 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
3518 next HOSTHARD; # who said, we could ftp anything except ftp?
3520 next HOSTHARD if $proto eq "file"; # file URLs would have had
3521 # success above. Likely a bogus URL
3523 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
3525 # Try the most capable first and leave ncftp* for last as it only
3527 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
3528 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
3529 next unless defined $funkyftp;
3530 next if $funkyftp =~ /^\s*$/;
3532 my($asl_ungz, $asl_gz);
3533 ($asl_ungz = $aslocal) =~ s/\.gz//;
3534 $asl_gz = "$asl_ungz.gz";
3536 my($src_switch) = "";
3538 my($stdout_redir) = " > $asl_ungz";
3540 $src_switch = " -source";
3541 } elsif ($f eq "ncftp"){
3542 $src_switch = " -c";
3543 } elsif ($f eq "wget"){
3544 $src_switch = " -O $asl_ungz";
3546 } elsif ($f eq 'curl'){
3547 $src_switch = ' -L -f -s -S --netrc-optional';
3550 if ($f eq "ncftpget"){
3551 $chdir = "cd $aslocal_dir && ";
3554 $CPAN::Frontend->myprint(
3556 Trying with "$funkyftp$src_switch" to get
3560 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
3561 $self->debug("system[$system]") if $CPAN::DEBUG;
3562 my($wstatus) = system($system);
3564 # lynx returns 0 when it fails somewhere
3566 my $content = do { local *FH;
3567 open FH, $asl_ungz or die;
3570 if ($content =~ /^<.*(<title>[45]|Error [45])/si) {
3571 $CPAN::Frontend->mywarn(qq{
3572 No success, the file that lynx has has downloaded looks like an error message:
3575 $CPAN::Frontend->mysleep(1);
3579 $CPAN::Frontend->myprint(qq{
3580 No success, the file that lynx has has downloaded is an empty file.
3585 if ($wstatus == 0) {
3588 } elsif ($asl_ungz ne $aslocal) {
3589 # test gzip integrity
3590 if (CPAN::Tarzip->new($asl_ungz)->gtest) {
3591 # e.g. foo.tar is gzipped --> foo.tar.gz
3592 rename $asl_ungz, $aslocal;
3594 CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz);
3597 $ThesiteURL = $ro_url;
3599 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3601 -f $asl_ungz && -s _ == 0;
3602 my $gz = "$aslocal.gz";
3603 my $gzurl = "$url.gz";
3604 $CPAN::Frontend->myprint(
3606 Trying with "$funkyftp$src_switch" to get
3609 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
3610 $self->debug("system[$system]") if $CPAN::DEBUG;
3612 if (($wstatus = system($system)) == 0
3616 # test gzip integrity
3617 my $ct = CPAN::Tarzip->new($asl_gz);
3619 $ct->gunzip($aslocal);
3621 # somebody uncompressed file for us?
3622 rename $asl_ungz, $aslocal;
3624 $ThesiteURL = $ro_url;
3627 unlink $asl_gz if -f $asl_gz;
3630 my $estatus = $wstatus >> 8;
3631 my $size = -f $aslocal ?
3632 ", left\n$aslocal with size ".-s _ :
3633 "\nWarning: expected file [$aslocal] doesn't exist";
3634 $CPAN::Frontend->myprint(qq{
3635 System call "$system"
3636 returned status $estatus (wstat $wstatus)$size
3639 return if $CPAN::Signal;
3640 } # transfer programs
3644 # package CPAN::FTP;
3646 my($self,$host_seq,$file,$aslocal,$stats) = @_;
3649 my($aslocal_dir) = File::Basename::dirname($aslocal);
3650 File::Path::mkpath($aslocal_dir);
3651 my $ftpbin = $CPAN::Config->{ftp};
3652 unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) {
3653 $CPAN::Frontend->myprint("No external ftp command available\n\n");
3656 $CPAN::Frontend->mywarn(qq{
3657 As a last ressort we now switch to the external ftp command '$ftpbin'
3660 Doing so often leads to problems that are hard to diagnose.
3662 If you're victim of such problems, please consider unsetting the ftp
3663 config variable with
3669 $CPAN::Frontend->mysleep(2);
3670 HOSTHARDEST: for $ro_url (@$host_seq) {
3671 $self->_set_attempt($stats,"hardest",$ro_url);
3672 my $url = "$ro_url$file";
3673 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
3674 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3677 my($host,$dir,$getfile) = ($1,$2,$3);
3679 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
3680 $ctime,$blksize,$blocks) = stat($aslocal);
3681 $timestamp = $mtime ||= 0;
3682 my($netrc) = CPAN::FTP::netrc->new;
3683 my($netrcfile) = $netrc->netrc;
3684 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
3685 my $targetfile = File::Basename::basename($aslocal);
3691 map("cd $_", split /\//, $dir), # RFC 1738
3693 "get $getfile $targetfile",
3697 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
3698 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
3699 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
3701 $netrc->contains($host))) if $CPAN::DEBUG;
3702 if ($netrc->protected) {
3703 my $dialog = join "", map { " $_\n" } @dialog;
3705 if ($netrc->contains($host)) {
3706 $netrc_explain = "Relying that your .netrc entry for '$host' ".
3707 "manages the login";
3709 $netrc_explain = "Relying that your default .netrc entry ".
3710 "manages the login";
3712 $CPAN::Frontend->myprint(qq{
3713 Trying with external ftp to get
3716 Going to send the dialog
3720 $self->talk_ftp("$ftpbin$verbose $host",
3722 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3723 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3725 if ($mtime > $timestamp) {
3726 $CPAN::Frontend->myprint("GOT $aslocal\n");
3727 $ThesiteURL = $ro_url;
3730 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
3732 return if $CPAN::Signal;
3734 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
3735 qq{correctly protected.\n});
3738 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
3739 nor does it have a default entry\n");
3742 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
3743 # then and login manually to host, using e-mail as
3745 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
3749 "user anonymous $Config::Config{'cf_email'}"
3751 my $dialog = join "", map { " $_\n" } @dialog;
3752 $CPAN::Frontend->myprint(qq{
3753 Trying with external ftp to get
3755 Going to send the dialog
3759 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
3760 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3761 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3763 if ($mtime > $timestamp) {
3764 $CPAN::Frontend->myprint("GOT $aslocal\n");
3765 $ThesiteURL = $ro_url;
3768 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
3770 return if $CPAN::Signal;
3771 $CPAN::Frontend->mywarn("Can't access URL $url.\n\n");
3772 $CPAN::Frontend->mysleep(2);
3776 # package CPAN::FTP;
3778 my($self,$command,@dialog) = @_;
3779 my $fh = FileHandle->new;
3780 $fh->open("|$command") or die "Couldn't open ftp: $!";
3781 foreach (@dialog) { $fh->print("$_\n") }
3782 $fh->close; # Wait for process to complete
3784 my $estatus = $wstatus >> 8;
3785 $CPAN::Frontend->myprint(qq{
3786 Subprocess "|$command"
3787 returned status $estatus (wstat $wstatus)
3791 # find2perl needs modularization, too, all the following is stolen
3795 my($self,$name) = @_;
3796 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
3797 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
3799 my($perms,%user,%group);
3803 $blocks = int(($blocks + 1) / 2);
3806 $blocks = int(($sizemm + 1023) / 1024);
3809 if (-f _) { $perms = '-'; }
3810 elsif (-d _) { $perms = 'd'; }
3811 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
3812 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
3813 elsif (-p _) { $perms = 'p'; }
3814 elsif (-S _) { $perms = 's'; }
3815 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
3817 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
3818 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
3819 my $tmpmode = $mode;
3820 my $tmp = $rwx[$tmpmode & 7];
3822 $tmp = $rwx[$tmpmode & 7] . $tmp;
3824 $tmp = $rwx[$tmpmode & 7] . $tmp;
3825 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
3826 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
3827 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
3830 my $user = $user{$uid} || $uid; # too lazy to implement lookup
3831 my $group = $group{$gid} || $gid;
3833 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
3835 my($moname) = $moname[$mon];
3836 if (-M _ > 365.25 / 2) {
3837 $timeyear = $year + 1900;
3840 $timeyear = sprintf("%02d:%02d", $hour, $min);
3843 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
3857 package CPAN::FTP::netrc;
3860 # package CPAN::FTP::netrc;
3863 my $home = CPAN::HandleConfig::home;
3864 my $file = File::Spec->catfile($home,".netrc");
3866 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3867 $atime,$mtime,$ctime,$blksize,$blocks)
3872 my($fh,@machines,$hasdefault);
3874 $fh = FileHandle->new or die "Could not create a filehandle";
3876 if($fh->open($file)){
3877 $protected = ($mode & 077) == 0;
3879 NETRC: while (<$fh>) {
3880 my(@tokens) = split " ", $_;
3881 TOKEN: while (@tokens) {
3882 my($t) = shift @tokens;
3883 if ($t eq "default"){
3887 last TOKEN if $t eq "macdef";
3888 if ($t eq "machine") {
3889 push @machines, shift @tokens;
3894 $file = $hasdefault = $protected = "";
3898 'mach' => [@machines],
3900 'hasdefault' => $hasdefault,
3901 'protected' => $protected,
3905 # CPAN::FTP::netrc::hasdefault;
3906 sub hasdefault { shift->{'hasdefault'} }
3907 sub netrc { shift->{'netrc'} }
3908 sub protected { shift->{'protected'} }
3910 my($self,$mach) = @_;
3911 for ( @{$self->{'mach'}} ) {
3912 return 1 if $_ eq $mach;
3917 package CPAN::Complete;
3921 my($text, $line, $start, $end) = @_;
3922 my(@perlret) = cpl($text, $line, $start);
3923 # find longest common match. Can anybody show me how to peruse
3924 # T::R::Gnu to have this done automatically? Seems expensive.
3925 return () unless @perlret;
3926 my($newtext) = $text;
3927 for (my $i = length($text)+1;;$i++) {
3928 last unless length($perlret[0]) && length($perlret[0]) >= $i;
3929 my $try = substr($perlret[0],0,$i);
3930 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
3931 # warn "try[$try]tries[@tries]";
3932 if (@tries == @perlret) {
3938 ($newtext,@perlret);
3941 #-> sub CPAN::Complete::cpl ;
3943 my($word,$line,$pos) = @_;
3947 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3949 if ($line =~ s/^(force\s*)//) {
3954 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
3955 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
3957 } elsif ($line =~ /^(a|ls)\s/) {
3958 @return = cplx('CPAN::Author',uc($word));
3959 } elsif ($line =~ /^b\s/) {
3960 CPAN::Shell->local_bundles;
3961 @return = cplx('CPAN::Bundle',$word);
3962 } elsif ($line =~ /^d\s/) {
3963 @return = cplx('CPAN::Distribution',$word);
3964 } elsif ($line =~ m/^(
3965 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
3967 if ($word =~ /^Bundle::/) {
3968 CPAN::Shell->local_bundles;
3970 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3971 } elsif ($line =~ /^i\s/) {
3972 @return = cpl_any($word);
3973 } elsif ($line =~ /^reload\s/) {
3974 @return = cpl_reload($word,$line,$pos);
3975 } elsif ($line =~ /^o\s/) {
3976 @return = cpl_option($word,$line,$pos);
3977 } elsif ($line =~ m/^\S+\s/ ) {
3978 # fallback for future commands and what we have forgotten above
3979 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3986 #-> sub CPAN::Complete::cplx ;
3988 my($class, $word) = @_;
3989 # I believed for many years that this was sorted, today I
3990 # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
3991 # make it sorted again. Maybe sort was dropped when GNU-readline
3992 # support came in? The RCS file is difficult to read on that:-(
3993 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
3996 #-> sub CPAN::Complete::cpl_any ;
4000 cplx('CPAN::Author',$word),
4001 cplx('CPAN::Bundle',$word),
4002 cplx('CPAN::Distribution',$word),
4003 cplx('CPAN::Module',$word),
4007 #-> sub CPAN::Complete::cpl_reload ;
4009 my($word,$line,$pos) = @_;
4011 my(@words) = split " ", $line;
4012 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4013 my(@ok) = qw(cpan index);
4014 return @ok if @words == 1;
4015 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
4018 #-> sub CPAN::Complete::cpl_option ;
4020 my($word,$line,$pos) = @_;
4022 my(@words) = split " ", $line;
4023 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4024 my(@ok) = qw(conf debug);
4025 return @ok if @words == 1;
4026 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
4028 } elsif ($words[1] eq 'index') {
4030 } elsif ($words[1] eq 'conf') {
4031 return CPAN::HandleConfig::cpl(@_);
4032 } elsif ($words[1] eq 'debug') {
4033 return sort grep /^\Q$word\E/i,
4034 sort keys %CPAN::DEBUG, 'all';
4038 package CPAN::Index;
4041 #-> sub CPAN::Index::force_reload ;
4044 $CPAN::Index::LAST_TIME = 0;
4048 #-> sub CPAN::Index::reload ;
4050 my($self,$force) = @_;
4053 # XXX check if a newer one is available. (We currently read it
4054 # from time to time)
4055 for ($CPAN::Config->{index_expire}) {
4056 $_ = 0.001 unless $_ && $_ > 0.001;
4058 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
4059 # debug here when CPAN doesn't seem to read the Metadata
4061 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
4063 unless ($CPAN::META->{PROTOCOL}) {
4064 $self->read_metadata_cache;
4065 $CPAN::META->{PROTOCOL} ||= "1.0";
4067 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
4068 # warn "Setting last_time to 0";
4069 $LAST_TIME = 0; # No warning necessary
4071 if ($LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
4074 # CPAN->debug("LAST_TIME[$LAST_TIME]index_expire[$CPAN::Config->{index_expire}]time[$time]");
4076 # IFF we are developing, it helps to wipe out the memory
4077 # between reloads, otherwise it is not what a user expects.
4078 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
4079 $CPAN::META = CPAN->new;
4082 local $LAST_TIME = $time;
4083 local $CPAN::META->{PROTOCOL} = PROTOCOL;
4085 my $needshort = $^O eq "dos";
4087 $self->rd_authindex($self
4089 "authors/01mailrc.txt.gz",
4091 File::Spec->catfile('authors', '01mailrc.gz') :
4092 File::Spec->catfile('authors', '01mailrc.txt.gz'),
4095 $debug = "timing reading 01[".($t2 - $time)."]";
4097 return if $CPAN::Signal; # this is sometimes lengthy
4098 $self->rd_modpacks($self
4100 "modules/02packages.details.txt.gz",
4102 File::Spec->catfile('modules', '02packag.gz') :
4103 File::Spec->catfile('modules', '02packages.details.txt.gz'),
4106 $debug .= "02[".($t2 - $time)."]";
4108 return if $CPAN::Signal; # this is sometimes lengthy
4109 $self->rd_modlist($self
4111 "modules/03modlist.data.gz",
4113 File::Spec->catfile('modules', '03mlist.gz') :
4114 File::Spec->catfile('modules', '03modlist.data.gz'),
4116 $self->write_metadata_cache;
4118 $debug .= "03[".($t2 - $time)."]";
4120 CPAN->debug($debug) if $CPAN::DEBUG;
4122 if ($CPAN::Config->{build_dir_reuse}) {
4123 $self->reanimate_build_dir;
4126 $CPAN::META->{PROTOCOL} = PROTOCOL;
4129 #-> sub CPAN::Index::reanimate_build_dir ;
4130 sub reanimate_build_dir {
4132 unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module}||"YAML")) {
4135 return if $HAVE_REANIMATED++;
4136 my $d = $CPAN::Config->{build_dir};
4137 my $dh = DirHandle->new;
4138 opendir $dh, $d or return; # does not exist
4143 $CPAN::Frontend->myprint("Going to read $CPAN::Config->{build_dir}/\n");
4144 my @candidates = grep {/\.yml$/} readdir $dh;
4145 DISTRO: for $dirent (@candidates) {
4146 my $c = CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))->[0];
4147 if ($c && CPAN->_perl_fingerprint($c->{perl})) {
4148 my $key = $c->{distribution}{ID};
4149 for my $k (keys %{$c->{distribution}}) {
4150 if ($c->{distribution}{$k}
4151 && ref $c->{distribution}{$k}
4152 && UNIVERSAL::isa($c->{distribution}{$k},"CPAN::Distrostatus")) {
4153 # the correct algorithm would be a
4154 # two-pass and we would subtract the
4155 # maximum of all old commands minus 2
4156 $c->{distribution}{$k}{COMMANDID} -= scalar @candidates - 2 ;
4160 #we tried to restore only if element already
4161 #exists; but then we do not work with metadata
4163 $CPAN::META->{readwrite}{'CPAN::Distribution'}{$key} = $c->{distribution};
4167 while (($painted/76) < ($i/@candidates)) {
4168 $CPAN::Frontend->myprint(".");
4172 $CPAN::Frontend->myprint(sprintf(
4173 "DONE\nFound %s old builds, restored the state of %s\n",
4174 @candidates ? sprintf("%d",scalar @candidates) : "no",
4175 $restored || "none",
4180 #-> sub CPAN::Index::reload_x ;
4182 my($cl,$wanted,$localname,$force) = @_;
4183 $force |= 2; # means we're dealing with an index here
4184 CPAN::HandleConfig->load; # we should guarantee loading wherever
4185 # we rely on Config XXX
4186 $localname ||= $wanted;
4187 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
4191 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
4194 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
4195 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
4196 qq{day$s. I\'ll use that.});
4199 $force |= 1; # means we're quite serious about it.
4201 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
4204 #-> sub CPAN::Index::rd_authindex ;
4206 my($cl, $index_target) = @_;
4208 return unless defined $index_target;
4209 $CPAN::Frontend->myprint("Going to read $index_target\n");
4211 tie *FH, 'CPAN::Tarzip', $index_target;
4214 push @lines, split /\012/ while <FH>;
4216 my $modulus = int($#lines/75) || 1;
4217 CPAN->debug(sprintf "modulus[%d]lines[%s]", $modulus, scalar @lines) if $CPAN::DEBUG;
4219 my($userid,$fullname,$email) =
4220 m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/;
4221 $fullname ||= $email;
4222 if ($userid && $fullname && $email){
4223 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
4224 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
4226 CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG;
4228 $CPAN::Frontend->myprint(".") unless $i++ % $modulus;
4229 return if $CPAN::Signal;
4231 $CPAN::Frontend->myprint("DONE\n");
4235 my($self,$dist) = @_;
4236 $dist = $self->{'id'} unless defined $dist;
4237 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
4241 #-> sub CPAN::Index::rd_modpacks ;
4243 my($self, $index_target) = @_;
4244 return unless defined $index_target;
4245 $CPAN::Frontend->myprint("Going to read $index_target\n");
4246 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
4248 CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
4251 while (my $bytes = $fh->READ(\$chunk,8192)) {
4254 my @lines = split /\012/, $slurp;
4255 CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG;
4258 my($line_count,$last_updated);
4260 my $shift = shift(@lines);
4261 last if $shift =~ /^\s*$/;
4262 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
4263 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
4265 CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
4266 if (not defined $line_count) {
4268 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
4269 Please check the validity of the index file by comparing it to more
4270 than one CPAN mirror. I'll continue but problems seem likely to
4274 $CPAN::Frontend->mysleep(5);
4275 } elsif ($line_count != scalar @lines) {
4277 $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
4278 contains a Line-Count header of %d but I see %d lines there. Please
4279 check the validity of the index file by comparing it to more than one
4280 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
4281 $index_target, $line_count, scalar(@lines));
4284 if (not defined $last_updated) {
4286 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
4287 Please check the validity of the index file by comparing it to more
4288 than one CPAN mirror. I'll continue but problems seem likely to
4292 $CPAN::Frontend->mysleep(5);
4296 ->myprint(sprintf qq{ Database was generated on %s\n},
4298 $DATE_OF_02 = $last_updated;
4301 if ($CPAN::META->has_inst('HTTP::Date')) {
4303 $age -= HTTP::Date::str2time($last_updated);
4305 $CPAN::Frontend->mywarn(" HTTP::Date not available\n");
4306 require Time::Local;
4307 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
4308 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
4309 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
4316 qq{Warning: This index file is %d days old.
4317 Please check the host you chose as your CPAN mirror for staleness.
4318 I'll continue but problems seem likely to happen.\a\n},
4321 } elsif ($age < -1) {
4325 qq{Warning: Your system date is %d days behind this index file!
4327 Timestamp index file: %s
4328 Please fix your system time, problems with the make command expected.\n},
4338 # A necessity since we have metadata_cache: delete what isn't
4340 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
4341 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
4344 my $modulus = int($#lines/75) || 1;
4346 # before 1.56 we split into 3 and discarded the rest. From
4347 # 1.57 we assign remaining text to $comment thus allowing to
4348 # influence isa_perl
4349 my($mod,$version,$dist,$comment) = split " ", $_, 4;
4350 my($bundle,$id,$userid);
4352 if ($mod eq 'CPAN' &&
4354 CPAN::Queue->exists('Bundle::CPAN') ||
4355 CPAN::Queue->exists('CPAN')
4359 if ($version > $CPAN::VERSION){
4360 $CPAN::Frontend->mywarn(qq{
4361 New CPAN.pm version (v$version) available.
4362 [Currently running version is v$CPAN::VERSION]
4363 You might want to try
4366 to both upgrade CPAN.pm and run the new version without leaving
4367 the current session.
4370 $CPAN::Frontend->mysleep(2);
4371 $CPAN::Frontend->myprint(qq{\n});
4373 last if $CPAN::Signal;
4374 } elsif ($mod =~ /^Bundle::(.*)/) {
4379 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
4380 # Let's make it a module too, because bundles have so much
4381 # in common with modules.
4383 # Changed in 1.57_63: seems like memory bloat now without
4384 # any value, so commented out
4386 # $CPAN::META->instance('CPAN::Module',$mod);
4390 # instantiate a module object
4391 $id = $CPAN::META->instance('CPAN::Module',$mod);
4395 # Although CPAN prohibits same name with different version the
4396 # indexer may have changed the version for the same distro
4397 # since the last time ("Force Reindexing" feature)
4398 if ($id->cpan_file ne $dist
4400 $id->cpan_version ne $version
4402 $userid = $id->userid || $self->userid($dist);
4404 'CPAN_USERID' => $userid,
4405 'CPAN_VERSION' => $version,
4406 'CPAN_FILE' => $dist,
4410 # instantiate a distribution object
4411 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
4412 # we do not need CONTAINSMODS unless we do something with
4413 # this dist, so we better produce it on demand.
4415 ## my $obj = $CPAN::META->instance(
4416 ## 'CPAN::Distribution' => $dist
4418 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
4420 $CPAN::META->instance(
4421 'CPAN::Distribution' => $dist
4423 'CPAN_USERID' => $userid,
4424 'CPAN_COMMENT' => $comment,
4428 for my $name ($mod,$dist) {
4429 # $self->debug("exists name[$name]") if $CPAN::DEBUG;
4430 $exists{$name} = undef;
4433 $CPAN::Frontend->myprint(".") unless $i++ % $modulus;
4434 return if $CPAN::Signal;
4436 $CPAN::Frontend->myprint("DONE\n");
4438 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
4439 for my $o ($CPAN::META->all_objects($class)) {
4440 next if exists $exists{$o->{ID}};
4441 $CPAN::META->delete($class,$o->{ID});
4442 # CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
4449 #-> sub CPAN::Index::rd_modlist ;
4451 my($cl,$index_target) = @_;
4452 return unless defined $index_target;
4453 $CPAN::Frontend->myprint("Going to read $index_target\n");
4454 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
4458 while (my $bytes = $fh->READ(\$chunk,8192)) {
4461 my @eval2 = split /\012/, $slurp;
4464 my $shift = shift(@eval2);
4465 if ($shift =~ /^Date:\s+(.*)/){
4466 if ($DATE_OF_03 eq $1){
4467 $CPAN::Frontend->myprint("Unchanged.\n");
4472 last if $shift =~ /^\s*$/;
4474 push @eval2, q{CPAN::Modulelist->data;};
4476 my($comp) = Safe->new("CPAN::Safe1");
4477 my($eval2) = join("\n", @eval2);
4478 CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
4479 my $ret = $comp->reval($eval2);
4480 Carp::confess($@) if $@;
4481 return if $CPAN::Signal;
4483 my $until = keys(%$ret) - 1;
4484 my $modulus = int($until/75) || 1;
4485 CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
4487 my $obj = $CPAN::META->instance("CPAN::Module",$_);
4488 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
4489 $obj->set(%{$ret->{$_}});
4490 $CPAN::Frontend->myprint(".") unless $i++ % $modulus;
4491 return if $CPAN::Signal;
4493 $CPAN::Frontend->myprint("DONE\n");
4496 #-> sub CPAN::Index::write_metadata_cache ;
4497 sub write_metadata_cache {
4499 return unless $CPAN::Config->{'cache_metadata'};
4500 return unless $CPAN::META->has_usable("Storable");
4502 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
4503 CPAN::Distribution)) {
4504 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
4506 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4507 $cache->{last_time} = $LAST_TIME;
4508 $cache->{DATE_OF_02} = $DATE_OF_02;
4509 $cache->{PROTOCOL} = PROTOCOL;
4510 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
4511 eval { Storable::nstore($cache, $metadata_file) };
4512 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4515 #-> sub CPAN::Index::read_metadata_cache ;
4516 sub read_metadata_cache {
4518 return unless $CPAN::Config->{'cache_metadata'};
4519 return unless $CPAN::META->has_usable("Storable");
4520 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4521 return unless -r $metadata_file and -f $metadata_file;
4522 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
4524 eval { $cache = Storable::retrieve($metadata_file) };
4525 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4526 if (!$cache || !UNIVERSAL::isa($cache, 'HASH')){
4530 if (exists $cache->{PROTOCOL}) {
4531 if (PROTOCOL > $cache->{PROTOCOL}) {
4532 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
4533 "with protocol v%s, requiring v%s\n",
4540 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
4541 "with protocol v1.0\n");
4546 while(my($class,$v) = each %$cache) {
4547 next unless $class =~ /^CPAN::/;
4548 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
4549 while (my($id,$ro) = each %$v) {
4550 $CPAN::META->{readwrite}{$class}{$id} ||=
4551 $class->new(ID=>$id, RO=>$ro);
4556 unless ($clcnt) { # sanity check
4557 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
4560 if ($idcnt < 1000) {
4561 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
4562 "in $metadata_file\n");
4565 $CPAN::META->{PROTOCOL} ||=
4566 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
4567 # does initialize to some protocol
4568 $LAST_TIME = $cache->{last_time};
4569 $DATE_OF_02 = $cache->{DATE_OF_02};
4570 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
4571 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
4575 package CPAN::InfoObj;
4580 exists $self->{RO} and return $self->{RO};
4583 #-> sub CPAN::InfoObj::cpan_userid
4588 return $ro->{CPAN_USERID} || "N/A";
4590 $self->debug("ID[$self->{ID}]");
4591 # N/A for bundles found locally
4596 sub id { shift->{ID}; }
4598 #-> sub CPAN::InfoObj::new ;
4600 my $this = bless {}, shift;
4605 # The set method may only be used by code that reads index data or
4606 # otherwise "objective" data from the outside world. All session
4607 # related material may do anything else with instance variables but
4608 # must not touch the hash under the RO attribute. The reason is that
4609 # the RO hash gets written to Metadata file and is thus persistent.
4611 #-> sub CPAN::InfoObj::safe_chdir ;
4613 my($self,$todir) = @_;
4614 # we die if we cannot chdir and we are debuggable
4615 Carp::confess("safe_chdir called without todir argument")
4616 unless defined $todir and length $todir;
4618 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4622 unless (-x $todir) {
4623 unless (chmod 0755, $todir) {
4624 my $cwd = CPAN::anycwd();
4625 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
4626 "permission to change the permission; cannot ".
4627 "chdir to '$todir'\n");
4628 $CPAN::Frontend->mysleep(5);
4629 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4630 qq{to todir[$todir]: $!});
4634 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
4637 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4640 my $cwd = CPAN::anycwd();
4641 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4642 qq{to todir[$todir] (a chmod has been issued): $!});
4647 #-> sub CPAN::InfoObj::set ;
4649 my($self,%att) = @_;
4650 my $class = ref $self;
4652 # This must be ||=, not ||, because only if we write an empty
4653 # reference, only then the set method will write into the readonly
4654 # area. But for Distributions that spring into existence, maybe
4655 # because of a typo, we do not like it that they are written into
4656 # the readonly area and made permanent (at least for a while) and
4657 # that is why we do not "allow" other places to call ->set.
4658 unless ($self->id) {
4659 CPAN->debug("Bug? Empty ID, rejecting");
4662 my $ro = $self->{RO} =
4663 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
4665 while (my($k,$v) = each %att) {
4670 #-> sub CPAN::InfoObj::as_glimpse ;
4674 my $class = ref($self);
4675 $class =~ s/^CPAN:://;
4676 my $id = $self->can("pretty_id") ? $self->pretty_id : $self->{ID};
4677 push @m, sprintf "%-15s %s\n", $class, $id;
4681 #-> sub CPAN::InfoObj::as_string ;
4685 my $class = ref($self);
4686 $class =~ s/^CPAN:://;
4687 push @m, $class, " id = $self->{ID}\n";
4689 unless ($ro = $self->ro) {
4690 if (substr($self->{ID},-1,1) eq ".") { # directory
4693 $CPAN::Frontend->mydie("Unknown object $self->{ID}");
4696 for (sort keys %$ro) {
4697 # next if m/^(ID|RO)$/;
4699 if ($_ eq "CPAN_USERID") {
4701 $extra .= $self->fullname;
4702 my $email; # old perls!
4703 if ($email = $CPAN::META->instance("CPAN::Author",
4706 $extra .= " <$email>";
4708 $extra .= " <no email>";
4711 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
4712 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
4715 next unless defined $ro->{$_};
4716 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
4718 KEY: for (sort keys %$self) {
4719 next if m/^(ID|RO)$/;
4720 unless (defined $self->{$_}) {
4724 if (ref($self->{$_}) eq "ARRAY") {
4725 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
4726 } elsif (ref($self->{$_}) eq "HASH") {
4728 if (/^CONTAINSMODS$/) {
4729 $value = join(" ",sort keys %{$self->{$_}});
4730 } elsif (/^prereq_pm$/) {
4732 my $v = $self->{$_};
4733 for my $x (sort keys %$v) {
4735 for my $y (sort keys %{$v->{$x}}) {
4736 push @svalue, "$y=>$v->{$x}{$y}";
4738 push @value, "$x\:" . join ",", @svalue if @svalue;
4740 $value = join ";", @value;
4742 $value = $self->{$_};
4750 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
4756 #-> sub CPAN::InfoObj::fullname ;
4759 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
4762 #-> sub CPAN::InfoObj::dump ;
4764 my($self, $what) = @_;
4765 unless ($CPAN::META->has_inst("Data::Dumper")) {
4766 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
4768 local $Data::Dumper::Sortkeys;
4769 $Data::Dumper::Sortkeys = 1;
4770 my $out = Data::Dumper::Dumper($what ? eval $what : $self);
4771 if (length $out > 100000) {
4772 my $fh_pager = FileHandle->new;
4773 local($SIG{PIPE}) = "IGNORE";
4774 my $pager = $CPAN::Config->{'pager'} || "cat";
4775 $fh_pager->open("|$pager")
4776 or die "Could not open pager $pager\: $!";
4777 $fh_pager->print($out);
4780 $CPAN::Frontend->myprint($out);
4784 package CPAN::Author;
4787 #-> sub CPAN::Author::force
4793 #-> sub CPAN::Author::force
4796 delete $self->{force};
4799 #-> sub CPAN::Author::id
4802 my $id = $self->{ID};
4803 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
4807 #-> sub CPAN::Author::as_glimpse ;
4811 my $class = ref($self);
4812 $class =~ s/^CPAN:://;
4813 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
4821 #-> sub CPAN::Author::fullname ;
4823 shift->ro->{FULLNAME};
4827 #-> sub CPAN::Author::email ;
4828 sub email { shift->ro->{EMAIL}; }
4830 #-> sub CPAN::Author::ls ;
4833 my $glob = shift || "";
4834 my $silent = shift || 0;
4837 # adapted from CPAN::Distribution::verifyCHECKSUM ;
4838 my(@csf); # chksumfile
4839 @csf = $self->id =~ /(.)(.)(.*)/;
4840 $csf[1] = join "", @csf[0,1];
4841 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
4843 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
4844 unless (grep {$_->[2] eq $csf[1]} @dl) {
4845 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
4848 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
4849 unless (grep {$_->[2] eq $csf[2]} @dl) {
4850 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
4853 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
4855 if ($CPAN::META->has_inst("Text::Glob")) {
4856 my $rglob = Text::Glob::glob_to_regex($glob);
4857 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
4859 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
4862 $CPAN::Frontend->myprint(join "", map {
4863 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
4864 } sort { $a->[2] cmp $b->[2] } @dl);
4868 # returns an array of arrays, the latter contain (size,mtime,filename)
4869 #-> sub CPAN::Author::dir_listing ;
4872 my $chksumfile = shift;
4873 my $recursive = shift;
4874 my $may_ftp = shift;
4877 File::Spec->catfile($CPAN::Config->{keep_source_where},
4878 "authors", "id", @$chksumfile);
4882 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
4883 # hazard. (Without GPG installed they are not that much better,
4885 $fh = FileHandle->new;
4886 if (open($fh, $lc_want)) {
4887 my $line = <$fh>; close $fh;
4888 unlink($lc_want) unless $line =~ /PGP/;
4892 # connect "force" argument with "index_expire".
4893 my $force = $self->{force};
4894 if (my @stat = stat $lc_want) {
4895 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
4899 $lc_file = CPAN::FTP->localize(
4900 "authors/id/@$chksumfile",
4905 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
4906 $chksumfile->[-1] .= ".gz";
4907 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
4910 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
4911 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
4917 $lc_file = $lc_want;
4918 # we *could* second-guess and if the user has a file: URL,
4919 # then we could look there. But on the other hand, if they do
4920 # have a file: URL, wy did they choose to set
4921 # $CPAN::Config->{show_upload_date} to false?
4924 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
4925 $fh = FileHandle->new;
4927 if (open $fh, $lc_file){
4930 $eval =~ s/\015?\012/\n/g;
4932 my($comp) = Safe->new();
4933 $cksum = $comp->reval($eval);
4935 rename $lc_file, "$lc_file.bad";
4936 Carp::confess($@) if $@;
4938 } elsif ($may_ftp) {
4939 Carp::carp "Could not open '$lc_file' for reading.";
4941 # Maybe should warn: "You may want to set show_upload_date to a true value"
4945 for $f (sort keys %$cksum) {
4946 if (exists $cksum->{$f}{isdir}) {
4948 my(@dir) = @$chksumfile;
4950 push @dir, $f, "CHECKSUMS";
4952 [$_->[0], $_->[1], "$f/$_->[2]"]
4953 } $self->dir_listing(\@dir,1,$may_ftp);
4955 push @result, [ 0, "-", $f ];
4959 ($cksum->{$f}{"size"}||0),
4960 $cksum->{$f}{"mtime"}||"---",
4968 package CPAN::Distribution;
4974 my $ro = $self->ro or return;
4978 # CPAN::Distribution::undelay
4981 delete $self->{later};
4984 # add the A/AN/ stuff
4985 # CPAN::Distribution::normalize
4988 $s = $self->id unless defined $s;
4989 if (substr($s,-1,1) eq ".") {
4990 # using a global because we are sometimes called as static method
4991 if (!$CPAN::META->{LOCK}
4992 && !$CPAN::Have_warned->{"$s is unlocked"}++
4994 $CPAN::Frontend->mywarn("You are visiting the local directory
4996 without lock, take care that concurrent processes do not do likewise.\n");
4997 $CPAN::Frontend->mysleep(1);
5000 $s = "$CPAN::iCwd/.";
5001 } elsif (File::Spec->file_name_is_absolute($s)) {
5002 } elsif (File::Spec->can("rel2abs")) {
5003 $s = File::Spec->rel2abs($s);
5005 $CPAN::Frontend->mydie("Your File::Spec is too old, please upgrade File::Spec");
5007 CPAN->debug("s[$s]") if $CPAN::DEBUG;
5008 unless ($CPAN::META->exists("CPAN::Distribution", $s)) {
5009 for ($CPAN::META->instance("CPAN::Distribution", $s)) {
5010 $_->{build_dir} = $s;
5011 $_->{archived} = "local_directory";
5012 $_->{unwrapped} = CPAN::Distrostatus->new("YES -- local_directory");
5018 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
5020 return $s if $s =~ m:^N/A|^Contact Author: ;
5021 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
5022 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
5023 CPAN->debug("s[$s]") if $CPAN::DEBUG;
5028 #-> sub CPAN::Distribution::author ;
5032 if (substr($self->id,-1,1) eq ".") {
5033 $authorid = "LOCAL";
5035 ($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
5037 CPAN::Shell->expand("Author",$authorid);
5040 # tries to get the yaml from CPAN instead of the distro itself:
5041 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
5044 my $meta = $self->pretty_id;
5045 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
5046 my(@ls) = CPAN::Shell->globls($meta);
5047 my $norm = $self->normalize($meta);
5051 File::Spec->catfile(
5052 $CPAN::Config->{keep_source_where},
5057 $self->debug("Doing localize") if $CPAN::DEBUG;
5058 unless ($local_file =
5059 CPAN::FTP->localize("authors/id/$norm",
5061 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
5063 my $yaml = CPAN->_yaml_loadfile($local_file)->[0];
5066 #-> sub CPAN::Distribution::cpan_userid
5069 if ($self->{ID} =~ m{[A-Z]/[A-Z\-]{2}/([A-Z\-]+)/}) {
5072 return $self->SUPER::cpan_userid;
5075 #-> sub CPAN::Distribution::pretty_id
5079 return $id unless $id =~ m|^./../|;
5083 # mark as dirty/clean
5084 #-> sub CPAN::Distribution::color_cmd_tmps ;
5085 sub color_cmd_tmps {
5087 my($depth) = shift || 0;
5088 my($color) = shift || 0;
5089 my($ancestors) = shift || [];
5090 # a distribution needs to recurse into its prereq_pms
5092 return if exists $self->{incommandcolor}
5093 && $self->{incommandcolor}==$color;
5095 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
5097 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
5098 my $prereq_pm = $self->prereq_pm;
5099 if (defined $prereq_pm) {
5100 PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
5101 keys %{$prereq_pm->{build_requires}||{}}) {
5102 next PREREQ if $pre eq "perl";
5104 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
5105 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
5106 $CPAN::Frontend->mysleep(2);
5109 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
5113 delete $self->{sponsored_mods};
5114 delete $self->{badtestcnt};
5116 $self->{incommandcolor} = $color;
5119 #-> sub CPAN::Distribution::as_string ;
5122 $self->containsmods;
5124 $self->SUPER::as_string(@_);
5127 #-> sub CPAN::Distribution::containsmods ;
5130 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
5131 my $dist_id = $self->{ID};
5132 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
5133 my $mod_file = $mod->cpan_file or next;
5134 my $mod_id = $mod->{ID} or next;
5135 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
5137 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
5139 keys %{$self->{CONTAINSMODS}};
5142 #-> sub CPAN::Distribution::upload_date ;
5145 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
5146 my(@local_wanted) = split(/\//,$self->id);
5147 my $filename = pop @local_wanted;
5148 push @local_wanted, "CHECKSUMS";
5149 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
5150 return unless $author;
5151 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
5153 my($dirent) = grep { $_->[2] eq $filename } @dl;
5154 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
5155 return unless $dirent->[1];
5156 return $self->{UPLOAD_DATE} = $dirent->[1];
5159 #-> sub CPAN::Distribution::uptodate ;
5163 foreach $c ($self->containsmods) {
5164 my $obj = CPAN::Shell->expandany($c);
5165 unless ($obj->uptodate){
5166 my $id = $self->pretty_id;
5167 $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG;
5174 #-> sub CPAN::Distribution::called_for ;
5177 $self->{CALLED_FOR} = $id if defined $id;
5178 return $self->{CALLED_FOR};
5181 #-> sub CPAN::Distribution::get ;
5184 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
5186 : ($ENV{PERLLIB} || "");
5188 $CPAN::META->set_perl5lib;
5189 local $ENV{MAKEFLAGS}; # protect us from outer make calls
5193 if ($self->prefs->{disabled}) {
5195 "disabled via prefs file '%s' doc %d",
5196 $self->{prefs_file},
5197 $self->{prefs_file_doc},
5200 exists $self->{build_dir} and push @e,
5201 "Is already unwrapped into directory $self->{build_dir}";
5203 exists $self->{unwrapped} and (
5204 $self->{unwrapped}->can("failed") ?
5205 $self->{unwrapped}->failed :
5206 $self->{unwrapped} =~ /^NO/
5208 and push @e, "Unwrapping had some problem, won't try again without force";
5210 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
5212 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
5215 # Get the file on local disk
5220 File::Spec->catfile(
5221 $CPAN::Config->{keep_source_where},
5224 split(/\//,$self->id)
5227 $self->debug("Doing localize") if $CPAN::DEBUG;
5228 unless ($local_file =
5229 CPAN::FTP->localize("authors/id/$self->{ID}",
5232 if ($CPAN::Index::DATE_OF_02) {
5233 $note = "Note: Current database in memory was generated ".
5234 "on $CPAN::Index::DATE_OF_02\n";
5236 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
5239 $self->debug("local_wanted[$local_wanted]local_file[$local_file]") if $CPAN::DEBUG;
5240 $self->{localfile} = $local_file;
5241 return if $CPAN::Signal;
5246 if ($CPAN::META->has_inst("Digest::SHA")) {
5247 $self->debug("Digest::SHA is installed, verifying");
5248 $self->verifyCHECKSUM;
5250 $self->debug("Digest::SHA is NOT installed");
5252 return if $CPAN::Signal;
5255 # Create a clean room and go there
5257 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
5258 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
5259 $self->safe_chdir($builddir);
5260 $self->debug("Removing tmp-$$") if $CPAN::DEBUG;
5261 File::Path::rmtree("tmp-$$");
5262 unless (mkdir "tmp-$$", 0755) {
5263 $CPAN::Frontend->unrecoverable_error(<<EOF);
5264 Couldn't mkdir '$builddir/tmp-$$': $!
5266 Cannot continue: Please find the reason why I cannot make the
5269 and fix the problem, then retry.
5274 $self->safe_chdir($sub_wd);
5277 $self->safe_chdir("tmp-$$");
5282 my $ct = CPAN::Tarzip->new($local_file);
5283 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
5284 $self->{was_uncompressed}++ unless $ct->gtest();
5285 $self->untar_me($ct);
5286 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
5287 $self->unzip_me($ct);
5289 $self->{was_uncompressed}++ unless $ct->gtest();
5290 $local_file = $self->handle_singlefile($local_file);
5292 # $self->{archived} = "NO";
5293 # $self->safe_chdir($sub_wd);
5297 # we are still in the tmp directory!
5298 # Let's check if the package has its own directory.
5299 my $dh = DirHandle->new(File::Spec->curdir)
5300 or Carp::croak("Couldn't opendir .: $!");
5301 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
5304 # XXX here we want in each branch File::Temp to protect all build_dir directories
5305 if (CPAN->has_inst("File::Temp")) {
5309 if (@readdir == 1 && -d $readdir[0]) {
5310 $tdir_base = $readdir[0];
5311 $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]);
5312 my $dh2 = DirHandle->new($from_dir)
5313 or Carp::croak("Couldn't opendir $from_dir: $!");
5314 @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC??
5316 my $userid = $self->cpan_userid;
5317 CPAN->debug("userid[$userid]");
5318 if (!$userid or $userid eq "N/A") {
5321 $tdir_base = $userid;
5322 $from_dir = File::Spec->curdir;
5323 @dirents = @readdir;
5325 $packagedir = File::Temp::tempdir(
5326 "$tdir_base-XXXXXX",
5331 for $f (@dirents) { # is already without "." and ".."
5332 my $from = File::Spec->catdir($from_dir,$f);
5333 my $to = File::Spec->catdir($packagedir,$f);
5334 File::Copy::move($from,$to) or Carp::confess("Couldn't move $from to $to: $!");
5336 } else { # older code below, still better than nothing when there is no File::Temp
5338 if (@readdir == 1 && -d $readdir[0]) {
5339 $distdir = $readdir[0];
5340 $packagedir = File::Spec->catdir($builddir,$distdir);
5341 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
5343 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
5345 File::Path::rmtree($packagedir);
5346 unless (File::Copy::move($distdir,$packagedir)) {
5347 $CPAN::Frontend->unrecoverable_error(<<EOF);
5348 Couldn't move '$distdir' to '$packagedir': $!
5350 Cannot continue: Please find the reason why I cannot move
5351 $builddir/tmp-$$/$distdir
5354 and fix the problem, then retry
5358 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
5365 my $userid = $self->cpan_userid;
5366 CPAN->debug("userid[$userid]");
5367 if (!$userid or $userid eq "N/A") {
5370 my $pragmatic_dir = $userid . '000';
5371 $pragmatic_dir =~ s/\W_//g;
5372 $pragmatic_dir++ while -d "../$pragmatic_dir";
5373 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
5374 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
5375 File::Path::mkpath($packagedir);
5377 for $f (@readdir) { # is already without "." and ".."
5378 my $to = File::Spec->catdir($packagedir,$f);
5379 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
5384 $self->safe_chdir($sub_wd);
5388 $self->{'build_dir'} = $packagedir;
5389 $self->safe_chdir($builddir);
5390 File::Path::rmtree("tmp-$$");
5392 $self->safe_chdir($packagedir);
5393 $self->_signature_business();
5394 $self->safe_chdir($builddir);
5395 return if $CPAN::Signal;
5398 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
5399 my($mpl_exists) = -f $mpl;
5400 unless ($mpl_exists) {
5401 # NFS has been reported to have racing problems after the
5402 # renaming of a directory in some environments.
5404 $CPAN::Frontend->mysleep(1);
5405 my $mpldh = DirHandle->new($packagedir)
5406 or Carp::croak("Couldn't opendir $packagedir: $!");
5407 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
5410 my $prefer_installer = "eumm"; # eumm|mb
5411 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
5412 if ($mpl_exists) { # they *can* choose
5413 $prefer_installer = CPAN::HandleConfig->prefs_lookup($self,
5414 q{prefer_installer});
5416 $prefer_installer = "mb";
5419 return unless $self->patch;
5420 if (lc($prefer_installer) eq "mb") {
5421 $self->{modulebuild} = 1;
5422 } elsif (! $mpl_exists) {
5423 $self->_edge_cases($mpl,$packagedir,$local_file);
5425 if ($self->{build_dir}
5427 $CPAN::Config->{build_dir_reuse}
5429 $self->store_persistent_state;
5435 #-> CPAN::Distribution::store_persistent_state
5436 sub store_persistent_state {
5438 my $file = sprintf "%s.yml", $self->{build_dir};
5439 CPAN->_yaml_dumpfile(
5443 perl => CPAN::_perl_fingerprint,
5444 distribution => $self,
5449 #-> CPAN::Distribution::patch
5451 my($self,$patch) = @_;
5452 my $norm = $self->normalize($patch);
5454 File::Spec->catfile(
5455 $CPAN::Config->{keep_source_where},
5460 $self->debug("Doing localize") if $CPAN::DEBUG;
5461 return CPAN::FTP->localize("authors/id/$norm",
5465 #-> CPAN::Distribution::patch
5468 if (my $patches = $self->prefs->{patches}) {
5469 return unless @$patches;
5470 $self->safe_chdir($self->{build_dir});
5471 CPAN->debug("patches[$patches]");
5472 my $patchbin = $CPAN::Config->{patch};
5473 unless ($patchbin && length $patchbin) {
5474 $CPAN::Frontend->mydie("No external patch command configured\n\n".
5475 "Please run 'o conf init /patch/'\n\n");
5477 unless (MM->maybe_command($patchbin)) {
5478 $CPAN::Frontend->mydie("No external patch command available\n\n".
5479 "Please run 'o conf init /patch/'\n\n");
5481 $patchbin = CPAN::HandleConfig->safe_quote($patchbin);
5482 local $ENV{PATCH_GET} = 0; # shall replace -g0 which is not
5483 # supported everywhere (and then,
5484 # not ever necessary there)
5485 my $stdpatchargs = "-N --fuzz=3";
5486 my $countedpatches = @$patches == 1 ? "1 patch" : (scalar @$patches . " patches");
5487 $CPAN::Frontend->myprint("Going to apply $countedpatches:\n");
5488 for my $patch (@$patches) {
5489 unless (-f $patch) {
5490 if (my $trydl = $self->try_download($patch)) {
5493 my $fail = "Could not find patch '$patch'";
5494 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5495 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5496 delete $self->{build_dir};
5500 $CPAN::Frontend->myprint(" $patch\n");
5501 my $readfh = CPAN::Tarzip->TIEHANDLE($patch);
5502 my $thispatchargs = join " ", $stdpatchargs, $self->_patch_p_parameter($readfh);
5503 $readfh = CPAN::Tarzip->TIEHANDLE($patch);
5504 my $writefh = FileHandle->new;
5505 unless (open $writefh, "|$patchbin $thispatchargs") {
5506 my $fail = "Could not fork '$patchbin $thispatchargs'";
5507 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5508 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5509 delete $self->{build_dir};
5512 while (my $x = $readfh->READLINE) {
5515 unless (close $writefh) {
5516 my $fail = "Could not apply patch '$patch'";
5517 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5518 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5519 delete $self->{build_dir};
5528 sub _patch_p_parameter {
5530 my($cnt_files,$cnt_p0files);
5532 while ($_ = $fh->READLINE) {
5533 next unless /^[\*\+]{3}\s(\S+)/;
5536 $cnt_p0files++ if -f $file;
5538 return $cnt_files==$cnt_p0files ? "-p0" : "-p1";
5541 #-> sub CPAN::Distribution::_edge_cases
5542 # with "configure" or "Makefile" or single file scripts
5544 my($self,$mpl,$packagedir,$local_file) = @_;
5545 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
5549 my($configure) = File::Spec->catfile($packagedir,"Configure");
5550 if (-f $configure) {
5551 # do we have anything to do?
5552 $self->{configure} = $configure;
5553 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
5554 $CPAN::Frontend->mywarn(qq{
5555 Package comes with a Makefile and without a Makefile.PL.
5556 We\'ll try to build it with that Makefile then.
5558 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
5559 $CPAN::Frontend->mysleep(2);
5561 my $cf = $self->called_for || "unknown";
5566 $cf =~ s|[/\\:]||g; # risk of filesystem damage
5567 $cf = "unknown" unless length($cf);
5568 $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
5569 (The test -f "$mpl" returned false.)
5570 Writing one on our own (setting NAME to $cf)\a\n});
5571 $self->{had_no_makefile_pl}++;
5572 $CPAN::Frontend->mysleep(3);
5574 # Writing our own Makefile.PL
5577 if ($self->{archived} eq "maybe_pl") {
5578 my $fh = FileHandle->new;
5579 my $script_file = File::Spec->catfile($packagedir,$local_file);
5580 $fh->open($script_file)
5581 or Carp::croak("Could not open $script_file: $!");
5583 # name parsen und prereq
5584 my($state) = "poddir";
5585 my($name, $prereq) = ("", "");
5587 if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
5590 } elsif ($1 eq 'PREREQUISITES') {
5593 } elsif ($state =~ m{^(name|prereq)$}) {
5598 } elsif ($state eq "name") {
5603 } elsif ($state eq "prereq") {
5606 } elsif (/^=cut\b/) {
5613 s{.*<}{}; # strip X<...>
5617 $prereq = join " ", split /\s+/, $prereq;
5618 my($PREREQ_PM) = join("\n", map {
5619 s{.*<}{}; # strip X<...>
5621 if (/[\s\'\"]/) { # prose?
5623 s/[^\w:]$//; # period?
5624 " "x28 . "'$_' => 0,";
5626 } split /\s*,\s*/, $prereq);
5629 EXE_FILES => ['$name'],
5635 my $to_file = File::Spec->catfile($packagedir, $name);
5636 rename $script_file, $to_file
5637 or die "Can't rename $script_file to $to_file: $!";
5641 my $fh = FileHandle->new;
5643 or Carp::croak("Could not open >$mpl: $!");
5645 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
5646 # because there was no Makefile.PL supplied.
5647 # Autogenerated on: }.scalar localtime().qq{
5649 use ExtUtils::MakeMaker;
5651 NAME => q[$cf],$script
5658 #-> CPAN::Distribution::_signature_business
5659 sub _signature_business {
5661 if ($CPAN::Config->{check_sigs}) {
5662 if ($CPAN::META->has_inst("Module::Signature")) {
5663 if (-f "SIGNATURE") {
5664 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
5665 my $rv = Module::Signature::verify();
5666 if ($rv != Module::Signature::SIGNATURE_OK() and
5667 $rv != Module::Signature::SIGNATURE_MISSING()) {
5668 $CPAN::Frontend->mywarn(
5669 qq{\nSignature invalid for }.
5670 qq{distribution file. }.
5671 qq{Please investigate.\n\n}
5675 sprintf(qq{I'd recommend removing %s. Its signature
5676 is invalid. Maybe you have configured your 'urllist' with
5677 a bad URL. Please check this array with 'o conf urllist', and
5678 retry. For more information, try opening a subshell with
5686 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
5687 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
5688 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
5690 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
5691 $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
5694 $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n});
5697 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
5702 #-> CPAN::Distribution::untar_me ;
5705 $self->{archived} = "tar";
5707 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
5709 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- untar failed");
5713 # CPAN::Distribution::unzip_me ;
5716 $self->{archived} = "zip";
5718 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
5720 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- unzip failed");
5725 sub handle_singlefile {
5726 my($self,$local_file) = @_;
5728 if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ){
5729 $self->{archived} = "pm";
5731 $self->{archived} = "maybe_pl";
5734 my $to = File::Basename::basename($local_file);
5735 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
5736 if (CPAN::Tarzip->new($local_file)->gunzip($to)) {
5737 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
5739 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- uncompressing failed");
5742 File::Copy::cp($local_file,".");
5743 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- copying failed");
5748 #-> sub CPAN::Distribution::new ;
5750 my($class,%att) = @_;
5752 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
5754 my $this = { %att };
5755 return bless $this, $class;
5758 #-> sub CPAN::Distribution::look ;
5762 if ($^O eq 'MacOS') {
5763 $self->Mac::BuildTools::look;
5767 if ( $CPAN::Config->{'shell'} ) {
5768 $CPAN::Frontend->myprint(qq{
5769 Trying to open a subshell in the build directory...
5772 $CPAN::Frontend->myprint(qq{
5773 Your configuration does not define a value for subshells.
5774 Please define it with "o conf shell <your shell>"
5778 my $dist = $self->id;
5780 unless ($dir = $self->dir) {
5783 unless ($dir ||= $self->dir) {
5784 $CPAN::Frontend->mywarn(qq{
5785 Could not determine which directory to use for looking at $dist.
5789 my $pwd = CPAN::anycwd();
5790 $self->safe_chdir($dir);
5791 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
5793 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
5794 $ENV{CPAN_SHELL_LEVEL} += 1;
5795 my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
5796 unless (system($shell) == 0) {
5798 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
5801 $self->safe_chdir($pwd);
5804 # CPAN::Distribution::cvs_import ;
5808 my $dir = $self->dir;
5810 my $package = $self->called_for;
5811 my $module = $CPAN::META->instance('CPAN::Module', $package);
5812 my $version = $module->cpan_version;
5814 my $userid = $self->cpan_userid;
5816 my $cvs_dir = (split /\//, $dir)[-1];
5817 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
5819 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
5821 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
5822 if ($cvs_site_perl) {
5823 $cvs_dir = "$cvs_site_perl/$cvs_dir";
5825 my $cvs_log = qq{"imported $package $version sources"};
5826 $version =~ s/\./_/g;
5827 # XXX cvs: undocumented and unclear how it was meant to work
5828 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
5829 "$cvs_dir", $userid, "v$version");
5831 my $pwd = CPAN::anycwd();
5832 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
5834 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
5836 $CPAN::Frontend->myprint(qq{@cmd\n});
5837 system(@cmd) == 0 or
5839 $CPAN::Frontend->mydie("cvs import failed");
5840 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
5843 #-> sub CPAN::Distribution::readme ;
5846 my($dist) = $self->id;
5847 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
5848 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
5851 File::Spec->catfile(
5852 $CPAN::Config->{keep_source_where},
5855 split(/\//,"$sans.readme"),
5857 $self->debug("Doing localize") if $CPAN::DEBUG;
5858 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
5860 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
5862 if ($^O eq 'MacOS') {
5863 Mac::BuildTools::launch_file($local_file);
5867 my $fh_pager = FileHandle->new;
5868 local($SIG{PIPE}) = "IGNORE";
5869 my $pager = $CPAN::Config->{'pager'} || "cat";
5870 $fh_pager->open("|$pager")
5871 or die "Could not open pager $pager\: $!";
5872 my $fh_readme = FileHandle->new;
5873 $fh_readme->open($local_file)
5874 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
5875 $CPAN::Frontend->myprint(qq{
5880 $fh_pager->print(<$fh_readme>);
5884 #-> sub CPAN::Distribution::verifyCHECKSUM ;
5885 sub verifyCHECKSUM {
5889 $self->{CHECKSUM_STATUS} ||= "";
5890 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
5891 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5893 my($lc_want,$lc_file,@local,$basename);
5894 @local = split(/\//,$self->id);
5896 push @local, "CHECKSUMS";
5898 File::Spec->catfile($CPAN::Config->{keep_source_where},
5899 "authors", "id", @local);
5901 if (my $size = -s $lc_want) {
5902 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
5903 if ($self->CHECKSUM_check_file($lc_want,1)) {
5904 return $self->{CHECKSUM_STATUS} = "OK";
5907 $lc_file = CPAN::FTP->localize("authors/id/@local",
5910 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
5911 $local[-1] .= ".gz";
5912 $lc_file = CPAN::FTP->localize("authors/id/@local",
5915 $lc_file =~ s/\.gz(?!\n)\Z//;
5916 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
5921 if ($self->CHECKSUM_check_file($lc_file)) {
5922 return $self->{CHECKSUM_STATUS} = "OK";
5926 #-> sub CPAN::Distribution::SIG_check_file ;
5927 sub SIG_check_file {
5928 my($self,$chk_file) = @_;
5929 my $rv = eval { Module::Signature::_verify($chk_file) };
5931 if ($rv == Module::Signature::SIGNATURE_OK()) {
5932 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
5933 return $self->{SIG_STATUS} = "OK";
5935 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
5936 qq{distribution file. }.
5937 qq{Please investigate.\n\n}.
5939 $CPAN::META->instance(
5944 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
5945 is invalid. Maybe you have configured your 'urllist' with
5946 a bad URL. Please check this array with 'o conf urllist', and
5949 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
5953 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
5955 # sloppy is 1 when we have an old checksums file that maybe is good
5958 sub CHECKSUM_check_file {
5959 my($self,$chk_file,$sloppy) = @_;
5960 my($cksum,$file,$basename);
5963 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
5964 if ($CPAN::Config->{check_sigs}) {
5965 if ($CPAN::META->has_inst("Module::Signature")) {
5966 $self->debug("Module::Signature is installed, verifying");
5967 $self->SIG_check_file($chk_file);
5969 $self->debug("Module::Signature is NOT installed");
5973 $file = $self->{localfile};
5974 $basename = File::Basename::basename($file);
5975 my $fh = FileHandle->new;
5976 if (open $fh, $chk_file){
5979 $eval =~ s/\015?\012/\n/g;
5981 my($comp) = Safe->new();
5982 $cksum = $comp->reval($eval);
5984 rename $chk_file, "$chk_file.bad";
5985 Carp::confess($@) if $@;
5988 Carp::carp "Could not open $chk_file for reading";
5991 if (! ref $cksum or ref $cksum ne "HASH") {
5992 $CPAN::Frontend->mywarn(qq{
5993 Warning: checksum file '$chk_file' broken.
5995 When trying to read that file I expected to get a hash reference
5996 for further processing, but got garbage instead.
5998 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
5999 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
6000 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
6002 } elsif (exists $cksum->{$basename}{sha256}) {
6003 $self->debug("Found checksum for $basename:" .
6004 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
6008 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
6010 $fh = CPAN::Tarzip->TIEHANDLE($file);
6013 my $dg = Digest::SHA->new(256);
6016 while ($fh->READ($ref, 4096) > 0){
6019 my $hexdigest = $dg->hexdigest;
6020 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
6024 $CPAN::Frontend->myprint("Checksum for $file ok\n");
6025 return $self->{CHECKSUM_STATUS} = "OK";
6027 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
6028 qq{distribution file. }.
6029 qq{Please investigate.\n\n}.
6031 $CPAN::META->instance(
6036 my $wrap = qq{I\'d recommend removing $file. Its
6037 checksum is incorrect. Maybe you have configured your 'urllist' with
6038 a bad URL. Please check this array with 'o conf urllist', and
6041 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
6043 # former versions just returned here but this seems a
6044 # serious threat that deserves a die
6046 # $CPAN::Frontend->myprint("\n\n");
6050 # close $fh if fileno($fh);
6053 unless ($self->{CHECKSUM_STATUS}) {
6054 $CPAN::Frontend->mywarn(qq{
6055 Warning: No checksum for $basename in $chk_file.
6057 The cause for this may be that the file is very new and the checksum
6058 has not yet been calculated, but it may also be that something is
6059 going awry right now.
6061 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes");
6062 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
6064 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
6069 #-> sub CPAN::Distribution::eq_CHECKSUM ;
6071 my($self,$fh,$expect) = @_;
6072 if ($CPAN::META->has_inst("Digest::SHA")) {
6073 my $dg = Digest::SHA->new(256);
6075 while (read($fh, $data, 4096)){
6078 my $hexdigest = $dg->hexdigest;
6079 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
6080 return $hexdigest eq $expect;
6085 #-> sub CPAN::Distribution::force ;
6087 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
6088 # effect by autoinspection, not by inspecting a global variable. One
6089 # of the reason why this was chosen to work that way was the treatment
6090 # of dependencies. They should not automatically inherit the force
6091 # status. But this has the downside that ^C and die() will return to
6092 # the prompt but will not be able to reset the force_update
6093 # attributes. We try to correct for it currently in the read_metadata
6094 # routine, and immediately before we check for a Signal. I hope this
6095 # works out in one of v1.57_53ff
6097 # "Force get forgets previous error conditions"
6099 #-> sub CPAN::Distribution::force ;
6101 my($self, $method) = @_;
6122 delete $self->{$att};
6123 CPAN->debug(sprintf "att[%s]", $att) if $CPAN::DEBUG;
6125 if ($method && $method =~ /make|test|install/) {
6126 $self->{"force_update"}++; # name should probably have been force_install
6130 #-> sub CPAN::Distribution::notest ;
6132 my($self, $method) = @_;
6133 # warn "XDEBUG: set notest for $self $method";
6134 $self->{"notest"}++; # name should probably have been force_install
6137 #-> sub CPAN::Distribution::unnotest ;
6140 # warn "XDEBUG: deleting notest";
6141 delete $self->{'notest'};
6144 #-> sub CPAN::Distribution::unforce ;
6147 delete $self->{'force_update'};
6150 #-> sub CPAN::Distribution::isa_perl ;
6153 my $file = File::Basename::basename($self->id);
6154 if ($file =~ m{ ^ perl
6163 \.tar[._-](?:gz|bz2)
6167 } elsif ($self->cpan_comment
6169 $self->cpan_comment =~ /isa_perl\(.+?\)/){
6175 #-> sub CPAN::Distribution::perl ;
6180 carp __PACKAGE__ . "::perl was called without parameters.";
6182 return CPAN::HandleConfig->safe_quote($CPAN::Perl);
6186 #-> sub CPAN::Distribution::make ;
6189 my $make = $self->{modulebuild} ? "Build" : "make";
6190 # Emergency brake if they said install Pippi and get newest perl
6191 if ($self->isa_perl) {
6193 $self->called_for ne $self->id &&
6194 ! $self->{force_update}
6196 # if we die here, we break bundles
6199 qq{The most recent version "%s" of the module "%s"
6200 is part of the perl-%s distribution. To install that, you need to run
6201 force install %s --or--
6204 $CPAN::META->instance(
6213 $self->{make} = CPAN::Distrostatus->new("NO isa perl");
6214 $CPAN::Frontend->mysleep(1);
6218 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
6220 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
6222 : ($ENV{PERLLIB} || "");
6224 $CPAN::META->set_perl5lib;
6225 local $ENV{MAKEFLAGS}; # protect us from outer make calls
6228 delete $self->{force_update};
6233 if (!$self->{archived} || $self->{archived} eq "NO") {
6234 push @e, "Is neither a tar nor a zip archive.";
6237 if (!$self->{unwrapped}
6239 $self->{unwrapped}->can("failed") ?
6240 $self->{unwrapped}->failed :
6241 $self->{unwrapped} =~ /^NO/
6243 push @e, "Had problems unarchiving. Please build manually";
6246 unless ($self->{force_update}) {
6247 exists $self->{signature_verify} and (
6248 $self->{signature_verify}->can("failed") ?
6249 $self->{signature_verify}->failed :
6250 $self->{signature_verify} =~ /^NO/
6252 and push @e, "Did not pass the signature test.";
6255 if (exists $self->{writemakefile} &&
6257 $self->{writemakefile}->can("failed") ?
6258 $self->{writemakefile}->failed :
6259 $self->{writemakefile} =~ /^NO/
6261 # XXX maybe a retry would be in order?
6262 my $err = $self->{writemakefile}->can("text") ?
6263 $self->{writemakefile}->text :
6264 $self->{writemakefile};
6266 $err ||= "Had some problem writing Makefile";
6267 $err .= ", won't make";
6271 defined $self->{make} and push @e,
6272 "Has already been processed within this session";
6274 if (exists $self->{later} and length($self->{later})) {
6275 if ($self->unsat_prereq) {
6276 push @e, $self->{later};
6277 # RT ticket 18438 raises doubts if the deletion of {later} is valid.
6278 # YAML-0.53 triggered the later hodge-podge here, but my margin notes
6279 # are not sufficient to be sure if we really must/may do the delete
6280 # here. SO I accept the suggested patch for now. If we trigger a bug
6281 # again, I must go into deep contemplation about the {later} flag.
6284 # delete $self->{later};
6288 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6291 delete $self->{force_update};
6294 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
6295 my $builddir = $self->dir or
6296 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
6297 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
6298 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
6300 if ($^O eq 'MacOS') {
6301 Mac::BuildTools::make($self);
6306 if ($self->{'configure'}) {
6307 $system = $self->{'configure'};
6308 } elsif ($self->{modulebuild}) {
6309 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
6310 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
6312 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
6314 # This needs a handler that can be turned on or off:
6315 # $switch = "-MExtUtils::MakeMaker ".
6316 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
6318 my $makepl_arg = $self->make_x_arg("pl");
6319 $system = sprintf("%s%s Makefile.PL%s",
6321 $switch ? " $switch" : "",
6322 $makepl_arg ? " $makepl_arg" : "",
6326 while (my($k,$v) = each %ENV) {
6327 next unless defined $v;
6331 if (my $env = $self->prefs->{pl}{env}) {
6332 for my $e (keys %$env) {
6333 $ENV{$e} = $env->{$e};
6336 if (exists $self->{writemakefile}) {
6338 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
6342 if ($CPAN::Config->{inactivity_timeout}) {
6344 if ($Config::Config{d_alarm}
6346 $Config::Config{d_alarm} eq "define"
6350 $CPAN::Frontend->mywarn("Warning: you have configured the config ".
6351 "variable 'inactivity_timeout' to ".
6352 "'$CPAN::Config->{inactivity_timeout}'. But ".
6353 "on this machine the system call 'alarm' ".
6354 "isn't available. This means that we cannot ".
6355 "provide the feature of intercepting long ".
6356 "waiting code and will turn this feature off.\n"
6358 $CPAN::Config->{inactivity_timeout} = 0;
6361 if ($go_via_alarm) {
6363 alarm $CPAN::Config->{inactivity_timeout};
6364 local $SIG{CHLD}; # = sub { wait };
6365 if (defined($pid = fork)) {
6370 # note, this exec isn't necessary if
6371 # inactivity_timeout is 0. On the Mac I'd
6372 # suggest, we set it always to 0.
6376 $CPAN::Frontend->myprint("Cannot fork: $!");
6385 $CPAN::Frontend->myprint($err);
6386 $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
6391 if (my $expect_model = $self->_prefs_with_expect("pl")) {
6392 $ret = $self->_run_via_expect($system,$expect_model);
6394 && $self->{writemakefile}
6395 && $self->{writemakefile}->failed) {
6400 $ret = system($system);
6403 $self->{writemakefile} = CPAN::Distrostatus
6404 ->new("NO '$system' returned status $ret");
6405 $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
6406 $self->store_persistent_state;
6407 $self->store_persistent_state;
6411 if (-f "Makefile" || -f "Build") {
6412 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
6413 delete $self->{make_clean}; # if cleaned before, enable next
6415 $self->{writemakefile} = CPAN::Distrostatus
6416 ->new(qq{NO -- Unknown reason});
6420 delete $self->{force_update};
6423 if (my @prereq = $self->unsat_prereq){
6424 if ($prereq[0][0] eq "perl") {
6425 my $need = "requires perl '$prereq[0][1]'";
6426 my $id = $self->pretty_id;
6427 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
6428 $self->{make} = CPAN::Distrostatus->new("NO $need");
6429 $self->store_persistent_state;
6432 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
6436 delete $self->{force_update};
6439 if ($self->{modulebuild}) {
6440 unless (-f "Build") {
6442 $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'".
6443 " in cwd[$cwd]. Danger, Will Robinson!");
6444 $CPAN::Frontend->mysleep(5);
6446 $system = sprintf "%s %s", $self->_build_command(), $CPAN::Config->{mbuild_arg};
6448 $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
6450 my $make_arg = $self->make_x_arg("make");
6451 $system = sprintf("%s%s",
6453 $make_arg ? " $make_arg" : "",
6455 if (my $env = $self->prefs->{make}{env}) { # overriding the local
6456 # ENV of PL, not the
6458 # unlikely to be a risk
6459 for my $e (keys %$env) {
6460 $ENV{$e} = $env->{$e};
6463 my $expect_model = $self->_prefs_with_expect("make");
6464 my $want_expect = 0;
6465 if ( $expect_model && @{$expect_model->{talk}} ) {
6466 my $can_expect = $CPAN::META->has_inst("Expect");
6470 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
6476 $system_ok = $self->_run_via_expect($system,$expect_model) == 0;
6478 $system_ok = system($system) == 0;
6480 $self->introduce_myself;
6482 $CPAN::Frontend->myprint(" $system -- OK\n");
6483 $self->{make} = CPAN::Distrostatus->new("YES");
6485 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
6486 $self->{make} = CPAN::Distrostatus->new("NO");
6487 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
6489 $self->store_persistent_state;
6492 # CPAN::Distribution::_run_via_expect
6493 sub _run_via_expect {
6494 my($self,$system,$expect_model) = @_;
6495 CPAN->debug("system[$system]expect_model[$expect_model]") if $CPAN::DEBUG;
6496 if ($CPAN::META->has_inst("Expect")) {
6497 my $expo = Expect->new; # expo Expect object;
6498 $expo->spawn($system);
6499 my $expecta = $expect_model->{talk};
6500 if ($expect_model->{mode} eq "expect") {
6501 return $self->_run_via_expect_deterministic($expo,$expecta);
6502 } elsif ($expect_model->{mode} eq "expect-in-any-order") {
6503 return $self->_run_via_expect_anyorder($expo,$expecta);
6505 die "Panic: Illegal expect mode: $expect_model->{mode}";
6508 $CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n");
6509 return system($system);
6513 sub _run_via_expect_anyorder {
6514 my($self,$expo,$expecta) = @_;
6515 my $timeout = 3; # currently unsettable
6516 my @expectacopy = @$expecta; # we trash it!
6519 my($eof,$ran_into_timeout);
6520 my @match = $expo->expect($timeout,
6525 $ran_into_timeout++;
6532 $but .= $expo->clear_accum;
6535 return $expo->exitstatus();
6536 } elsif ($ran_into_timeout) {
6537 # warn "DEBUG: they are asking a question, but[$but]";
6538 for (my $i = 0; $i <= $#expectacopy; $i+=2) {
6539 my($next,$send) = @expectacopy[$i,$i+1];
6540 my $regex = eval "qr{$next}";
6541 # warn "DEBUG: will compare with regex[$regex].";
6542 if ($but =~ /$regex/) {
6543 # warn "DEBUG: will send send[$send]";
6545 splice @expectacopy, $i, 2; # never allow reusing an QA pair
6549 my $why = "could not answer a question during the dialog";
6550 $CPAN::Frontend->mywarn("Failing: $why\n");
6551 $self->{writemakefile} =
6552 CPAN::Distrostatus->new("NO $why");
6558 sub _run_via_expect_deterministic {
6559 my($self,$expo,$expecta) = @_;
6560 my $ran_into_timeout;
6561 EXPECT: for (my $i = 0; $i <= $#$expecta; $i+=2) {
6562 my($next,$send) = @$expecta[$i,$i+1];
6565 $timeout = $next->{timeout};
6566 $re = $next->{expect};
6571 CPAN->debug("timeout[$timeout]re[$re]") if $CPAN::DEBUG;
6572 my $regex = eval "qr{$re}";
6573 $expo->expect($timeout,
6575 my $but = $expo->clear_accum;
6576 $CPAN::Frontend->mywarn("EOF (maybe harmless)
6577 expected[$regex]\nbut[$but]\n\n");
6581 my $but = $expo->clear_accum;
6582 $CPAN::Frontend->mywarn("TIMEOUT
6583 expected[$regex]\nbut[$but]\n\n");
6584 $ran_into_timeout++;
6587 if ($ran_into_timeout){
6588 # note that the caller expects 0 for success
6589 $self->{writemakefile} =
6590 CPAN::Distrostatus->new("NO timeout during expect dialog");
6596 return $expo->exitstatus();
6599 # CPAN::Distribution::_find_prefs
6602 my $distroid = $self->pretty_id;
6603 CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
6604 my $prefs_dir = $CPAN::Config->{prefs_dir};
6605 eval { File::Path::mkpath($prefs_dir); };
6607 $CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
6609 my $yaml_module = CPAN->_yaml_module;
6610 if ($CPAN::META->has_inst($yaml_module)) {
6611 my $dh = DirHandle->new($prefs_dir)
6612 or die Carp::croak("Couldn't open '$prefs_dir': $!");
6613 DIRENT: for (sort $dh->read) {
6614 next if $_ eq "." || $_ eq "..";
6615 next unless /\.yml$/;
6616 my $abs = File::Spec->catfile($prefs_dir, $_);
6618 CPAN->debug(sprintf "abs[%s]", $abs) if $CPAN::DEBUG;
6619 my @yaml = @{CPAN->_yaml_loadfile($abs)};
6621 ELEMENT: for my $y (0..$#yaml) {
6622 my $yaml = $yaml[$y];
6623 my $match = $yaml->{match};
6625 CPAN->debug("no 'match' in abs[$abs], skipping");
6629 for my $sub_attribute (keys %$match) {
6630 my $qr = eval "qr{$yaml->{match}{$sub_attribute}}";
6631 if ($sub_attribute eq "module") {
6633 CPAN->debug(sprintf "abs[%s]yaml[%d]", $abs, scalar @yaml) if $CPAN::DEBUG;
6634 my @modules = $self->containsmods;
6635 CPAN->debug(sprintf "abs[%s]yaml[%d]modules[%s]", $abs, scalar @yaml, join(",",@modules)) if $CPAN::DEBUG;
6636 MODULE: for my $module (@modules) {
6637 $okm ||= $module =~ /$qr/;
6638 last MODULE if $okm;
6641 } elsif ($sub_attribute eq "distribution") {
6642 my $okd = $distroid =~ /$qr/;
6644 } elsif ($sub_attribute eq "perl") {
6645 my $okp = $^X =~ /$qr/;
6648 $CPAN::Frontend->mydie("Nonconforming YAML file '$abs': ".
6649 "unknown sub_attribut '$sub_attribute'. ".
6651 "remove, cannot continue.");
6654 CPAN->debug(sprintf "abs[%s]yaml[%d]ok[%d]", $abs, scalar @yaml, $ok) if $CPAN::DEBUG;
6659 prefs_file_doc => $y,
6667 unless ($self->{have_complained_about_missing_yaml}++) {
6668 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot read prefs '$prefs_dir'\n");
6674 # CPAN::Distribution::prefs
6677 if (exists $self->{prefs}) {
6678 return $self->{prefs}; # XXX comment out during debugging
6680 if ($CPAN::Config->{prefs_dir}) {
6681 CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG;
6682 my $prefs = $self->_find_prefs();
6684 for my $x (qw(prefs prefs_file prefs_file_doc)) {
6685 $self->{$x} = $prefs->{$x};
6689 File::Basename::basename($self->{prefs_file}),
6690 $self->{prefs_file_doc},
6692 my $filler1 = "_" x 22;
6693 my $filler2 = int(66 - length($bs))/2;
6694 $filler2 = 0 if $filler2 < 0;
6695 $filler2 = " " x $filler2;
6696 $CPAN::Frontend->myprint("
6697 $filler1 D i s t r o P r e f s $filler1
6698 $filler2 $bs $filler2
6700 $CPAN::Frontend->mysleep(1);
6701 return $self->{prefs};
6707 # CPAN::Distribution::make_x_arg
6709 my($self, $whixh) = @_;
6711 my $prefs = $self->prefs;
6714 && exists $prefs->{$whixh}
6715 && exists $prefs->{$whixh}{args}
6716 && $prefs->{$whixh}{args}
6718 $make_x_arg = join(" ",
6719 map {CPAN::HandleConfig
6720 ->safe_quote($_)} @{$prefs->{$whixh}{args}},
6723 my $what = sprintf "make%s_arg", $whixh eq "make" ? "" : $whixh;
6724 $make_x_arg ||= $CPAN::Config->{$what};
6728 # CPAN::Distribution::_make_command
6735 CPAN::HandleConfig->prefs_lookup($self,
6737 || $Config::Config{make}
6741 # Old style call, without object. Deprecated
6742 Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
6745 CPAN::HandleConfig->prefs_lookup($self,q{make})
6746 || $CPAN::Config->{make}
6747 || $Config::Config{make}
6752 #-> sub CPAN::Distribution::follow_prereqs ;
6753 sub follow_prereqs {
6755 my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_;
6756 return unless @prereq_tuples;
6757 my @prereq = map { $_->[0] } @prereq_tuples;
6758 my $pretty_id = $self->pretty_id;
6760 b => "build_requires",
6764 my($filler1,$filler2,$filler3,$filler4);
6765 my $unsat = "Unsatisfied dependencies detected during";
6766 my $w = length($unsat) > length($pretty_id) ? length($unsat) : length($pretty_id);
6768 my $r = int(($w - length($unsat))/2);
6769 my $l = $w - length($unsat) - $r;
6770 $filler1 = "-"x4 . " "x$l;
6771 $filler2 = " "x$r . "-"x4 . "\n";
6774 my $r = int(($w - length($pretty_id))/2);
6775 my $l = $w - length($pretty_id) - $r;
6776 $filler3 = "-"x4 . " "x$l;
6777 $filler4 = " "x$r . "-"x4 . "\n";
6780 myprint("$filler1 $unsat $filler2".
6781 "$filler3 $pretty_id $filler4".
6782 join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @prereq_tuples),
6785 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
6787 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
6788 my $answer = CPAN::Shell::colorable_makemaker_prompt(
6789 "Shall I follow them and prepend them to the queue
6790 of modules we are processing right now?", "yes");
6791 $follow = $answer =~ /^\s*y/i;
6795 myprint(" Ignoring dependencies on modules @prereq\n");
6799 # color them as dirty
6800 for my $p (@prereq) {
6801 # warn "calling color_cmd_tmps(0,1)";
6802 CPAN::Shell->expandany($p)->color_cmd_tmps(0,1);
6804 # queue them and re-queue yourself
6805 CPAN::Queue->jumpqueue([$id,$self->{reqtype}],
6806 reverse @prereq_tuples);
6807 $self->{later} = "Delayed until after prerequisites";
6808 return 1; # signal success to the queuerunner
6812 #-> sub CPAN::Distribution::unsat_prereq ;
6813 # return ([Foo=>1],[Bar=>1.2]) for normal modules
6814 # return ([perl=>5.008]) if we need a newer perl than we are running under
6817 my $prereq_pm = $self->prereq_pm or return;
6819 my %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
6820 NEED: while (my($need_module, $need_version) = each %merged) {
6821 my($have_version,$inst_file);
6822 if ($need_module eq "perl") {
6826 my $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
6827 next if $nmo->uptodate;
6828 $inst_file = $nmo->inst_file;
6830 # if they have not specified a version, we accept any installed one
6831 if (not defined $need_version or
6832 $need_version eq "0" or
6833 $need_version eq "undef") {
6834 next if defined $inst_file;
6837 $have_version = $nmo->inst_version;
6840 # We only want to install prereqs if either they're not installed
6841 # or if the installed version is too old. We cannot omit this
6842 # check, because if 'force' is in effect, nobody else will check.
6843 if (defined $inst_file) {
6844 my(@all_requirements) = split /\s*,\s*/, $need_version;
6847 RQ: for my $rq (@all_requirements) {
6848 if ($rq =~ s|>=\s*||) {
6849 } elsif ($rq =~ s|>\s*||) {
6851 if (CPAN::Version->vgt($have_version,$rq)){
6855 } elsif ($rq =~ s|!=\s*||) {
6857 if (CPAN::Version->vcmp($have_version,$rq)){
6863 } elsif ($rq =~ m|<=?\s*|) {
6865 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])");
6869 if (! CPAN::Version->vgt($rq, $have_version)){
6872 CPAN->debug(sprintf("need_module[%s]inst_file[%s]".
6873 "inst_version[%s]rq[%s]ok[%d]",
6877 CPAN::Version->readable($rq),
6881 next NEED if $ok == @all_requirements;
6884 if ($need_module eq "perl") {
6885 return ["perl", $need_version];
6887 if ($self->{sponsored_mods}{$need_module}++){
6888 # We have already sponsored it and for some reason it's still
6889 # not available. So we do nothing. Or what should we do?
6890 # if we push it again, we have a potential infinite loop
6893 my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
6894 push @need, [$need_module,$needed_as];
6899 #-> sub CPAN::Distribution::read_yaml ;
6902 return $self->{yaml_content} if exists $self->{yaml_content};
6903 my $build_dir = $self->{build_dir};
6904 my $yaml = File::Spec->catfile($build_dir,"META.yml");
6905 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
6906 return unless -f $yaml;
6907 eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml)->[0]; };
6909 return; # if we die, then we cannot read YAML's own META.yml
6911 if (not exists $self->{yaml_content}{dynamic_config}
6912 or $self->{yaml_content}{dynamic_config}
6914 $self->{yaml_content} = undef;
6916 $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
6918 return $self->{yaml_content};
6921 #-> sub CPAN::Distribution::prereq_pm ;
6924 return $self->{prereq_pm} if
6925 exists $self->{prereq_pm_detected} && $self->{prereq_pm_detected};
6926 return unless $self->{writemakefile} # no need to have succeeded
6927 # but we must have run it
6928 || $self->{modulebuild};
6930 if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
6931 $req = $yaml->{requires} || {};
6932 $breq = $yaml->{build_requires} || {};
6933 undef $req unless ref $req eq "HASH" && %$req;
6935 if ($yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
6936 my $eummv = do { local $^W = 0; $1+0; };
6937 if ($eummv < 6.2501) {
6938 # thanks to Slaven for digging that out: MM before
6939 # that could be wrong because it could reflect a
6946 while (my($k,$v) = each %{$req||{}}) {
6949 } elsif ($k =~ /[A-Za-z]/ &&
6951 $CPAN::META->exists("Module",$v)
6953 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
6954 "requires hash: $k => $v; I'll take both ".
6955 "key and value as a module name\n");
6956 $CPAN::Frontend->mysleep(1);
6962 $req = $areq if $do_replace;
6965 unless ($req || $breq) {
6966 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
6967 my $makefile = File::Spec->catfile($build_dir,"Makefile");
6971 $fh = FileHandle->new("<$makefile\0")) {
6974 last if /MakeMaker post_initialize section/;
6976 \s+PREREQ_PM\s+=>\s+(.+)
6979 # warn "Found prereq expr[$p]";
6981 # Regexp modified by A.Speer to remember actual version of file
6982 # PREREQ_PM hash key wants, then add to
6983 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){
6984 # In case a prereq is mentioned twice, complain.
6985 if ( defined $req->{$1} ) {
6986 warn "Warning: PREREQ_PM mentions $1 more than once, ".
6987 "last mention wins";
6993 } elsif (-f "Build") {
6994 if ($CPAN::META->has_inst("Module::Build")) {
6996 $req = Module::Build->current->requires();
6997 $breq = Module::Build->current->build_requires();
6999 # this failed for example for HTML::Mason and for
7000 # Error.pm because they are subclassing Module::Build
7001 # in their Build.PL in such a way that Module::Build
7002 # cannot read the _build directory. We DO need a dump
7007 sprintf("Warning: while trying to determine ".
7008 "prerequisites for %s with the help of ".
7009 "Module::Build the following error ".
7010 "occurred: '%s'\n\nFalling back to META.yml ".
7011 "for prerequisites\n",
7015 my $build_dir = $self->{build_dir};
7016 my $yaml = File::Spec->catfile($build_dir,"META.yml");
7017 if ($yaml = CPAN->_yaml_loadfile($yaml)->[0]) {
7018 $req = $yaml->{requires} || {};
7019 $breq = $yaml->{build_requires} || {};
7026 && ! -f "Makefile.PL"
7027 && ! exists $req->{"Module::Build"}
7028 && ! $CPAN::META->has_inst("Module::Build")) {
7029 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
7030 "undeclared prerequisite.\n".
7031 " Adding it now as such.\n"
7033 $CPAN::Frontend->mysleep(5);
7034 $req->{"Module::Build"} = 0;
7035 delete $self->{writemakefile};
7037 $self->{prereq_pm_detected}++;
7038 return $self->{prereq_pm} = { requires => $req, build_requires => $breq };
7041 #-> sub CPAN::Distribution::test ;
7046 delete $self->{force_update};
7049 # warn "XDEBUG: checking for notest: $self->{notest} $self";
7050 if ($self->{notest}) {
7051 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
7055 my $make = $self->{modulebuild} ? "Build" : "make";
7057 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
7059 : ($ENV{PERLLIB} || "");
7061 $CPAN::META->set_perl5lib;
7062 local $ENV{MAKEFLAGS}; # protect us from outer make calls
7064 $CPAN::Frontend->myprint("Running $make test\n");
7065 if (my @prereq = $self->unsat_prereq){
7066 unless ($prereq[0][0] eq "perl") {
7067 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
7072 unless (exists $self->{make} or exists $self->{later}) {
7074 "Make had some problems, won't test";
7077 exists $self->{make} and
7079 $self->{make}->can("failed") ?
7080 $self->{make}->failed :
7081 $self->{make} =~ /^NO/
7082 ) and push @e, "Can't test without successful make";
7084 $self->{badtestcnt} ||= 0;
7085 $self->{badtestcnt} > 0 and
7086 push @e, "Won't repeat unsuccessful test during this command";
7088 exists $self->{later} and length($self->{later}) and
7089 push @e, $self->{later};
7091 if (exists $self->{build_dir}) {
7092 if ($CPAN::META->{is_tested}{$self->{build_dir}}
7094 exists $self->{make_test}
7097 $self->{make_test}->can("failed") ?
7098 $self->{make_test}->failed :
7099 $self->{make_test} =~ /^NO/
7102 push @e, "Already tested successfully";
7105 push @e, "Has no own directory";
7108 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
7110 chdir $self->{'build_dir'} or
7111 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
7112 $self->debug("Changed directory to $self->{'build_dir'}")
7115 if ($^O eq 'MacOS') {
7116 Mac::BuildTools::make_test($self);
7120 if ($self->{modulebuild}) {
7121 my $v = CPAN::Shell->expand("Module","Test::Harness")->inst_version;
7122 if (CPAN::Version->vlt($v,2.62)) {
7123 $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only
7124 '$v', you need at least '2.62'. Please upgrade your Test::Harness.\n});
7125 $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old");
7131 if ($self->{modulebuild}) {
7132 $system = sprintf "%s test", $self->_build_command();
7134 $system = join " ", $self->_make_command(), "test";
7138 while (my($k,$v) = each %ENV) {
7139 next unless defined $v;
7143 if (my $env = $self->prefs->{test}{env}) {
7144 for my $e (keys %$env) {
7145 $ENV{$e} = $env->{$e};
7148 my $expect_model = $self->_prefs_with_expect("test");
7149 my $want_expect = 0;
7150 if ( $expect_model && @{$expect_model->{talk}} ) {
7151 my $can_expect = $CPAN::META->has_inst("Expect");
7155 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
7156 "testing without\n");
7159 my $test_report = CPAN::HandleConfig->prefs_lookup($self,
7163 my $can_report = $CPAN::META->has_inst("CPAN::Reporter");
7167 $CPAN::Frontend->mywarn->("CPAN::Reporter not installed, falling back to ".
7168 "testing without\n");
7171 my $ready_to_report = $want_report;
7172 if ($ready_to_report
7174 substr($self->id,-1,1) eq "."
7176 $self->author->id eq "LOCAL"
7179 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
7180 "for local directories\n");
7181 $ready_to_report = 0;
7183 if ($ready_to_report
7185 $self->prefs->{patches}
7187 @{$self->prefs->{patches}}
7191 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
7192 "when the source has been patched\n");
7193 $ready_to_report = 0;
7196 if ($ready_to_report) {
7197 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is currently ".
7198 "not supported when distroprefs specify ".
7199 "an interactive test\n");
7201 $tests_ok = $self->_run_via_expect($system,$expect_model) == 0;
7202 } elsif ( $ready_to_report ) {
7203 $tests_ok = CPAN::Reporter::test($self, $system);
7205 $tests_ok = system($system) == 0;
7207 $self->introduce_myself;
7211 for my $m (keys %{$self->{sponsored_mods}}) {
7212 my $m_obj = CPAN::Shell->expand("Module",$m);
7213 my $d_obj = $m_obj->distribution;
7215 if (!$d_obj->{make_test}
7217 $d_obj->{make_test}->failed){
7225 my $which = join ",", @prereq;
7226 my $verb = $cnt == 1 ? "one dependency not OK ($which)" :
7227 "$cnt dependencies missing ($which)";
7228 $CPAN::Frontend->mywarn("Tests succeeded but $verb\n");
7229 $self->{make_test} = CPAN::Distrostatus->new("NO $verb");
7230 $self->store_persistent_state;
7235 $CPAN::Frontend->myprint(" $system -- OK\n");
7236 $CPAN::META->is_tested($self->{'build_dir'});
7237 $self->{make_test} = CPAN::Distrostatus->new("YES");
7239 $self->{make_test} = CPAN::Distrostatus->new("NO");
7240 $self->{badtestcnt}++;
7241 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
7243 $self->store_persistent_state;
7246 sub _prefs_with_expect {
7247 my($self,$where) = @_;
7248 return unless my $prefs = $self->prefs;
7249 return unless my $where_prefs = $prefs->{$where};
7250 if ($where_prefs->{expect}) {
7253 talk => $where_prefs->{expect},
7255 } elsif ($where_prefs->{"expect-in-any-order"}) {
7257 mode => "expect-in-any-order",
7258 talk => $where_prefs->{"expect-in-any-order"},
7264 #-> sub CPAN::Distribution::clean ;
7267 my $make = $self->{modulebuild} ? "Build" : "make";
7268 $CPAN::Frontend->myprint("Running $make clean\n");
7269 unless (exists $self->{archived}) {
7270 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
7271 "/untarred, nothing done\n");
7274 unless (exists $self->{build_dir}) {
7275 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
7280 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
7281 push @e, "make clean already called once";
7282 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
7284 chdir $self->{'build_dir'} or
7285 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
7286 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
7288 if ($^O eq 'MacOS') {
7289 Mac::BuildTools::make_clean($self);
7294 if ($self->{modulebuild}) {
7295 unless (-f "Build") {
7297 $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}".
7298 " in cwd[$cwd]. Danger, Will Robinson!");
7299 $CPAN::Frontend->mysleep(5);
7301 $system = sprintf "%s clean", $self->_build_command();
7303 $system = join " ", $self->_make_command(), "clean";
7305 my $system_ok = system($system) == 0;
7306 $self->introduce_myself;
7308 $CPAN::Frontend->myprint(" $system -- OK\n");
7312 # Jost Krieger pointed out that this "force" was wrong because
7313 # it has the effect that the next "install" on this distribution
7314 # will untar everything again. Instead we should bring the
7315 # object's state back to where it is after untarring.
7326 $self->{make_clean} = CPAN::Distrostatus->new("YES");
7329 # Hmmm, what to do if make clean failed?
7331 $self->{make_clean} = CPAN::Distrostatus->new("NO");
7332 $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n});
7334 # 2006-02-27: seems silly to me to force a make now
7335 # $self->force("make"); # so that this directory won't be used again
7338 $self->store_persistent_state;
7341 #-> sub CPAN::Distribution::install ;
7346 delete $self->{force_update};
7349 my $make = $self->{modulebuild} ? "Build" : "make";
7350 $CPAN::Frontend->myprint("Running $make install\n");
7353 unless (exists $self->{make} or exists $self->{later}) {
7355 "Make had some problems, won't install";
7358 exists $self->{make} and
7360 $self->{make}->can("failed") ?
7361 $self->{make}->failed :
7362 $self->{make} =~ /^NO/
7364 push @e, "Make had returned bad status, install seems impossible";
7366 if (exists $self->{build_dir}) {
7368 push @e, "Has no own directory";
7371 if (exists $self->{make_test} and
7373 $self->{make_test}->can("failed") ?
7374 $self->{make_test}->failed :
7375 $self->{make_test} =~ /^NO/
7377 if ($self->{force_update}) {
7378 $self->{make_test}->text("FAILED but failure ignored because ".
7379 "'force' in effect");
7381 push @e, "make test had returned bad status, ".
7382 "won't install without force"
7385 if (exists $self->{'install'}) {
7386 if ($self->{'install'}->can("text") ?
7387 $self->{'install'}->text eq "YES" :
7388 $self->{'install'} =~ /^YES/
7390 push @e, "Already done";
7392 # comment in Todo on 2006-02-11; maybe retry?
7393 push @e, "Already tried without success";
7397 exists $self->{later} and length($self->{later}) and
7398 push @e, $self->{later};
7400 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
7402 chdir $self->{'build_dir'} or
7403 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
7404 $self->debug("Changed directory to $self->{'build_dir'}")
7407 if ($^O eq 'MacOS') {
7408 Mac::BuildTools::make_install($self);
7413 if ($self->{modulebuild}) {
7414 my($mbuild_install_build_command) =
7415 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
7416 $CPAN::Config->{mbuild_install_build_command} ?
7417 $CPAN::Config->{mbuild_install_build_command} :
7418 $self->_build_command();
7419 $system = sprintf("%s install %s",
7420 $mbuild_install_build_command,
7421 $CPAN::Config->{mbuild_install_arg},
7424 my($make_install_make_command) =
7425 CPAN::HandleConfig->prefs_lookup($self,
7426 q{make_install_make_command})
7427 || $self->_make_command();
7428 $system = sprintf("%s install %s",
7429 $make_install_make_command,
7430 $CPAN::Config->{make_install_arg},
7434 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
7435 my $brip = CPAN::HandleConfig->prefs_lookup($self,
7436 q{build_requires_install_policy});
7439 my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command
7440 my $want_install = "yes";
7441 if ($reqtype eq "b") {
7442 if ($brip eq "no") {
7443 $want_install = "no";
7444 } elsif ($brip =~ m|^ask/(.+)|) {
7446 $default = "yes" unless $default =~ /^(y|n)/i;
7448 CPAN::Shell::colorable_makemaker_prompt
7449 ("$id is just needed temporarily during building or testing. ".
7450 "Do you want to install it permanently? (Y/n)",
7454 unless ($want_install =~ /^y/i) {
7455 my $is_only = "is only 'build_requires'";
7456 $CPAN::Frontend->mywarn("Not installing because $is_only\n");
7457 $self->{install} = CPAN::Distrostatus->new("NO -- $is_only");
7458 delete $self->{force_update};
7461 my($pipe) = FileHandle->new("$system $stderr |");
7464 print $_; # intentionally NOT use Frontend->myprint because it
7465 # looks irritating when we markup in color what we
7466 # just pass through from an external program
7470 my $close_ok = $? == 0;
7471 $self->introduce_myself;
7473 $CPAN::Frontend->myprint(" $system -- OK\n");
7474 $CPAN::META->is_installed($self->{build_dir});
7475 return $self->{install} = CPAN::Distrostatus->new("YES");
7477 $self->{install} = CPAN::Distrostatus->new("NO");
7478 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
7480 CPAN::HandleConfig->prefs_lookup($self,
7481 q{make_install_make_command});
7483 $makeout =~ /permission/s
7487 || $mimc eq (CPAN::HandleConfig->prefs_lookup($self,
7491 $CPAN::Frontend->myprint(
7493 qq{ You may have to su }.
7494 qq{to root to install the package\n}.
7495 qq{ (Or you may want to run something like\n}.
7496 qq{ o conf make_install_make_command 'sudo make'\n}.
7497 qq{ to raise your permissions.}
7501 delete $self->{force_update};
7502 $self->store_persistent_state;
7505 sub introduce_myself {
7507 $CPAN::Frontend->myprint(sprintf(" %s\n",$self->pretty_id));
7510 #-> sub CPAN::Distribution::dir ;
7512 shift->{'build_dir'};
7515 #-> sub CPAN::Distribution::perldoc ;
7519 my($dist) = $self->id;
7520 my $package = $self->called_for;
7522 $self->_display_url( $CPAN::Defaultdocs . $package );
7525 #-> sub CPAN::Distribution::_check_binary ;
7527 my ($dist,$shell,$binary) = @_;
7530 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
7533 if ($CPAN::META->has_inst("File::Which")) {
7534 return File::Which::which($binary);
7537 $pid = open README, "which $binary|"
7538 or $CPAN::Frontend->mywarn(qq{Could not fork 'which $binary': $!\n});
7544 or $CPAN::Frontend->mywarn("Could not run 'which $binary': $!\n")
7548 $CPAN::Frontend->myprint(qq{ + $out \n})
7549 if $CPAN::DEBUG && $out;
7554 #-> sub CPAN::Distribution::_display_url ;
7556 my($self,$url) = @_;
7557 my($res,$saved_file,$pid,$out);
7559 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
7562 # should we define it in the config instead?
7563 my $html_converter = "html2text";
7565 my $web_browser = $CPAN::Config->{'lynx'} || undef;
7566 my $web_browser_out = $web_browser
7567 ? CPAN::Distribution->_check_binary($self,$web_browser)
7570 if ($web_browser_out) {
7571 # web browser found, run the action
7572 my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
7573 $CPAN::Frontend->myprint(qq{system[$browser $url]})
7575 $CPAN::Frontend->myprint(qq{
7578 with browser $browser
7580 $CPAN::Frontend->mysleep(1);
7581 system("$browser $url");
7582 if ($saved_file) { 1 while unlink($saved_file) }
7584 # web browser not found, let's try text only
7585 my $html_converter_out =
7586 CPAN::Distribution->_check_binary($self,$html_converter);
7587 $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
7589 if ($html_converter_out ) {
7590 # html2text found, run it
7591 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
7592 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
7593 unless defined($saved_file);
7596 $pid = open README, "$html_converter $saved_file |"
7597 or $CPAN::Frontend->mydie(qq{
7598 Could not fork '$html_converter $saved_file': $!});
7600 if ($CPAN::META->has_inst("File::Temp")) {
7601 $fh = File::Temp->new(
7602 template => 'cpan_htmlconvert_XXXX',
7606 $filename = $fh->filename;
7608 $filename = "cpan_htmlconvert_$$.txt";
7609 $fh = FileHandle->new();
7610 open $fh, ">$filename" or die;
7616 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
7617 my $tmpin = $fh->filename;
7618 $CPAN::Frontend->myprint(sprintf(qq{
7620 saved output to %s\n},
7628 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
7629 my $fh_pager = FileHandle->new;
7630 local($SIG{PIPE}) = "IGNORE";
7631 my $pager = $CPAN::Config->{'pager'} || "cat";
7632 $fh_pager->open("|$pager")
7633 or $CPAN::Frontend->mydie(qq{
7634 Could not open pager '$pager': $!});
7635 $CPAN::Frontend->myprint(qq{
7640 $CPAN::Frontend->mysleep(1);
7641 $fh_pager->print(<FH>);
7644 # coldn't find the web browser or html converter
7645 $CPAN::Frontend->myprint(qq{
7646 You need to install lynx or $html_converter to use this feature.});
7651 #-> sub CPAN::Distribution::_getsave_url ;
7653 my($dist, $shell, $url) = @_;
7655 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
7659 if ($CPAN::META->has_inst("File::Temp")) {
7660 $fh = File::Temp->new(
7661 template => "cpan_getsave_url_XXXX",
7665 $filename = $fh->filename;
7667 $fh = FileHandle->new;
7668 $filename = "cpan_getsave_url_$$.html";
7670 my $tmpin = $filename;
7671 if ($CPAN::META->has_usable('LWP')) {
7672 $CPAN::Frontend->myprint("Fetching with LWP:
7676 CPAN::LWP::UserAgent->config;
7677 eval { $Ua = CPAN::LWP::UserAgent->new; };
7679 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
7683 $Ua->proxy('http', $var)
7684 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
7686 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
7689 my $req = HTTP::Request->new(GET => $url);
7690 $req->header('Accept' => 'text/html');
7691 my $res = $Ua->request($req);
7692 if ($res->is_success) {
7693 $CPAN::Frontend->myprint(" + request successful.\n")
7695 print $fh $res->content;
7697 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
7701 $CPAN::Frontend->myprint(sprintf(
7702 "LWP failed with code[%s], message[%s]\n",
7709 $CPAN::Frontend->mywarn(" LWP not available\n");
7714 # sub CPAN::Distribution::_build_command
7715 sub _build_command {
7717 if ($^O eq "MSWin32") { # special code needed at least up to
7718 # Module::Build 0.2611 and 0.2706; a fix
7719 # in M:B has been promised 2006-01-30
7720 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
7721 return "$perl ./Build";
7726 package CPAN::Bundle;
7731 $CPAN::Frontend->myprint($self->as_string);
7736 delete $self->{later};
7737 for my $c ( $self->contains ) {
7738 my $obj = CPAN::Shell->expandany($c) or next;
7743 # mark as dirty/clean
7744 #-> sub CPAN::Bundle::color_cmd_tmps ;
7745 sub color_cmd_tmps {
7747 my($depth) = shift || 0;
7748 my($color) = shift || 0;
7749 my($ancestors) = shift || [];
7750 # a module needs to recurse to its cpan_file, a distribution needs
7751 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
7753 return if exists $self->{incommandcolor}
7754 && $self->{incommandcolor}==$color;
7756 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
7758 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
7760 for my $c ( $self->contains ) {
7761 my $obj = CPAN::Shell->expandany($c) or next;
7762 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
7763 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
7766 delete $self->{badtestcnt};
7768 $self->{incommandcolor} = $color;
7771 #-> sub CPAN::Bundle::as_string ;
7775 # following line must be "=", not "||=" because we have a moving target
7776 $self->{INST_VERSION} = $self->inst_version;
7777 return $self->SUPER::as_string;
7780 #-> sub CPAN::Bundle::contains ;
7783 my($inst_file) = $self->inst_file || "";
7784 my($id) = $self->id;
7785 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
7786 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
7789 unless ($inst_file) {
7790 # Try to get at it in the cpan directory
7791 $self->debug("no inst_file") if $CPAN::DEBUG;
7793 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
7794 $cpan_file = $self->cpan_file;
7795 if ($cpan_file eq "N/A") {
7796 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
7797 Maybe stale symlink? Maybe removed during session? Giving up.\n");
7799 my $dist = $CPAN::META->instance('CPAN::Distribution',
7802 $self->debug("id[$dist->{ID}]") if $CPAN::DEBUG;
7803 my($todir) = $CPAN::Config->{'cpan_home'};
7804 my(@me,$from,$to,$me);
7805 @me = split /::/, $self->id;
7807 $me = File::Spec->catfile(@me);
7808 $from = $self->find_bundle_file($dist->{'build_dir'},join('/',@me));
7809 $to = File::Spec->catfile($todir,$me);
7810 File::Path::mkpath(File::Basename::dirname($to));
7811 File::Copy::copy($from, $to)
7812 or Carp::confess("Couldn't copy $from to $to: $!");
7816 my $fh = FileHandle->new;
7818 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
7820 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
7822 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
7823 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
7824 next unless $in_cont;
7829 push @result, (split " ", $_, 2)[0];
7832 delete $self->{STATUS};
7833 $self->{CONTAINS} = \@result;
7834 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
7836 $CPAN::Frontend->mywarn(qq{
7837 The bundle file "$inst_file" may be a broken
7838 bundlefile. It seems not to contain any bundle definition.
7839 Please check the file and if it is bogus, please delete it.
7840 Sorry for the inconvenience.
7846 #-> sub CPAN::Bundle::find_bundle_file
7847 # $where is in local format, $what is in unix format
7848 sub find_bundle_file {
7849 my($self,$where,$what) = @_;
7850 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
7851 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
7852 ### my $bu = File::Spec->catfile($where,$what);
7853 ### return $bu if -f $bu;
7854 my $manifest = File::Spec->catfile($where,"MANIFEST");
7855 unless (-f $manifest) {
7856 require ExtUtils::Manifest;
7857 my $cwd = CPAN::anycwd();
7858 $self->safe_chdir($where);
7859 ExtUtils::Manifest::mkmanifest();
7860 $self->safe_chdir($cwd);
7862 my $fh = FileHandle->new($manifest)
7863 or Carp::croak("Couldn't open $manifest: $!");
7865 my $bundle_filename = $what;
7866 $bundle_filename =~ s|Bundle.*/||;
7867 my $bundle_unixpath;
7870 my($file) = /(\S+)/;
7871 if ($file =~ m|\Q$what\E$|) {
7872 $bundle_unixpath = $file;
7873 # return File::Spec->catfile($where,$bundle_unixpath); # bad
7876 # retry if she managed to have no Bundle directory
7877 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
7879 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
7880 if $bundle_unixpath;
7881 Carp::croak("Couldn't find a Bundle file in $where");
7884 # needs to work quite differently from Module::inst_file because of
7885 # cpan_home/Bundle/ directory and the possibility that we have
7886 # shadowing effect. As it makes no sense to take the first in @INC for
7887 # Bundles, we parse them all for $VERSION and take the newest.
7889 #-> sub CPAN::Bundle::inst_file ;
7894 @me = split /::/, $self->id;
7897 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
7898 my $bfile = File::Spec->catfile($incdir, @me);
7899 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
7900 next unless -f $bfile;
7901 my $foundv = MM->parse_version($bfile);
7902 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
7903 $self->{INST_FILE} = $bfile;
7904 $self->{INST_VERSION} = $bestv = $foundv;
7910 #-> sub CPAN::Bundle::inst_version ;
7913 $self->inst_file; # finds INST_VERSION as side effect
7914 $self->{INST_VERSION};
7917 #-> sub CPAN::Bundle::rematein ;
7919 my($self,$meth) = @_;
7920 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
7921 my($id) = $self->id;
7922 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
7923 unless $self->inst_file || $self->cpan_file;
7925 for $s ($self->contains) {
7926 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
7927 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
7928 if ($type eq 'CPAN::Distribution') {
7929 $CPAN::Frontend->mywarn(qq{
7930 The Bundle }.$self->id.qq{ contains
7931 explicitly a file '$s'.
7932 Going to $meth that.
7934 $CPAN::Frontend->mysleep(5);
7936 # possibly noisy action:
7937 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
7938 my $obj = $CPAN::META->instance($type,$s);
7939 $obj->{reqtype} = $self->{reqtype};
7941 if ($obj->isa('CPAN::Bundle')
7943 exists $obj->{install_failed}
7945 ref($obj->{install_failed}) eq "HASH"
7947 for (keys %{$obj->{install_failed}}) {
7948 $self->{install_failed}{$_} = undef; # propagate faiure up
7951 $fail{$s} = 1; # the bundle itself may have succeeded but
7956 $success = $obj->can("uptodate") ? $obj->uptodate : 0;
7957 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
7959 delete $self->{install_failed}{$s};
7966 # recap with less noise
7967 if ( $meth eq "install" ) {
7970 my $raw = sprintf(qq{Bundle summary:
7971 The following items in bundle %s had installation problems:},
7974 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
7975 $CPAN::Frontend->myprint("\n");
7978 for $s ($self->contains) {
7980 $paragraph .= "$s ";
7981 $self->{install_failed}{$s} = undef;
7982 $reported{$s} = undef;
7985 my $report_propagated;
7986 for $s (sort keys %{$self->{install_failed}}) {
7987 next if exists $reported{$s};
7988 $paragraph .= "and the following items had problems
7989 during recursive bundle calls: " unless $report_propagated++;
7990 $paragraph .= "$s ";
7992 $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
7993 $CPAN::Frontend->myprint("\n");
7995 $self->{'install'} = 'YES';
8000 # If a bundle contains another that contains an xs_file we have here,
8001 # we just don't bother I suppose
8002 #-> sub CPAN::Bundle::xs_file
8007 #-> sub CPAN::Bundle::force ;
8008 sub force { shift->rematein('force',@_); }
8009 #-> sub CPAN::Bundle::notest ;
8010 sub notest { shift->rematein('notest',@_); }
8011 #-> sub CPAN::Bundle::get ;
8012 sub get { shift->rematein('get',@_); }
8013 #-> sub CPAN::Bundle::make ;
8014 sub make { shift->rematein('make',@_); }
8015 #-> sub CPAN::Bundle::test ;
8018 $self->{badtestcnt} ||= 0;
8019 $self->rematein('test',@_);
8021 #-> sub CPAN::Bundle::install ;
8024 $self->rematein('install',@_);
8026 #-> sub CPAN::Bundle::clean ;
8027 sub clean { shift->rematein('clean',@_); }
8029 #-> sub CPAN::Bundle::uptodate ;
8032 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
8034 foreach $c ($self->contains) {
8035 my $obj = CPAN::Shell->expandany($c);
8036 return 0 unless $obj->uptodate;
8041 #-> sub CPAN::Bundle::readme ;
8044 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
8045 No File found for bundle } . $self->id . qq{\n}), return;
8046 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
8047 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
8050 package CPAN::Module;
8054 # sub CPAN::Module::userid
8059 return $ro->{userid} || $ro->{CPAN_USERID};
8061 # sub CPAN::Module::description
8064 my $ro = $self->ro or return "";
8070 CPAN::Shell->expand("Distribution",$self->cpan_file);
8073 # sub CPAN::Module::undelay
8076 delete $self->{later};
8077 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
8082 # mark as dirty/clean
8083 #-> sub CPAN::Module::color_cmd_tmps ;
8084 sub color_cmd_tmps {
8086 my($depth) = shift || 0;
8087 my($color) = shift || 0;
8088 my($ancestors) = shift || [];
8089 # a module needs to recurse to its cpan_file
8091 return if exists $self->{incommandcolor}
8092 && $self->{incommandcolor}==$color;
8093 return if $depth>=1 && $self->uptodate;
8095 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
8097 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
8099 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
8100 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
8103 delete $self->{badtestcnt};
8105 $self->{incommandcolor} = $color;
8108 #-> sub CPAN::Module::as_glimpse ;
8112 my $class = ref($self);
8113 $class =~ s/^CPAN:://;
8117 $CPAN::Shell::COLOR_REGISTERED
8119 $CPAN::META->has_inst("Term::ANSIColor")
8123 $color_on = Term::ANSIColor::color("green");
8124 $color_off = Term::ANSIColor::color("reset");
8126 my $uptodateness = " ";
8127 if ($class eq "Bundle") {
8128 } elsif ($self->uptodate) {
8129 $uptodateness = "=";
8130 } elsif ($self->inst_version) {
8131 $uptodateness = "<";
8133 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
8139 ($self->distribution ?
8140 $self->distribution->pretty_id :
8147 #-> sub CPAN::Module::dslip_status
8151 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
8152 pre-alpha alpha beta released
8154 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
8155 developer comp.lang.perl.*
8157 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
8158 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
8160 object-oriented pragma
8162 @{$stat->{P}}{qw,p g l b a o d r n,} = qw,Standard-Perl
8166 distribution_allowed
8167 restricted_distribution
8169 for my $x (qw(d s l i p)) {
8170 $stat->{$x}{' '} = 'unknown';
8171 $stat->{$x}{'?'} = 'unknown';
8174 return +{} unless $ro && $ro->{statd};
8181 DV => $stat->{D}{$ro->{statd}},
8182 SV => $stat->{S}{$ro->{stats}},
8183 LV => $stat->{L}{$ro->{statl}},
8184 IV => $stat->{I}{$ro->{stati}},
8185 PV => $stat->{P}{$ro->{statp}},
8189 #-> sub CPAN::Module::as_string ;
8193 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
8194 my $class = ref($self);
8195 $class =~ s/^CPAN:://;
8197 push @m, $class, " id = $self->{ID}\n";
8198 my $sprintf = " %-12s %s\n";
8199 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
8200 if $self->description;
8201 my $sprintf2 = " %-12s %s (%s)\n";
8203 $userid = $self->userid;
8206 if ($author = CPAN::Shell->expand('Author',$userid)) {
8209 if ($m = $author->email) {
8216 $author->fullname . $email
8220 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
8221 if $self->cpan_version;
8222 if (my $cpan_file = $self->cpan_file){
8223 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
8224 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
8225 my $upload_date = $dist->upload_date;
8227 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
8231 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
8232 my $dslip = $self->dslip_status;
8236 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
8238 my $local_file = $self->inst_file;
8239 unless ($self->{MANPAGE}) {
8242 $manpage = $self->manpage_headline($local_file);
8244 # If we have already untarred it, we should look there
8245 my $dist = $CPAN::META->instance('CPAN::Distribution',
8247 # warn "dist[$dist]";
8248 # mff=manifest file; mfh=manifest handle
8253 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
8255 $mfh = FileHandle->new($mff)
8257 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
8258 my $lfre = $self->id; # local file RE
8261 my($lfl); # local file file
8263 my(@mflines) = <$mfh>;
8268 while (length($lfre)>5 and !$lfl) {
8269 ($lfl) = grep /$lfre/, @mflines;
8270 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
8273 $lfl =~ s/\s.*//; # remove comments
8274 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
8275 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
8276 # warn "lfl_abs[$lfl_abs]";
8278 $manpage = $self->manpage_headline($lfl_abs);
8282 $self->{MANPAGE} = $manpage if $manpage;
8285 for $item (qw/MANPAGE/) {
8286 push @m, sprintf($sprintf, $item, $self->{$item})
8287 if exists $self->{$item};
8289 for $item (qw/CONTAINS/) {
8290 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
8291 if exists $self->{$item} && @{$self->{$item}};
8293 push @m, sprintf($sprintf, 'INST_FILE',
8294 $local_file || "(not installed)");
8295 push @m, sprintf($sprintf, 'INST_VERSION',
8296 $self->inst_version) if $local_file;
8300 sub manpage_headline {
8301 my($self,$local_file) = @_;
8302 my(@local_file) = $local_file;
8303 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
8304 push @local_file, $local_file;
8306 for $locf (@local_file) {
8307 next unless -f $locf;
8308 my $fh = FileHandle->new($locf)
8309 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
8313 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
8314 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
8331 #-> sub CPAN::Module::cpan_file ;
8332 # Note: also inherited by CPAN::Bundle
8335 # CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
8336 unless ($self->ro) {
8337 CPAN::Index->reload;
8340 if ($ro && defined $ro->{CPAN_FILE}){
8341 return $ro->{CPAN_FILE};
8343 my $userid = $self->userid;
8345 if ($CPAN::META->exists("CPAN::Author",$userid)) {
8346 my $author = $CPAN::META->instance("CPAN::Author",
8348 my $fullname = $author->fullname;
8349 my $email = $author->email;
8350 unless (defined $fullname && defined $email) {
8351 return sprintf("Contact Author %s",
8355 return "Contact Author $fullname <$email>";
8357 return "Contact Author $userid (Email address not available)";
8365 #-> sub CPAN::Module::cpan_version ;
8371 # Can happen with modules that are not on CPAN
8374 $ro->{CPAN_VERSION} = 'undef'
8375 unless defined $ro->{CPAN_VERSION};
8376 $ro->{CPAN_VERSION};
8379 #-> sub CPAN::Module::force ;
8382 $self->{'force_update'}++;
8387 # warn "XDEBUG: set notest for Module";
8388 $self->{'notest'}++;
8391 #-> sub CPAN::Module::rematein ;
8393 my($self,$meth) = @_;
8394 $CPAN::Frontend->myprint(sprintf("Running %s for module '%s'\n",
8397 my $cpan_file = $self->cpan_file;
8398 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
8399 $CPAN::Frontend->mywarn(sprintf qq{
8400 The module %s isn\'t available on CPAN.
8402 Either the module has not yet been uploaded to CPAN, or it is
8403 temporary unavailable. Please contact the author to find out
8404 more about the status. Try 'i %s'.
8411 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
8412 $pack->called_for($self->id);
8413 $pack->force($meth) if exists $self->{'force_update'};
8414 $pack->notest($meth) if exists $self->{'notest'};
8416 $pack->{reqtype} ||= "";
8417 CPAN->debug("dist-reqtype[$pack->{reqtype}]".
8418 "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG;
8419 if ($pack->{reqtype}) {
8420 if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) {
8421 $pack->{reqtype} = $self->{reqtype};
8423 exists $pack->{install}
8426 $pack->{install}->can("failed") ?
8427 $pack->{install}->failed :
8428 $pack->{install} =~ /^NO/
8431 delete $pack->{install};
8432 $CPAN::Frontend->mywarn
8433 ("Promoting $pack->{ID} from 'build_requires' to 'requires'");
8437 $pack->{reqtype} = $self->{reqtype};
8444 $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
8445 $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
8446 delete $self->{'force_update'};
8447 delete $self->{'notest'};
8453 #-> sub CPAN::Module::perldoc ;
8454 sub perldoc { shift->rematein('perldoc') }
8455 #-> sub CPAN::Module::readme ;
8456 sub readme { shift->rematein('readme') }
8457 #-> sub CPAN::Module::look ;
8458 sub look { shift->rematein('look') }
8459 #-> sub CPAN::Module::cvs_import ;
8460 sub cvs_import { shift->rematein('cvs_import') }
8461 #-> sub CPAN::Module::get ;
8462 sub get { shift->rematein('get',@_) }
8463 #-> sub CPAN::Module::make ;
8464 sub make { shift->rematein('make') }
8465 #-> sub CPAN::Module::test ;
8468 $self->{badtestcnt} ||= 0;
8469 $self->rematein('test',@_);
8471 #-> sub CPAN::Module::uptodate ;
8474 local($_); # protect against a bug in MakeMaker 6.17
8475 my($latest) = $self->cpan_version;
8477 my($inst_file) = $self->inst_file;
8479 if (defined $inst_file) {
8480 $have = $self->inst_version;
8485 ! CPAN::Version->vgt($latest, $have)
8487 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
8488 "latest[$latest] have[$have]") if $CPAN::DEBUG;
8493 #-> sub CPAN::Module::install ;
8499 not exists $self->{'force_update'}
8501 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
8503 $self->inst_version,
8509 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
8510 $CPAN::Frontend->mywarn(qq{
8511 \n\n\n ***WARNING***
8512 The module $self->{ID} has no active maintainer.\n\n\n
8514 $CPAN::Frontend->mysleep(5);
8516 $self->rematein('install') if $doit;
8518 #-> sub CPAN::Module::clean ;
8519 sub clean { shift->rematein('clean') }
8521 #-> sub CPAN::Module::inst_file ;
8525 @packpath = split /::/, $self->{ID};
8526 $packpath[-1] .= ".pm";
8527 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
8528 unshift @packpath, "Term", "ReadLine"; # historical reasons
8530 foreach $dir (@INC) {
8531 my $pmfile = File::Spec->catfile($dir,@packpath);
8539 #-> sub CPAN::Module::xs_file ;
8543 @packpath = split /::/, $self->{ID};
8544 push @packpath, $packpath[-1];
8545 $packpath[-1] .= "." . $Config::Config{'dlext'};
8546 foreach $dir (@INC) {
8547 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
8555 #-> sub CPAN::Module::inst_version ;
8558 my $parsefile = $self->inst_file or return;
8559 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
8562 $have = MM->parse_version($parsefile) || "undef";
8563 $have =~ s/^ //; # since the %vd hack these two lines here are needed
8564 $have =~ s/ $//; # trailing whitespace happens all the time
8566 # My thoughts about why %vd processing should happen here
8568 # Alt1 maintain it as string with leading v:
8569 # read index files do nothing
8570 # compare it use utility for compare
8571 # print it do nothing
8573 # Alt2 maintain it as what it is
8574 # read index files convert
8575 # compare it use utility because there's still a ">" vs "gt" issue
8576 # print it use CPAN::Version for print
8578 # Seems cleaner to hold it in memory as a string starting with a "v"
8580 # If the author of this module made a mistake and wrote a quoted
8581 # "v1.13" instead of v1.13, we simply leave it at that with the
8582 # effect that *we* will treat it like a v-tring while the rest of
8583 # perl won't. Seems sensible when we consider that any action we
8584 # could take now would just add complexity.
8586 $have = CPAN::Version->readable($have);
8588 $have =~ s/\s*//g; # stringify to float around floating point issues
8589 $have; # no stringify needed, \s* above matches always
8602 CPAN - query, download and build perl modules from CPAN sites
8608 perl -MCPAN -e shell;
8616 cpan> install Acme::Meta # in the shell
8618 CPAN::Shell->install("Acme::Meta"); # in perl
8622 cpan> install NWCLARK/Acme-Meta-0.02.tar.gz # in the shell
8625 install("NWCLARK/Acme-Meta-0.02.tar.gz"); # in perl
8629 $mo = CPAN::Shell->expandany($mod);
8630 $mo = CPAN::Shell->expand("Module",$mod); # same thing
8632 # distribution objects:
8634 $do = CPAN::Shell->expand("Module",$mod)->distribution;
8635 $do = CPAN::Shell->expandany($distro); # same thing
8636 $do = CPAN::Shell->expand("Distribution",
8637 $distro); # same thing
8641 This module and its competitor, the CPANPLUS module, are both much
8642 cooler than the other.
8644 =head1 COMPATIBILITY
8646 CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
8647 newer versions. It is getting more and more difficult to get the
8648 minimal prerequisites working on older perls. It is close to
8649 impossible to get the whole Bundle::CPAN working there. If you're in
8650 the position to have only these old versions, be advised that CPAN is
8651 designed to work fine without the Bundle::CPAN installed.
8653 To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
8654 compatible with ancient perls and that File::Temp is listed as a
8655 prerequisite but CPAN has reasonable workarounds if it is missing.
8659 The CPAN module is designed to automate the make and install of perl
8660 modules and extensions. It includes some primitive searching
8661 capabilities and knows how to use Net::FTP or LWP (or some external
8662 download clients) to fetch the raw data from the net.
8664 Modules are fetched from one or more of the mirrored CPAN
8665 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
8668 The CPAN module also supports the concept of named and versioned
8669 I<bundles> of modules. Bundles simplify the handling of sets of
8670 related modules. See Bundles below.
8672 The package contains a session manager and a cache manager. There is
8673 no status retained between sessions. The session manager keeps track
8674 of what has been fetched, built and installed in the current
8675 session. The cache manager keeps track of the disk space occupied by
8676 the make processes and deletes excess space according to a simple FIFO
8679 All methods provided are accessible in a programmer style and in an
8680 interactive shell style.
8682 =head2 CPAN::shell([$prompt, $command]) Starting Interactive Mode
8684 The interactive mode is entered by running
8686 perl -MCPAN -e shell
8688 which puts you into a readline interface. You will have the most fun if
8689 you install Term::ReadKey and Term::ReadLine to enjoy both history and
8692 Once you are on the command line, type 'h' and the rest should be
8695 The function call C<shell> takes two optional arguments, one is the
8696 prompt, the second is the default initial command line (the latter
8697 only works if a real ReadLine interface module is installed).
8699 The most common uses of the interactive modes are
8703 =item Searching for authors, bundles, distribution files and modules
8705 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
8706 for each of the four categories and another, C<i> for any of the
8707 mentioned four. Each of the four entities is implemented as a class
8708 with slightly differing methods for displaying an object.
8710 Arguments you pass to these commands are either strings exactly matching
8711 the identification string of an object or regular expressions that are
8712 then matched case-insensitively against various attributes of the
8713 objects. The parser recognizes a regular expression only if you
8714 enclose it between two slashes.
8716 The principle is that the number of found objects influences how an
8717 item is displayed. If the search finds one item, the result is
8718 displayed with the rather verbose method C<as_string>, but if we find
8719 more than one, we display each object with the terse method
8722 =item make, test, install, clean modules or distributions
8724 These commands take any number of arguments and investigate what is
8725 necessary to perform the action. If the argument is a distribution
8726 file name (recognized by embedded slashes), it is processed. If it is
8727 a module, CPAN determines the distribution file in which this module
8728 is included and processes that, following any dependencies named in
8729 the module's META.yml or Makefile.PL (this behavior is controlled by
8730 the configuration parameter C<prerequisites_policy>.)
8732 Any C<make> or C<test> are run unconditionally. An
8734 install <distribution_file>
8736 also is run unconditionally. But for
8740 CPAN checks if an install is actually needed for it and prints
8741 I<module up to date> in the case that the distribution file containing
8742 the module doesn't need to be updated.
8744 CPAN also keeps track of what it has done within the current session
8745 and doesn't try to build a package a second time regardless if it
8746 succeeded or not. The C<force> pragma may precede another command
8747 (currently: C<make>, C<test>, or C<install>) and executes the
8748 command from scratch and tries to continue in case of some errors.
8752 cpan> install OpenGL
8753 OpenGL is up to date.
8754 cpan> force install OpenGL
8757 OpenGL-0.4/COPYRIGHT
8760 The C<notest> pragma may be set to skip the test part in the build
8765 cpan> notest install Tk
8767 A C<clean> command results in a
8771 being executed within the distribution file's working directory.
8773 =item get, readme, perldoc, look module or distribution
8775 C<get> downloads a distribution file without further action. C<readme>
8776 displays the README file of the associated distribution. C<Look> gets
8777 and untars (if not yet done) the distribution file, changes to the
8778 appropriate directory and opens a subshell process in that directory.
8779 C<perldoc> displays the pod documentation of the module in html or
8784 =item ls globbing_expression
8786 The first form lists all distribution files in and below an author's
8787 CPAN directory as they are stored in the CHECKUMS files distributed on
8788 CPAN. The listing goes recursive into all subdirectories.
8790 The second form allows to limit or expand the output with shell
8791 globbing as in the following examples:
8797 The last example is very slow and outputs extra progress indicators
8798 that break the alignment of the result.
8800 Note that globbing only lists directories explicitly asked for, for
8801 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
8802 regarded as a bug and may be changed in future versions.
8806 The C<failed> command reports all distributions that failed on one of
8807 C<make>, C<test> or C<install> for some reason in the currently
8808 running shell session.
8812 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>
8813 (but the directory can be configured via the C<cpan_home> config
8814 variable). The shell is a bit picky if you try to start another CPAN
8815 session. It dies immediately if there is a lockfile and the lock seems
8816 to belong to a running process. In case you want to run a second shell
8817 session, it is probably safest to maintain another directory, say
8818 C<~/.cpan-for-X/> and a C<~/.cpan-for-X/CPAN/MyConfig.pm> that
8819 contains the configuration options. Then you can start the second
8822 perl -I ~/.cpan-for-X -MCPAN::MyConfig -MCPAN -e shell
8826 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
8827 in the cpan-shell it is intended that you can press C<^C> anytime and
8828 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
8829 to clean up and leave the shell loop. You can emulate the effect of a
8830 SIGTERM by sending two consecutive SIGINTs, which usually means by
8831 pressing C<^C> twice.
8833 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
8834 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
8835 Build.PL> subprocess.
8841 The commands that are available in the shell interface are methods in
8842 the package CPAN::Shell. If you enter the shell command, all your
8843 input is split by the Text::ParseWords::shellwords() routine which
8844 acts like most shells do. The first word is being interpreted as the
8845 method to be called and the rest of the words are treated as arguments
8846 to this method. Continuation lines are supported if a line ends with a
8851 C<autobundle> writes a bundle file into the
8852 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
8853 a list of all modules that are both available from CPAN and currently
8854 installed within @INC. The name of the bundle file is based on the
8855 current date and a counter.
8859 This commands provides a statistical overview over recent download
8860 activities. The data for this is collected in the YAML file
8861 C<FTPstats.yml> in your C<cpan_home> directory. If no YAML module is
8862 configured or YAML not installed, then no stats are provided.
8866 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
8867 directory so that you can save your own preferences instead of the
8872 recompile() is a very special command in that it takes no argument and
8873 runs the make/test/install cycle with brute force over all installed
8874 dynamically loadable extensions (aka XS modules) with 'force' in
8875 effect. The primary purpose of this command is to finish a network
8876 installation. Imagine, you have a common source tree for two different
8877 architectures. You decide to do a completely independent fresh
8878 installation. You start on one architecture with the help of a Bundle
8879 file produced earlier. CPAN installs the whole Bundle for you, but
8880 when you try to repeat the job on the second architecture, CPAN
8881 responds with a C<"Foo up to date"> message for all modules. So you
8882 invoke CPAN's recompile on the second architecture and you're done.
8884 Another popular use for C<recompile> is to act as a rescue in case your
8885 perl breaks binary compatibility. If one of the modules that CPAN uses
8886 is in turn depending on binary compatibility (so you cannot run CPAN
8887 commands), then you should try the CPAN::Nox module for recovery.
8889 =head2 report Bundle|Distribution|Module
8891 The C<report> command temporarily turns on the C<test_report> config
8892 variable, then runs the C<force test> command with the given
8893 arguments. The C<force> pragma is used to re-run the tests and repeat
8894 every step that might have failed before.
8896 =head2 upgrade [Module|/Regex/]...
8898 The C<upgrade> command first runs an C<r> command with the given
8899 arguments and then installs the newest versions of all modules that
8900 were listed by that.
8902 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
8904 Although it may be considered internal, the class hierarchy does matter
8905 for both users and programmer. CPAN.pm deals with above mentioned four
8906 classes, and all those classes share a set of methods. A classical
8907 single polymorphism is in effect. A metaclass object registers all
8908 objects of all kinds and indexes them with a string. The strings
8909 referencing objects have a separated namespace (well, not completely
8914 words containing a "/" (slash) Distribution
8915 words starting with Bundle:: Bundle
8916 everything else Module or Author
8918 Modules know their associated Distribution objects. They always refer
8919 to the most recent official release. Developers may mark their releases
8920 as unstable development versions (by inserting an underbar into the
8921 module version number which will also be reflected in the distribution
8922 name when you run 'make dist'), so the really hottest and newest
8923 distribution is not always the default. If a module Foo circulates
8924 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
8925 way to install version 1.23 by saying
8929 This would install the complete distribution file (say
8930 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
8931 like to install version 1.23_90, you need to know where the
8932 distribution file resides on CPAN relative to the authors/id/
8933 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
8934 so you would have to say
8936 install BAR/Foo-1.23_90.tar.gz
8938 The first example will be driven by an object of the class
8939 CPAN::Module, the second by an object of class CPAN::Distribution.
8941 =head2 Integrating local directories
8943 Distribution objects are normally distributions from the CPAN, but
8944 there is a slightly degenerate case for Distribution objects, too,
8945 normally only needed by developers. If a distribution object ends with
8946 a dot or is a dot by itself, then it represents a local directory and
8947 all actions such as C<make>, C<test>, and C<install> are applied
8948 directly to that directory. This gives the command C<cpan .> an
8949 interesting touch: while the normal mantra of installing a CPAN module
8950 without CPAN.pm is one of
8952 perl Makefile.PL perl Build.PL
8953 ( go and get prerequisites )
8955 make test ./Build test
8956 make install ./Build install
8958 the command C<cpan .> does all of this at once. It figures out which
8959 of the two mantras is appropriate, fetches and installs all
8960 prerequisites, cares for them recursively and finally finishes the
8961 installation of the module in the current directory, be it a CPAN
8964 =head1 PROGRAMMER'S INTERFACE
8966 If you do not enter the shell, the available shell commands are both
8967 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
8968 functions in the calling package (C<install(...)>). Before calling low-level
8969 commands it makes sense to initialize components of CPAN you need, e.g.:
8971 CPAN::HandleConfig->load;
8972 CPAN::Shell::setup_output;
8973 CPAN::Index->reload;
8975 High-level commands do such initializations automatically.
8977 There's currently only one class that has a stable interface -
8978 CPAN::Shell. All commands that are available in the CPAN shell are
8979 methods of the class CPAN::Shell. Each of the commands that produce
8980 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
8981 the IDs of all modules within the list.
8985 =item expand($type,@things)
8987 The IDs of all objects available within a program are strings that can
8988 be expanded to the corresponding real objects with the
8989 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
8990 list of CPAN::Module objects according to the C<@things> arguments
8991 given. In scalar context it only returns the first element of the
8994 =item expandany(@things)
8996 Like expand, but returns objects of the appropriate type, i.e.
8997 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
8998 CPAN::Distribution objects for distributions. Note: it does not expand
8999 to CPAN::Author objects.
9001 =item Programming Examples
9003 This enables the programmer to do operations that combine
9004 functionalities that are available in the shell.
9006 # install everything that is outdated on my disk:
9007 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
9009 # install my favorite programs if necessary:
9010 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
9011 CPAN::Shell->install($mod);
9014 # list all modules on my disk that have no VERSION number
9015 for $mod (CPAN::Shell->expand("Module","/./")){
9016 next unless $mod->inst_file;
9017 # MakeMaker convention for undefined $VERSION:
9018 next unless $mod->inst_version eq "undef";
9019 print "No VERSION in ", $mod->id, "\n";
9022 # find out which distribution on CPAN contains a module:
9023 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
9025 Or if you want to write a cronjob to watch The CPAN, you could list
9026 all modules that need updating. First a quick and dirty way:
9028 perl -e 'use CPAN; CPAN::Shell->r;'
9030 If you don't want to get any output in the case that all modules are
9031 up to date, you can parse the output of above command for the regular
9032 expression //modules are up to date// and decide to mail the output
9033 only if it doesn't match. Ick?
9035 If you prefer to do it more in a programmer style in one single
9036 process, maybe something like this suits you better:
9038 # list all modules on my disk that have newer versions on CPAN
9039 for $mod (CPAN::Shell->expand("Module","/./")){
9040 next unless $mod->inst_file;
9041 next if $mod->uptodate;
9042 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
9043 $mod->id, $mod->inst_version, $mod->cpan_version;
9046 If that gives you too much output every day, you maybe only want to
9047 watch for three modules. You can write
9049 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
9051 as the first line instead. Or you can combine some of the above
9054 # watch only for a new mod_perl module
9055 $mod = CPAN::Shell->expand("Module","mod_perl");
9056 exit if $mod->uptodate;
9057 # new mod_perl arrived, let me know all update recommendations
9062 =head2 Methods in the other Classes
9064 The programming interface for the classes CPAN::Module,
9065 CPAN::Distribution, CPAN::Bundle, and CPAN::Author is still considered
9066 beta and partially even alpha. In the following paragraphs only those
9067 methods are documented that have proven useful over a longer time and
9068 thus are unlikely to change.
9072 =item CPAN::Author::as_glimpse()
9074 Returns a one-line description of the author
9076 =item CPAN::Author::as_string()
9078 Returns a multi-line description of the author
9080 =item CPAN::Author::email()
9082 Returns the author's email address
9084 =item CPAN::Author::fullname()
9086 Returns the author's name
9088 =item CPAN::Author::name()
9090 An alias for fullname
9092 =item CPAN::Bundle::as_glimpse()
9094 Returns a one-line description of the bundle
9096 =item CPAN::Bundle::as_string()
9098 Returns a multi-line description of the bundle
9100 =item CPAN::Bundle::clean()
9102 Recursively runs the C<clean> method on all items contained in the bundle.
9104 =item CPAN::Bundle::contains()
9106 Returns a list of objects' IDs contained in a bundle. The associated
9107 objects may be bundles, modules or distributions.
9109 =item CPAN::Bundle::force($method,@args)
9111 Forces CPAN to perform a task that normally would have failed. Force
9112 takes as arguments a method name to be called and any number of
9113 additional arguments that should be passed to the called method. The
9114 internals of the object get the needed changes so that CPAN.pm does
9115 not refuse to take the action. The C<force> is passed recursively to
9116 all contained objects.
9118 =item CPAN::Bundle::get()
9120 Recursively runs the C<get> method on all items contained in the bundle
9122 =item CPAN::Bundle::inst_file()
9124 Returns the highest installed version of the bundle in either @INC or
9125 C<$CPAN::Config->{cpan_home}>. Note that this is different from
9126 CPAN::Module::inst_file.
9128 =item CPAN::Bundle::inst_version()
9130 Like CPAN::Bundle::inst_file, but returns the $VERSION
9132 =item CPAN::Bundle::uptodate()
9134 Returns 1 if the bundle itself and all its members are uptodate.
9136 =item CPAN::Bundle::install()
9138 Recursively runs the C<install> method on all items contained in the bundle
9140 =item CPAN::Bundle::make()
9142 Recursively runs the C<make> method on all items contained in the bundle
9144 =item CPAN::Bundle::readme()
9146 Recursively runs the C<readme> method on all items contained in the bundle
9148 =item CPAN::Bundle::test()
9150 Recursively runs the C<test> method on all items contained in the bundle
9152 =item CPAN::Distribution::as_glimpse()
9154 Returns a one-line description of the distribution
9156 =item CPAN::Distribution::as_string()
9158 Returns a multi-line description of the distribution
9160 =item CPAN::Distribution::author
9162 Returns the CPAN::Author object of the maintainer who uploaded this
9165 =item CPAN::Distribution::clean()
9167 Changes to the directory where the distribution has been unpacked and
9168 runs C<make clean> there.
9170 =item CPAN::Distribution::containsmods()
9172 Returns a list of IDs of modules contained in a distribution file.
9173 Only works for distributions listed in the 02packages.details.txt.gz
9174 file. This typically means that only the most recent version of a
9175 distribution is covered.
9177 =item CPAN::Distribution::cvs_import()
9179 Changes to the directory where the distribution has been unpacked and
9182 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
9186 =item CPAN::Distribution::dir()
9188 Returns the directory into which this distribution has been unpacked.
9190 =item CPAN::Distribution::force($method,@args)
9192 Forces CPAN to perform a task that normally would have failed. Force
9193 takes as arguments a method name to be called and any number of
9194 additional arguments that should be passed to the called method. The
9195 internals of the object get the needed changes so that CPAN.pm does
9196 not refuse to take the action.
9198 =item CPAN::Distribution::get()
9200 Downloads the distribution from CPAN and unpacks it. Does nothing if
9201 the distribution has already been downloaded and unpacked within the
9204 =item CPAN::Distribution::install()
9206 Changes to the directory where the distribution has been unpacked and
9207 runs the external command C<make install> there. If C<make> has not
9208 yet been run, it will be run first. A C<make test> will be issued in
9209 any case and if this fails, the install will be canceled. The
9210 cancellation can be avoided by letting C<force> run the C<install> for
9213 This install method has only the power to install the distribution if
9214 there are no dependencies in the way. To install an object and all of
9215 its dependencies, use CPAN::Shell->install.
9217 Note that install() gives no meaningful return value. See uptodate().
9219 =item CPAN::Distribution::isa_perl()
9221 Returns 1 if this distribution file seems to be a perl distribution.
9222 Normally this is derived from the file name only, but the index from
9223 CPAN can contain a hint to achieve a return value of true for other
9226 =item CPAN::Distribution::look()
9228 Changes to the directory where the distribution has been unpacked and
9229 opens a subshell there. Exiting the subshell returns.
9231 =item CPAN::Distribution::make()
9233 First runs the C<get> method to make sure the distribution is
9234 downloaded and unpacked. Changes to the directory where the
9235 distribution has been unpacked and runs the external commands C<perl
9236 Makefile.PL> or C<perl Build.PL> and C<make> there.
9238 =item CPAN::Distribution::perldoc()
9240 Downloads the pod documentation of the file associated with a
9241 distribution (in html format) and runs it through the external
9242 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
9243 isn't available, it converts it to plain text with external
9244 command html2text and runs it through the pager specified
9245 in C<$CPAN::Config->{pager}>
9247 =item CPAN::Distribution::prefs()
9249 Returns the hash reference from the first matching YAML file that the
9250 user has deposited in the C<prefs_dir/> directory. The first
9251 succeeding match wins. The files in the C<prefs_dir/> are processed
9252 alphabetically and the canonical distroname (e.g.
9253 AUTHOR/Foo-Bar-3.14.tar.gz) is matched against the regular expressions
9254 stored in the $root->{match}{distribution} attribute value.
9255 Additionally all module names contained in a distribution are matched
9256 agains the regular expressions in the $root->{match}{module} attribute
9257 value. The two match values are ANDed together. Each of the two
9258 attributes are optional.
9260 =item CPAN::Distribution::prereq_pm()
9262 Returns the hash reference that has been announced by a distribution
9263 as the merge of the C<requires> element and the C<build_requires>
9264 element of the META.yml or the C<PREREQ_PM> hash in the
9265 C<Makefile.PL>. Note: works only after an attempt has been made to
9266 C<make> the distribution. Returns undef otherwise.
9268 =item CPAN::Distribution::readme()
9270 Downloads the README file associated with a distribution and runs it
9271 through the pager specified in C<$CPAN::Config->{pager}>.
9273 =item CPAN::Distribution::read_yaml()
9275 Returns the content of the META.yml of this distro as a hashref. Note:
9276 works only after an attempt has been made to C<make> the distribution.
9277 Returns undef otherwise. Also returns undef if the content of META.yml
9280 =item CPAN::Distribution::test()
9282 Changes to the directory where the distribution has been unpacked and
9283 runs C<make test> there.
9285 =item CPAN::Distribution::uptodate()
9287 Returns 1 if all the modules contained in the distribution are
9288 uptodate. Relies on containsmods.
9290 =item CPAN::Index::force_reload()
9292 Forces a reload of all indices.
9294 =item CPAN::Index::reload()
9296 Reloads all indices if they have not been read for more than
9297 C<$CPAN::Config->{index_expire}> days.
9299 =item CPAN::InfoObj::dump()
9301 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
9302 inherit this method. It prints the data structure associated with an
9303 object. Useful for debugging. Note: the data structure is considered
9304 internal and thus subject to change without notice.
9306 =item CPAN::Module::as_glimpse()
9308 Returns a one-line description of the module in four columns: The
9309 first column contains the word C<Module>, the second column consists
9310 of one character: an equals sign if this module is already installed
9311 and uptodate, a less-than sign if this module is installed but can be
9312 upgraded, and a space if the module is not installed. The third column
9313 is the name of the module and the fourth column gives maintainer or
9314 distribution information.
9316 =item CPAN::Module::as_string()
9318 Returns a multi-line description of the module
9320 =item CPAN::Module::clean()
9322 Runs a clean on the distribution associated with this module.
9324 =item CPAN::Module::cpan_file()
9326 Returns the filename on CPAN that is associated with the module.
9328 =item CPAN::Module::cpan_version()
9330 Returns the latest version of this module available on CPAN.
9332 =item CPAN::Module::cvs_import()
9334 Runs a cvs_import on the distribution associated with this module.
9336 =item CPAN::Module::description()
9338 Returns a 44 character description of this module. Only available for
9339 modules listed in The Module List (CPAN/modules/00modlist.long.html
9340 or 00modlist.long.txt.gz)
9342 =item CPAN::Module::distribution()
9344 Returns the CPAN::Distribution object that contains the current
9345 version of this module.
9347 =item CPAN::Module::dslip_status()
9349 Returns a hash reference. The keys of the hash are the letters C<D>,
9350 C<S>, C<L>, C<I>, and <P>, for development status, support level,
9351 language, interface and public licence respectively. The data for the
9352 DSLIP status are collected by pause.perl.org when authors register
9353 their namespaces. The values of the 5 hash elements are one-character
9354 words whose meaning is described in the table below. There are also 5
9355 hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
9356 verbose value of the 5 status variables.
9358 Where the 'DSLIP' characters have the following meanings:
9360 D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
9361 i - Idea, listed to gain consensus or as a placeholder
9362 c - under construction but pre-alpha (not yet released)
9363 a/b - Alpha/Beta testing
9365 M - Mature (no rigorous definition)
9366 S - Standard, supplied with Perl 5
9371 u - Usenet newsgroup comp.lang.perl.modules
9372 n - None known, try comp.lang.perl.modules
9373 a - abandoned; volunteers welcome to take over maintainance
9376 p - Perl-only, no compiler needed, should be platform independent
9377 c - C and perl, a C compiler will be needed
9378 h - Hybrid, written in perl with optional C code, no compiler needed
9379 + - C++ and perl, a C++ compiler will be needed
9380 o - perl and another language other than C or C++
9383 f - plain Functions, no references used
9384 h - hybrid, object and function interfaces available
9385 n - no interface at all (huh?)
9386 r - some use of unblessed References or ties
9387 O - Object oriented using blessed references and/or inheritance
9390 p - Standard-Perl: user may choose between GPL and Artistic
9391 g - GPL: GNU General Public License
9392 l - LGPL: "GNU Lesser General Public License" (previously known as
9393 "GNU Library General Public License")
9394 b - BSD: The BSD License
9395 a - Artistic license alone
9396 o - open source: appoved by www.opensource.org
9397 d - allows distribution without restrictions
9398 r - restricted distribtion
9399 n - no license at all
9401 =item CPAN::Module::force($method,@args)
9403 Forces CPAN to perform a task that normally would have failed. Force
9404 takes as arguments a method name to be called and any number of
9405 additional arguments that should be passed to the called method. The
9406 internals of the object get the needed changes so that CPAN.pm does
9407 not refuse to take the action.
9409 =item CPAN::Module::get()
9411 Runs a get on the distribution associated with this module.
9413 =item CPAN::Module::inst_file()
9415 Returns the filename of the module found in @INC. The first file found
9416 is reported just like perl itself stops searching @INC when it finds a
9419 =item CPAN::Module::inst_version()
9421 Returns the version number of the module in readable format.
9423 =item CPAN::Module::install()
9425 Runs an C<install> on the distribution associated with this module.
9427 =item CPAN::Module::look()
9429 Changes to the directory where the distribution associated with this
9430 module has been unpacked and opens a subshell there. Exiting the
9433 =item CPAN::Module::make()
9435 Runs a C<make> on the distribution associated with this module.
9437 =item CPAN::Module::manpage_headline()
9439 If module is installed, peeks into the module's manpage, reads the
9440 headline and returns it. Moreover, if the module has been downloaded
9441 within this session, does the equivalent on the downloaded module even
9442 if it is not installed.
9444 =item CPAN::Module::perldoc()
9446 Runs a C<perldoc> on this module.
9448 =item CPAN::Module::readme()
9450 Runs a C<readme> on the distribution associated with this module.
9452 =item CPAN::Module::test()
9454 Runs a C<test> on the distribution associated with this module.
9456 =item CPAN::Module::uptodate()
9458 Returns 1 if the module is installed and up-to-date.
9460 =item CPAN::Module::userid()
9462 Returns the author's ID of the module.
9466 =head2 Cache Manager
9468 Currently the cache manager only keeps track of the build directory
9469 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
9470 deletes complete directories below C<build_dir> as soon as the size of
9471 all directories there gets bigger than $CPAN::Config->{build_cache}
9472 (in MB). The contents of this cache may be used for later
9473 re-installations that you intend to do manually, but will never be
9474 trusted by CPAN itself. This is due to the fact that the user might
9475 use these directories for building modules on different architectures.
9477 There is another directory ($CPAN::Config->{keep_source_where}) where
9478 the original distribution files are kept. This directory is not
9479 covered by the cache manager and must be controlled by the user. If
9480 you choose to have the same directory as build_dir and as
9481 keep_source_where directory, then your sources will be deleted with
9482 the same fifo mechanism.
9486 A bundle is just a perl module in the namespace Bundle:: that does not
9487 define any functions or methods. It usually only contains documentation.
9489 It starts like a perl module with a package declaration and a $VERSION
9490 variable. After that the pod section looks like any other pod with the
9491 only difference being that I<one special pod section> exists starting with
9496 In this pod section each line obeys the format
9498 Module_Name [Version_String] [- optional text]
9500 The only required part is the first field, the name of a module
9501 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
9502 of the line is optional. The comment part is delimited by a dash just
9503 as in the man page header.
9505 The distribution of a bundle should follow the same convention as
9506 other distributions.
9508 Bundles are treated specially in the CPAN package. If you say 'install
9509 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
9510 the modules in the CONTENTS section of the pod. You can install your
9511 own Bundles locally by placing a conformant Bundle file somewhere into
9512 your @INC path. The autobundle() command which is available in the
9513 shell interface does that for you by including all currently installed
9514 modules in a snapshot bundle file.
9516 =head1 PREREQUISITES
9518 If you have a local mirror of CPAN and can access all files with
9519 "file:" URLs, then you only need a perl better than perl5.003 to run
9520 this module. Otherwise Net::FTP is strongly recommended. LWP may be
9521 required for non-UNIX systems or if your nearest CPAN site is
9522 associated with a URL that is not C<ftp:>.
9524 If you have neither Net::FTP nor LWP, there is a fallback mechanism
9525 implemented for an external ftp command or for an external lynx
9530 =head2 Finding packages and VERSION
9532 This module presumes that all packages on CPAN
9538 declare their $VERSION variable in an easy to parse manner. This
9539 prerequisite can hardly be relaxed because it consumes far too much
9540 memory to load all packages into the running program just to determine
9541 the $VERSION variable. Currently all programs that are dealing with
9542 version use something like this
9544 perl -MExtUtils::MakeMaker -le \
9545 'print MM->parse_version(shift)' filename
9547 If you are author of a package and wonder if your $VERSION can be
9548 parsed, please try the above method.
9552 come as compressed or gzipped tarfiles or as zip files and contain a
9553 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
9554 without much enthusiasm).
9560 The debugging of this module is a bit complex, because we have
9561 interferences of the software producing the indices on CPAN, of the
9562 mirroring process on CPAN, of packaging, of configuration, of
9563 synchronicity, and of bugs within CPAN.pm.
9565 For debugging the code of CPAN.pm itself in interactive mode some more
9566 or less useful debugging aid can be turned on for most packages within
9571 =item o debug package...
9573 sets debug mode for packages.
9575 =item o debug -package...
9577 unsets debug mode for packages.
9581 turns debugging on for all packages.
9583 =item o debug number
9587 which sets the debugging packages directly. Note that C<o debug 0>
9588 turns debugging off.
9590 What seems quite a successful strategy is the combination of C<reload
9591 cpan> and the debugging switches. Add a new debug statement while
9592 running in the shell and then issue a C<reload cpan> and see the new
9593 debugging messages immediately without losing the current context.
9595 C<o debug> without an argument lists the valid package names and the
9596 current set of packages in debugging mode. C<o debug> has built-in
9599 For debugging of CPAN data there is the C<dump> command which takes
9600 the same arguments as make/test/install and outputs each object's
9601 Data::Dumper dump. If an argument looks like a perl variable and
9602 contains one of C<$>, C<@> or C<%>, it is eval()ed and fed to
9603 Data::Dumper directly.
9605 =head2 Floppy, Zip, Offline Mode
9607 CPAN.pm works nicely without network too. If you maintain machines
9608 that are not networked at all, you should consider working with file:
9609 URLs. Of course, you have to collect your modules somewhere first. So
9610 you might use CPAN.pm to put together all you need on a networked
9611 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
9612 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
9613 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
9614 with this floppy. See also below the paragraph about CD-ROM support.
9616 =head2 Basic Utilities for Programmers
9620 =item has_inst($module)
9622 Returns true if the module is installed. See the source for details.
9624 =item has_usable($module)
9626 Returns true if the module is installed and several and is in a usable
9627 state. Only useful for a handful of modules that are used internally.
9628 See the source for details.
9630 =item instance($module)
9632 The constructor for all the singletons used to represent modules,
9633 distributions, authors and bundles. If the object already exists, this
9634 method returns the object, otherwise it calls the constructor.
9638 =head1 CONFIGURATION
9640 When the CPAN module is used for the first time, a configuration
9641 dialog tries to determine a couple of site specific options. The
9642 result of the dialog is stored in a hash reference C< $CPAN::Config >
9643 in a file CPAN/Config.pm.
9645 The default values defined in the CPAN/Config.pm file can be
9646 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
9647 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
9648 added to the search path of the CPAN module before the use() or
9649 require() statements. The mkmyconfig command writes this file for you.
9651 The C<o conf> command has various bells and whistles:
9655 =item completion support
9657 If you have a ReadLine module installed, you can hit TAB at any point
9658 of the commandline and C<o conf> will offer you completion for the
9659 built-in subcommands and/or config variable names.
9661 =item displaying some help: o conf help
9663 Displays a short help
9665 =item displaying current values: o conf [KEY]
9667 Displays the current value(s) for this config variable. Without KEY
9668 displays all subcommands and config variables.
9674 =item changing of scalar values: o conf KEY VALUE
9676 Sets the config variable KEY to VALUE. The empty string can be
9677 specified as usual in shells, with C<''> or C<"">
9681 o conf wget /usr/bin/wget
9683 =item changing of list values: o conf KEY SHIFT|UNSHIFT|PUSH|POP|SPLICE|LIST
9685 If a config variable name ends with C<list>, it is a list. C<o conf
9686 KEY shift> removes the first element of the list, C<o conf KEY pop>
9687 removes the last element of the list. C<o conf KEYS unshift LIST>
9688 prepends a list of values to the list, C<o conf KEYS push LIST>
9689 appends a list of valued to the list.
9691 Likewise, C<o conf KEY splice LIST> passes the LIST to the according
9694 Finally, any other list of arguments is taken as a new list value for
9695 the KEY variable discarding the previous value.
9699 o conf urllist unshift http://cpan.dev.local/CPAN
9700 o conf urllist splice 3 1
9701 o conf urllist http://cpan1.local http://cpan2.local ftp://ftp.perl.org
9703 =item interactive editing: o conf init [MATCH|LIST]
9705 Runs an interactive configuration dialog for matching variables.
9706 Without argument runs the dialog over all supported config variables.
9707 To specify a MATCH the argument must be enclosed by slashes.
9711 o conf init ftp_passive ftp_proxy
9714 =item reverting to saved: o conf defaults
9716 Reverts all config variables to the state in the saved config file.
9718 =item saving the config: o conf commit
9720 Saves all config variables to the current config file (CPAN/Config.pm
9721 or CPAN/MyConfig.pm that was loaded at start).
9725 The configuration dialog can be started any time later again by
9726 issuing the command C< o conf init > in the CPAN shell. A subset of
9727 the configuration dialog can be run by issuing C<o conf init WORD>
9728 where WORD is any valid config variable or a regular expression.
9730 =head2 Config Variables
9732 Currently the following keys in the hash reference $CPAN::Config are
9735 build_cache size of cache for directories to build modules
9736 build_dir locally accessible directory to build modules
9737 build_dir_reuse boolean if distros in build_dir are persistent
9738 build_requires_install_policy
9739 to install or not to install: when a module is
9740 only needed for building. yes|no|ask/yes|ask/no
9741 bzip2 path to external prg
9742 cache_metadata use serializer to cache metadata
9743 commands_quote prefered character to use for quoting external
9744 commands when running them. Defaults to double
9745 quote on Windows, single tick everywhere else;
9746 can be set to space to disable quoting
9747 check_sigs if signatures should be verified
9748 colorize_output boolean if Term::ANSIColor should colorize output
9749 colorize_print Term::ANSIColor attributes for normal output
9750 colorize_warn Term::ANSIColor attributes for warnings
9751 commandnumber_in_prompt
9752 boolean if you want to see current command number
9753 cpan_home local directory reserved for this package
9754 curl path to external prg
9755 dontload_hash DEPRECATED
9756 dontload_list arrayref: modules in the list will not be
9757 loaded by the CPAN::has_inst() routine
9758 ftp path to external prg
9759 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
9760 ftp_proxy proxy host for ftp requests
9762 gpg path to external prg
9763 gzip location of external program gzip
9764 histfile file to maintain history between sessions
9765 histsize maximum number of lines to keep in histfile
9766 http_proxy proxy host for http requests
9767 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
9768 after this many seconds inactivity. Set to 0 to
9770 index_expire after this many days refetch index files
9771 inhibit_startup_message
9772 if true, does not print the startup message
9773 keep_source_where directory in which to keep the source (if we do)
9774 lynx path to external prg
9775 make location of external make program
9776 make_arg arguments that should always be passed to 'make'
9777 make_install_make_command
9778 the make command for running 'make install', for
9780 make_install_arg same as make_arg for 'make install'
9781 makepl_arg arguments passed to 'perl Makefile.PL'
9782 mbuild_arg arguments passed to './Build'
9783 mbuild_install_arg arguments passed to './Build install'
9784 mbuild_install_build_command
9785 command to use instead of './Build' when we are
9786 in the install stage, for example 'sudo ./Build'
9787 mbuildpl_arg arguments passed to 'perl Build.PL'
9788 ncftp path to external prg
9789 ncftpget path to external prg
9790 no_proxy don't proxy to these hosts/domains (comma separated list)
9791 pager location of external program more (or any pager)
9792 password your password if you CPAN server wants one
9793 patch path to external prg
9794 prefer_installer legal values are MB and EUMM: if a module comes
9795 with both a Makefile.PL and a Build.PL, use the
9796 former (EUMM) or the latter (MB); if the module
9797 comes with only one of the two, that one will be
9799 prerequisites_policy
9800 what to do if you are missing module prerequisites
9801 ('follow' automatically, 'ask' me, or 'ignore')
9802 prefs_dir local directory to store per-distro build options
9803 proxy_user username for accessing an authenticating proxy
9804 proxy_pass password for accessing an authenticating proxy
9805 randomize_urllist add some randomness to the sequence of the urllist
9806 scan_cache controls scanning of cache ('atstart' or 'never')
9807 shell your favorite shell
9808 show_upload_date boolean if commands should try to determine upload date
9809 tar location of external program tar
9810 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
9811 (and nonsense for characters outside latin range)
9812 term_ornaments boolean to turn ReadLine ornamenting on/off
9813 test_report email test reports (if CPAN::Reporter is installed)
9814 unzip location of external program unzip
9815 urllist arrayref to nearby CPAN sites (or equivalent locations)
9816 username your username if you CPAN server wants one
9817 wait_list arrayref to a wait server to try (See CPAN::WAIT)
9818 wget path to external prg
9819 yaml_module which module to use to read/write YAML files
9821 You can set and query each of these options interactively in the cpan
9822 shell with the command set defined within the C<o conf> command:
9826 =item C<o conf E<lt>scalar optionE<gt>>
9828 prints the current value of the I<scalar option>
9830 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
9832 Sets the value of the I<scalar option> to I<value>
9834 =item C<o conf E<lt>list optionE<gt>>
9836 prints the current value of the I<list option> in MakeMaker's
9839 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
9841 shifts or pops the array in the I<list option> variable
9843 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
9845 works like the corresponding perl commands.
9849 =head2 CPAN::anycwd($path): Note on config variable getcwd
9851 CPAN.pm changes the current working directory often and needs to
9852 determine its own current working directory. Per default it uses
9853 Cwd::cwd but if this doesn't work on your system for some reason,
9854 alternatives can be configured according to the following table:
9872 Calls the external command cwd.
9876 =head2 Note on the format of the urllist parameter
9878 urllist parameters are URLs according to RFC 1738. We do a little
9879 guessing if your URL is not compliant, but if you have problems with
9880 C<file> URLs, please try the correct format. Either:
9882 file://localhost/whatever/ftp/pub/CPAN/
9886 file:///home/ftp/pub/CPAN/
9888 =head2 urllist parameter has CD-ROM support
9890 The C<urllist> parameter of the configuration table contains a list of
9891 URLs that are to be used for downloading. If the list contains any
9892 C<file> URLs, CPAN always tries to get files from there first. This
9893 feature is disabled for index files. So the recommendation for the
9894 owner of a CD-ROM with CPAN contents is: include your local, possibly
9895 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
9897 o conf urllist push file://localhost/CDROM/CPAN
9899 CPAN.pm will then fetch the index files from one of the CPAN sites
9900 that come at the beginning of urllist. It will later check for each
9901 module if there is a local copy of the most recent version.
9903 Another peculiarity of urllist is that the site that we could
9904 successfully fetch the last file from automatically gets a preference
9905 token and is tried as the first site for the next request. So if you
9906 add a new site at runtime it may happen that the previously preferred
9907 site will be tried another time. This means that if you want to disallow
9908 a site for the next transfer, it must be explicitly removed from
9911 =head2 Maintaining the urllist parameter
9913 If you have YAML.pm (or some other YAML module configured in
9914 C<yaml_module>) installed, CPAN.pm collects a few statistical data
9915 about recent downloads. You can view the statistics with the C<hosts>
9916 command or inspect them directly by looking into the C<FTPstats.yml>
9917 file in your C<cpan_home> directory.
9919 To get some interesting statistics it is recommended to set the
9920 C<randomize_urllist> parameter that introduces some amount of
9921 randomness into the URL selection.
9923 =head2 prefs_dir for avoiding interactive questions (ALPHA)
9925 (B<Note:> This feature has been introduced in CPAN.pm 1.8854 and is
9926 still considered experimental and may still be changed)
9928 The files in the directory specified in C<prefs_dir> are YAML files
9929 that specify how CPAN.pm shall treat distributions that deviate from
9930 the normal non-interactive model of building and installing CPAN
9933 Some modules try to get some data from the user interactively thus
9934 disturbing the installation of large bundles like Phalanx100 or
9935 modules like Plagger.
9937 CPAN.pm can use YAML files to either pass additional arguments to one
9938 of the four commands, set environment variables or instantiate an
9939 Expect object that reads from the console and enters answers on your
9940 behalf (latter option requires Expect.pm installed). A further option
9941 is to apply patches from the local disk or from CPAN.
9943 CPAN.pm comes with a couple of such YAML files. The structure is
9944 currently not documented because in flux. Please see the distroprefs
9945 directory of the CPAN distribution for examples and follow the README
9948 Please note that setting the environment variable PERL_MM_USE_DEFAULT
9949 to a true value can also get you a long way if you want to always pick
9950 the default answers. But this only works if the author of a package
9951 used the prompt function provided by ExtUtils::MakeMaker and if the
9952 defaults are OK for you.
9956 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
9957 install foreign, unmasked, unsigned code on your machine. We compare
9958 to a checksum that comes from the net just as the distribution file
9959 itself. But we try to make it easy to add security on demand:
9961 =head2 Cryptographically signed modules
9963 Since release 1.77 CPAN.pm has been able to verify cryptographically
9964 signed module distributions using Module::Signature. The CPAN modules
9965 can be signed by their authors, thus giving more security. The simple
9966 unsigned MD5 checksums that were used before by CPAN protect mainly
9967 against accidental file corruption.
9969 You will need to have Module::Signature installed, which in turn
9970 requires that you have at least one of Crypt::OpenPGP module or the
9971 command-line F<gpg> tool installed.
9973 You will also need to be able to connect over the Internet to the public
9974 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
9976 The configuration parameter check_sigs is there to turn signature
9981 Most functions in package CPAN are exported per default. The reason
9982 for this is that the primary use is intended for the cpan shell or for
9987 When the CPAN shell enters a subshell via the look command, it sets
9988 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
9991 When the config variable ftp_passive is set, all downloads will be run
9992 with the environment variable FTP_PASSIVE set to this value. This is
9993 in general a good idea as it influences both Net::FTP and LWP based
9994 connections. The same effect can be achieved by starting the cpan
9995 shell with this environment variable set. For Net::FTP alone, one can
9996 also always set passive mode by running libnetcfg.
9998 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
10000 Populating a freshly installed perl with my favorite modules is pretty
10001 easy if you maintain a private bundle definition file. To get a useful
10002 blueprint of a bundle definition file, the command autobundle can be used
10003 on the CPAN shell command line. This command writes a bundle definition
10004 file for all modules that are installed for the currently running perl
10005 interpreter. It's recommended to run this command only once and from then
10006 on maintain the file manually under a private name, say
10007 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
10009 cpan> install Bundle::my_bundle
10011 then answer a few questions and then go out for a coffee.
10013 Maintaining a bundle definition file means keeping track of two
10014 things: dependencies and interactivity. CPAN.pm sometimes fails on
10015 calculating dependencies because not all modules define all MakeMaker
10016 attributes correctly, so a bundle definition file should specify
10017 prerequisites as early as possible. On the other hand, it's a bit
10018 annoying that many distributions need some interactive configuring. So
10019 what I try to accomplish in my private bundle file is to have the
10020 packages that need to be configured early in the file and the gentle
10021 ones later, so I can go out after a few minutes and leave CPAN.pm
10024 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
10026 Thanks to Graham Barr for contributing the following paragraphs about
10027 the interaction between perl, and various firewall configurations. For
10028 further information on firewalls, it is recommended to consult the
10029 documentation that comes with the ncftp program. If you are unable to
10030 go through the firewall with a simple Perl setup, it is very likely
10031 that you can configure ncftp so that it works for your firewall.
10033 =head2 Three basic types of firewalls
10035 Firewalls can be categorized into three basic types.
10039 =item http firewall
10041 This is where the firewall machine runs a web server and to access the
10042 outside world you must do it via the web server. If you set environment
10043 variables like http_proxy or ftp_proxy to a values beginning with http://
10044 or in your web browser you have to set proxy information then you know
10045 you are running an http firewall.
10047 To access servers outside these types of firewalls with perl (even for
10048 ftp) you will need to use LWP.
10052 This where the firewall machine runs an ftp server. This kind of
10053 firewall will only let you access ftp servers outside the firewall.
10054 This is usually done by connecting to the firewall with ftp, then
10055 entering a username like "user@outside.host.com"
10057 To access servers outside these type of firewalls with perl you
10058 will need to use Net::FTP.
10060 =item One way visibility
10062 I say one way visibility as these firewalls try to make themselves look
10063 invisible to the users inside the firewall. An FTP data connection is
10064 normally created by sending the remote server your IP address and then
10065 listening for the connection. But the remote server will not be able to
10066 connect to you because of the firewall. So for these types of firewall
10067 FTP connections need to be done in a passive mode.
10069 There are two that I can think off.
10075 If you are using a SOCKS firewall you will need to compile perl and link
10076 it with the SOCKS library, this is what is normally called a 'socksified'
10077 perl. With this executable you will be able to connect to servers outside
10078 the firewall as if it is not there.
10080 =item IP Masquerade
10082 This is the firewall implemented in the Linux kernel, it allows you to
10083 hide a complete network behind one IP address. With this firewall no
10084 special compiling is needed as you can access hosts directly.
10086 For accessing ftp servers behind such firewalls you usually need to
10087 set the environment variable C<FTP_PASSIVE> or the config variable
10088 ftp_passive to a true value.
10094 =head2 Configuring lynx or ncftp for going through a firewall
10096 If you can go through your firewall with e.g. lynx, presumably with a
10099 /usr/local/bin/lynx -pscott:tiger
10101 then you would configure CPAN.pm with the command
10103 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
10105 That's all. Similarly for ncftp or ftp, you would configure something
10108 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
10110 Your mileage may vary...
10118 I installed a new version of module X but CPAN keeps saying,
10119 I have the old version installed
10121 Most probably you B<do> have the old version installed. This can
10122 happen if a module installs itself into a different directory in the
10123 @INC path than it was previously installed. This is not really a
10124 CPAN.pm problem, you would have the same problem when installing the
10125 module manually. The easiest way to prevent this behaviour is to add
10126 the argument C<UNINST=1> to the C<make install> call, and that is why
10127 many people add this argument permanently by configuring
10129 o conf make_install_arg UNINST=1
10133 So why is UNINST=1 not the default?
10135 Because there are people who have their precise expectations about who
10136 may install where in the @INC path and who uses which @INC array. In
10137 fine tuned environments C<UNINST=1> can cause damage.
10141 I want to clean up my mess, and install a new perl along with
10142 all modules I have. How do I go about it?
10144 Run the autobundle command for your old perl and optionally rename the
10145 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
10146 with the Configure option prefix, e.g.
10148 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
10150 Install the bundle file you produced in the first step with something like
10152 cpan> install Bundle::mybundle
10158 When I install bundles or multiple modules with one command
10159 there is too much output to keep track of.
10161 You may want to configure something like
10163 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
10164 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
10166 so that STDOUT is captured in a file for later inspection.
10171 I am not root, how can I install a module in a personal directory?
10173 First of all, you will want to use your own configuration, not the one
10174 that your root user installed. If you do not have permission to write
10175 in the cpan directory that root has configured, you will be asked if
10176 you want to create your own config. Answering "yes" will bring you into
10177 CPAN's configuration stage, using the system config for all defaults except
10178 things that have to do with CPAN's work directory, saving your choices to
10179 your MyConfig.pm file.
10181 You can also manually initiate this process with the following command:
10183 % perl -MCPAN -e 'mkmyconfig'
10189 from the CPAN shell.
10191 You will most probably also want to configure something like this:
10193 o conf makepl_arg "LIB=~/myperl/lib \
10194 INSTALLMAN1DIR=~/myperl/man/man1 \
10195 INSTALLMAN3DIR=~/myperl/man/man3"
10197 You can make this setting permanent like all C<o conf> settings with
10200 You will have to add ~/myperl/man to the MANPATH environment variable
10201 and also tell your perl programs to look into ~/myperl/lib, e.g. by
10204 use lib "$ENV{HOME}/myperl/lib";
10206 or setting the PERL5LIB environment variable.
10208 While we're speaking about $ENV{HOME}, it might be worth mentioning,
10209 that for Windows we use the File::HomeDir module that provides an
10210 equivalent to the concept of the home directory on Unix.
10212 Another thing you should bear in mind is that the UNINST parameter can
10213 be dnagerous when you are installing into a private area because you
10214 might accidentally remove modules that other people depend on that are
10215 not using the private area.
10219 How to get a package, unwrap it, and make a change before building it?
10221 Have a look at the C<look> (!) command.
10225 I installed a Bundle and had a couple of fails. When I
10226 retried, everything resolved nicely. Can this be fixed to work
10229 The reason for this is that CPAN does not know the dependencies of all
10230 modules when it starts out. To decide about the additional items to
10231 install, it just uses data found in the META.yml file or the generated
10232 Makefile. An undetected missing piece breaks the process. But it may
10233 well be that your Bundle installs some prerequisite later than some
10234 depending item and thus your second try is able to resolve everything.
10235 Please note, CPAN.pm does not know the dependency tree in advance and
10236 cannot sort the queue of things to install in a topologically correct
10237 order. It resolves perfectly well IF all modules declare the
10238 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
10239 the C<requires> stanza of Module::Build. For bundles which fail and
10240 you need to install often, it is recommended to sort the Bundle
10241 definition file manually.
10245 In our intranet we have many modules for internal use. How
10246 can I integrate these modules with CPAN.pm but without uploading
10247 the modules to CPAN?
10249 Have a look at the CPAN::Site module.
10253 When I run CPAN's shell, I get an error message about things in my
10254 /etc/inputrc (or ~/.inputrc) file.
10256 These are readline issues and can only be fixed by studying readline
10257 configuration on your architecture and adjusting the referenced file
10258 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
10259 and edit them. Quite often harmless changes like uppercasing or
10260 lowercasing some arguments solves the problem.
10264 Some authors have strange characters in their names.
10266 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
10267 expecting ISO-8859-1 charset, a converter can be activated by setting
10268 term_is_latin to a true value in your config file. One way of doing so
10271 cpan> o conf term_is_latin 1
10273 If other charset support is needed, please file a bugreport against
10274 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
10275 the support or maybe UTF-8 terminals become widely available.
10279 When an install fails for some reason and then I correct the error
10280 condition and retry, CPAN.pm refuses to install the module, saying
10281 C<Already tried without success>.
10283 Use the force pragma like so
10285 force install Foo::Bar
10287 This does a bit more than really needed because it untars the
10288 distribution again and runs make and test and only then install.
10290 Or, if you find this is too fast and you would prefer to do smaller
10295 first and then continue as always. C<Force get> I<forgets> previous
10302 and then 'make install' directly in the subshell.
10304 Or you leave the CPAN shell and start it again.
10306 For the really curious, by accessing internals directly, you I<could>
10308 !delete CPAN::Shell->expandany("Foo::Bar")->distribution->{install}
10310 but this is neither guaranteed to work in the future nor is it a
10315 How do I install a "DEVELOPER RELEASE" of a module?
10317 By default, CPAN will install the latest non-developer release of a
10318 module. If you want to install a dev release, you have to specify the
10319 partial path starting with the author id to the tarball you wish to
10322 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
10324 Note that you can use the C<ls> command to get this path listed.
10328 How do I install a module and all its dependencies from the commandline,
10329 without being prompted for anything, despite my CPAN configuration
10332 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
10333 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
10334 asked any questions at all (assuming the modules you are installing are
10335 nice about obeying that variable as well):
10337 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
10341 How do I create a Module::Build based Build.PL derived from an
10342 ExtUtils::MakeMaker focused Makefile.PL?
10344 http://search.cpan.org/search?query=Module::Build::Convert
10346 http://accognoscere.org/papers/perl-module-build-convert/module-build-convert.html
10350 What's the best CPAN site for me?
10352 The urllist config parameter is yours. You can add and remove sites at
10353 will. You should find out which sites have the best uptodateness,
10354 bandwidth, reliability, etc. and are topologically close to you. Some
10355 people prefer fast downloads, others uptodateness, others reliability.
10356 You decide which to try in which order.
10358 Henk P. Penning maintains a site that collects data about CPAN sites:
10360 http://www.cs.uu.nl/people/henkp/mirmon/cpan.html
10366 Please report bugs via http://rt.cpan.org/
10368 Before submitting a bug, please make sure that the traditional method
10369 of building a Perl module package from a shell by following the
10370 installation instructions of that package still works in your
10373 =head1 SECURITY ADVICE
10375 This software enables you to upgrade software on your computer and so
10376 is inherently dangerous because the newly installed software may
10377 contain bugs and may alter the way your computer works or even make it
10378 unusable. Please consider backing up your data before every upgrade.
10382 Andreas Koenig C<< <andk@cpan.org> >>
10386 This program is free software; you can redistribute it and/or
10387 modify it under the same terms as Perl itself.
10389 See L<http://www.perl.com/perl/misc/Artistic.html>
10391 =head1 TRANSLATIONS
10393 Kawai,Takanori provides a Japanese translation of this manpage at
10394 http://member.nifty.ne.jp/hippo2000/perltips/CPAN.htm
10398 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)