1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 $CPAN::VERSION = '1.9203';
5 $CPAN::VERSION = eval $CPAN::VERSION if $CPAN::VERSION =~ /_/;
7 use CPAN::HandleConfig;
12 use CPAN::DeferedCode;
18 use ExtUtils::MakeMaker qw(prompt); # for some unknown reason,
19 # 5.005_04 does not work without
21 use File::Basename ();
29 use Sys::Hostname qw(hostname);
30 use Text::ParseWords ();
33 # we need to run chdir all over and we would get at wrong libraries
36 if (File::Spec->can("rel2abs")) {
38 $inc = File::Spec->rel2abs($inc) unless ref $inc;
44 require Mac::BuildTools if $^O eq 'MacOS';
45 $ENV{PERL5_CPAN_IS_RUNNING}=$$;
46 $ENV{PERL5_CPANPLUS_IS_RUNNING}=$$; # https://rt.cpan.org/Ticket/Display.html?id=23735
48 END { $CPAN::End++; &cleanup; }
51 $CPAN::Frontend ||= "CPAN::Shell";
52 unless (@CPAN::Defaultsites) {
53 @CPAN::Defaultsites = map {
54 CPAN::URL->new(TEXT => $_, FROM => "DEF")
56 "http://www.perl.org/CPAN/",
57 "ftp://ftp.perl.org/pub/CPAN/";
59 # $CPAN::iCwd (i for initial) is going to be initialized during find_perl
60 $CPAN::Perl ||= CPAN::find_perl();
61 $CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
62 $CPAN::Defaultrecent ||= "http://search.cpan.org/uploads.rdf";
63 $CPAN::Defaultrecent ||= "http://cpan.uwinnipeg.ca/htdocs/cpan.xml";
65 # our globals are getting a mess
91 @CPAN::ISA = qw(CPAN::Debug Exporter);
93 # note that these functions live in CPAN::Shell and get executed via
94 # AUTOLOAD when called directly
121 sub soft_chdir_with_alternatives ($);
124 $autoload_recursion ||= 0;
126 #-> sub CPAN::AUTOLOAD ;
128 $autoload_recursion++;
132 warn "Refusing to autoload '$l' while signal pending";
133 $autoload_recursion--;
136 if ($autoload_recursion > 1) {
137 my $fullcommand = join " ", map { "'$_'" } $l, @_;
138 warn "Refusing to autoload $fullcommand in recursion\n";
139 $autoload_recursion--;
143 @export{@EXPORT} = '';
144 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
145 if (exists $export{$l}) {
148 die(qq{Unknown CPAN command "$AUTOLOAD". }.
149 qq{Type ? for help.\n});
151 $autoload_recursion--;
155 #-> sub CPAN::shell ;
158 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
159 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
161 my $oprompt = shift || CPAN::Prompt->new;
162 my $prompt = $oprompt;
163 my $commandline = shift || "";
164 $CPAN::CurrentCommandId ||= 1;
167 unless ($Suppress_readline) {
168 require Term::ReadLine;
171 $term->ReadLine eq "Term::ReadLine::Stub"
173 $term = Term::ReadLine->new('CPAN Monitor');
175 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
176 my $attribs = $term->Attribs;
177 $attribs->{attempted_completion_function} = sub {
178 &CPAN::Complete::gnu_cpl;
181 $readline::rl_completion_function =
182 $readline::rl_completion_function = 'CPAN::Complete::cpl';
184 if (my $histfile = $CPAN::Config->{'histfile'}) {{
185 unless ($term->can("AddHistory")) {
186 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
189 $META->readhist($term,$histfile);
191 for ($CPAN::Config->{term_ornaments}) { # alias
192 local $Term::ReadLine::termcap_nowarn = 1;
193 $term->ornaments($_) if defined;
195 # $term->OUT is autoflushed anyway
196 my $odef = select STDERR;
204 my @cwd = grep { defined $_ and length $_ }
206 File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
207 File::Spec->rootdir();
208 my $try_detect_readline;
209 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
210 unless ($CPAN::Config->{inhibit_startup_message}) {
211 my $rl_avail = $Suppress_readline ? "suppressed" :
212 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
213 "available (maybe install Bundle::CPAN or Bundle::CPANxxl?)";
214 $CPAN::Frontend->myprint(
216 cpan shell -- CPAN exploration and modules installation (v%s)
224 my($continuation) = "";
225 my $last_term_ornaments;
226 SHELLCOMMAND: while () {
227 if ($Suppress_readline) {
228 if ($Echo_readline) {
232 last SHELLCOMMAND unless defined ($_ = <> );
233 if ($Echo_readline) {
234 # backdoor: I could not find a way to record sessions
239 last SHELLCOMMAND unless
240 defined ($_ = $term->readline($prompt, $commandline));
242 $_ = "$continuation$_" if $continuation;
244 next SHELLCOMMAND if /^$/;
246 if (/^(?:q(?:uit)?|bye|exit)$/i) {
257 use vars qw($import_done);
258 CPAN->import(':DEFAULT') unless $import_done++;
259 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
266 eval { @line = Text::ParseWords::shellwords($_) };
267 warn($@), next SHELLCOMMAND if $@;
268 warn("Text::Parsewords could not parse the line [$_]"),
269 next SHELLCOMMAND unless @line;
270 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
271 my $command = shift @line;
272 eval { CPAN::Shell->$command(@line) };
278 my $dv = Dumpvalue->new();
279 Carp::cluck(sprintf "Catching error: %s", $dv->stringify($err));
289 # pragmas for classic commands
298 # only commands that tell us something about failed distros
299 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
301 soft_chdir_with_alternatives(\@cwd);
302 $CPAN::Frontend->myprint("\n");
304 $CPAN::CurrentCommandId++;
308 $commandline = ""; # I do want to be able to pass a default to
309 # shell, but on the second command I see no
312 CPAN::Queue->nullify_queue;
313 if ($try_detect_readline) {
314 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
316 $CPAN::META->has_inst("Term::ReadLine::Perl")
318 delete $INC{"Term/ReadLine.pm"};
320 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
321 require Term::ReadLine;
322 $CPAN::Frontend->myprint("\n$redef subroutines in ".
323 "Term::ReadLine redefined\n");
327 if ($term and $term->can("ornaments")) {
328 for ($CPAN::Config->{term_ornaments}) { # alias
330 if (not defined $last_term_ornaments
331 or $_ != $last_term_ornaments
333 local $Term::ReadLine::termcap_nowarn = 1;
334 $term->ornaments($_);
335 $last_term_ornaments = $_;
338 undef $last_term_ornaments;
342 for my $class (qw(Module Distribution)) {
343 # again unsafe meta access?
344 for my $dm (keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) {
345 next unless $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
346 CPAN->debug("BUG: $class '$dm' was in command state, resetting");
347 delete $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
351 $GOTOSHELL = 0; # not too often
352 $META->savehist if $CPAN::term && $CPAN::term->can("GetHistory");
357 soft_chdir_with_alternatives(\@cwd);
360 sub soft_chdir_with_alternatives ($) {
363 my $root = File::Spec->rootdir();
364 $CPAN::Frontend->mywarn(qq{Warning: no good directory to chdir to!
365 Trying '$root' as temporary haven.
370 if (chdir $cwd->[0]) {
374 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
375 Trying to chdir to "$cwd->[1]" instead.
379 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
387 if ($Config::Config{d_flock}) {
388 return flock $fh, $mode;
389 } elsif (!$Have_warned->{"d_flock"}++) {
390 $CPAN::Frontend->mywarn("Your OS does not support locking; continuing and ignoring all locking issues\n");
391 $CPAN::Frontend->mysleep(5);
398 sub _yaml_module () {
399 my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
401 $yaml_module ne "YAML"
403 !$CPAN::META->has_inst($yaml_module)
405 # $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back to 'YAML'\n");
406 $yaml_module = "YAML";
408 if ($yaml_module eq "YAML"
410 $CPAN::META->has_inst($yaml_module)
412 $YAML::VERSION < 0.60
414 !$Have_warned->{"YAML"}++
416 $CPAN::Frontend->mywarn("Warning: YAML version '$YAML::VERSION' is too low, please upgrade!\n".
417 "I'll continue but problems are *very* likely to happen.\n"
419 $CPAN::Frontend->mysleep(5);
424 # CPAN::_yaml_loadfile
426 my($self,$local_file) = @_;
427 return +[] unless -s $local_file;
428 my $yaml_module = _yaml_module;
429 if ($CPAN::META->has_inst($yaml_module)) {
430 # temporarly enable yaml code deserialisation
432 # 5.6.2 could not do the local() with the reference
433 local $YAML::LoadCode;
434 local $YAML::Syck::LoadCode;
435 ${ "$yaml_module\::LoadCode" } = $CPAN::Config->{yaml_load_code} || 0;
438 if ($code = UNIVERSAL::can($yaml_module, "LoadFile")) {
440 eval { @yaml = $code->($local_file); };
442 # this shall not be done by the frontend
443 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
446 } elsif ($code = UNIVERSAL::can($yaml_module, "Load")) {
448 open FH, $local_file or die "Could not open '$local_file': $!";
452 eval { @yaml = $code->($ystream); };
454 # this shall not be done by the frontend
455 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
460 # this shall not be done by the frontend
461 die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "parse");
466 # CPAN::_yaml_dumpfile
468 my($self,$local_file,@what) = @_;
469 my $yaml_module = _yaml_module;
470 if ($CPAN::META->has_inst($yaml_module)) {
472 if (UNIVERSAL::isa($local_file, "FileHandle")) {
473 $code = UNIVERSAL::can($yaml_module, "Dump");
474 eval { print $local_file $code->(@what) };
475 } elsif ($code = UNIVERSAL::can($yaml_module, "DumpFile")) {
476 eval { $code->($local_file,@what); };
477 } elsif ($code = UNIVERSAL::can($yaml_module, "Dump")) {
479 open FH, ">$local_file" or die "Could not open '$local_file': $!";
480 print FH $code->(@what);
483 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"dump",$@);
486 if (UNIVERSAL::isa($local_file, "FileHandle")) {
487 # I think this case does not justify a warning at all
489 die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "dump");
494 sub _init_sqlite () {
495 unless ($CPAN::META->has_inst("CPAN::SQLite")) {
496 $CPAN::Frontend->mywarn(qq{CPAN::SQLite not installed, trying to work without\n})
497 unless $Have_warned->{"CPAN::SQLite"}++;
500 require CPAN::SQLite::META; # not needed since CVS version of 2006-12-17
501 $CPAN::SQLite ||= CPAN::SQLite::META->new($CPAN::META);
505 my $negative_cache = {};
506 sub _sqlite_running {
507 if ($negative_cache->{time} && time < $negative_cache->{time} + 60) {
508 # need to cache the result, otherwise too slow
509 return $negative_cache->{fact};
511 $negative_cache = {}; # reset
513 my $ret = $CPAN::Config->{use_sqlite} && ($CPAN::SQLite || _init_sqlite());
514 return $ret if $ret; # fast anyway
515 $negative_cache->{time} = time;
516 return $negative_cache->{fact} = $ret;
520 package CPAN::CacheMgr;
522 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
527 use Fcntl qw(:flock);
528 use vars qw($connect_to_internet_ok $Ua $Thesite $ThesiteURL $Themethod);
529 @CPAN::FTP::ISA = qw(CPAN::Debug);
531 package CPAN::LWP::UserAgent;
533 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
534 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
536 package CPAN::Complete;
538 @CPAN::Complete::ISA = qw(CPAN::Debug);
539 # Q: where is the "How do I add a new command" HOWTO?
540 # A: svn diff -r 1048:1049 where andk added the report command
541 @CPAN::Complete::COMMANDS = sort qw(
542 ? ! a b d h i m o q r u
577 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED);
578 @CPAN::Index::ISA = qw(CPAN::Debug);
581 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
584 package CPAN::InfoObj;
586 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
588 package CPAN::Author;
590 @CPAN::Author::ISA = qw(CPAN::InfoObj);
592 package CPAN::Distribution;
594 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
596 package CPAN::Bundle;
598 @CPAN::Bundle::ISA = qw(CPAN::Module);
600 package CPAN::Module;
602 @CPAN::Module::ISA = qw(CPAN::InfoObj);
604 package CPAN::Exception::RecursiveDependency;
606 use overload '""' => "as_string";
608 # a module sees its distribution (no version)
609 # a distribution sees its prereqs (which are module names) (usually with versions)
610 # a bundle sees its module names and/or its distributions (no version)
615 my (@deps,%seen,$loop_starts_with);
616 DCHAIN: for my $dep (@$deps) {
617 push @deps, {name => $dep, display_as => $dep};
619 $loop_starts_with = $dep;
624 for my $i (0..$#deps) {
625 my $x = $deps[$i]{name};
626 $in_loop ||= $x eq $loop_starts_with;
627 my $xo = CPAN::Shell->expandany($x) or next;
628 if ($xo->isa("CPAN::Module")) {
629 my $have = $xo->inst_version || "N/A";
630 my($want,$d,$want_type);
631 if ($i>0 and $d = $deps[$i-1]{name}) {
632 my $do = CPAN::Shell->expandany($d);
633 $want = $do->{prereq_pm}{requires}{$x};
635 $want_type = "requires: ";
637 $want = $do->{prereq_pm}{build_requires}{$x};
639 $want_type = "build_requires: ";
641 $want_type = "unknown status";
646 $want = $xo->cpan_version;
647 $want_type = "want: ";
649 $deps[$i]{have} = $have;
650 $deps[$i]{want_type} = $want_type;
651 $deps[$i]{want} = $want;
652 $deps[$i]{display_as} = "$x (have: $have; $want_type$want)";
653 } elsif ($xo->isa("CPAN::Distribution")) {
654 $deps[$i]{display_as} = $xo->pretty_id;
656 $xo->{make} = CPAN::Distrostatus->new("NO cannot resolve circular dependency");
658 $xo->{make} = CPAN::Distrostatus->new("NO one dependency ($loop_starts_with) is a circular dependency");
660 $xo->store_persistent_state; # otherwise I will not reach
661 # all involved parties for
665 bless { deps => \@deps }, $class;
670 my $ret = "\nRecursive dependency detected:\n ";
671 $ret .= join("\n => ", map {$_->{display_as}} @{$self->{deps}});
672 $ret .= ".\nCannot resolve.\n";
676 package CPAN::Exception::yaml_not_installed;
678 use overload '""' => "as_string";
681 my($class,$module,$file,$during) = @_;
682 bless { module => $module, file => $file, during => $during }, $class;
687 "'$self->{module}' not installed, cannot $self->{during} '$self->{file}'\n";
690 package CPAN::Exception::yaml_process_error;
692 use overload '""' => "as_string";
695 my($class,$module,$file,$during,$error) = @_;
696 bless { module => $module,
699 error => $error }, $class;
704 if ($self->{during}) {
706 if ($self->{module}) {
707 if ($self->{error}) {
708 return "Alert: While trying to '$self->{during}' YAML file\n".
709 " '$self->{file}'\n".
710 "with '$self->{module}' the following error was encountered:\n".
713 return "Alert: While trying to '$self->{during}' YAML file\n".
714 " '$self->{file}'\n".
715 "with '$self->{module}' some unknown error was encountered\n";
718 return "Alert: While trying to '$self->{during}' YAML file\n".
719 " '$self->{file}'\n".
720 "some unknown error was encountered\n";
723 return "Alert: While trying to '$self->{during}' some YAML file\n".
724 "some unknown error was encountered\n";
727 return "Alert: unknown error encountered\n";
731 package CPAN::Prompt; use overload '""' => "as_string";
732 use vars qw($prompt);
734 $CPAN::CurrentCommandId ||= 0;
740 unless ($CPAN::META->{LOCK}) {
741 $word = "nolock_cpan";
743 if ($CPAN::Config->{commandnumber_in_prompt}) {
744 sprintf "$word\[%d]> ", $CPAN::CurrentCommandId;
750 package CPAN::URL; use overload '""' => "as_string", fallback => 1;
751 # accessors: TEXT(the url string), FROM(DEF=>defaultlist,USER=>urllist),
752 # planned are things like age or quality
754 my($class,%args) = @_;
766 $self->{TEXT} = $set;
771 package CPAN::Distrostatus;
772 use overload '""' => "as_string",
775 my($class,$arg) = @_;
778 FAILED => substr($arg,0,2) eq "NO",
779 COMMANDID => $CPAN::CurrentCommandId,
783 sub commandid { shift->{COMMANDID} }
784 sub failed { shift->{FAILED} }
788 $self->{TEXT} = $set;
808 @CPAN::Shell::ISA = qw(CPAN::Debug);
809 $COLOR_REGISTERED ||= 0;
812 '!' => "eval the rest of the line as perl",
814 autobundle => "wtite inventory into a bundle file",
815 b => "info about bundle",
817 clean => "clean up a distribution's build directory",
819 d => "info about a distribution",
822 failed => "list all failed actions within current session",
823 fforce => "redo a command from scratch",
824 force => "redo a command",
826 help => "overview over commands; 'help ...' explains specific commands",
827 hosts => "statistics about recently used hosts",
828 i => "info about authors/bundles/distributions/modules",
829 install => "install a distribution",
830 install_tested => "install all distributions tested OK",
831 is_tested => "list all distributions tested OK",
832 look => "open a subshell in a distribution's directory",
833 ls => "list distributions according to a glob",
834 m => "info about a module",
835 make => "make/build a distribution",
836 mkmyconfig => "write current config into a CPAN/MyConfig.pm file",
837 notest => "run a (usually install) command but leave out the test phase",
838 o => "'o conf ...' for config stuff; 'o debug ...' for debugging",
839 perldoc => "try to get a manpage for a module",
841 quit => "leave the cpan shell",
842 r => "review over upgradeable modules",
843 readme => "display the README of a distro woth a pager",
844 recent => "show recent uploads to the CPAN",
846 reload => "'reload cpan' or 'reload index'",
847 report => "test a distribution and send a test report to cpantesters",
848 reports => "info about reported tests from cpantesters",
851 test => "test a distribution",
852 u => "display uninstalled modules",
853 upgrade => "combine 'r' command with immediate installation",
856 $autoload_recursion ||= 0;
858 #-> sub CPAN::Shell::AUTOLOAD ;
860 $autoload_recursion++;
862 my $class = shift(@_);
863 # warn "autoload[$l] class[$class]";
866 warn "Refusing to autoload '$l' while signal pending";
867 $autoload_recursion--;
870 if ($autoload_recursion > 1) {
871 my $fullcommand = join " ", map { "'$_'" } $l, @_;
872 warn "Refusing to autoload $fullcommand in recursion\n";
873 $autoload_recursion--;
877 # XXX needs to be reconsidered
878 if ($CPAN::META->has_inst('CPAN::WAIT')) {
881 $CPAN::Frontend->mywarn(qq{
882 Commands starting with "w" require CPAN::WAIT to be installed.
883 Please consider installing CPAN::WAIT to use the fulltext index.
884 For this you just need to type
889 $CPAN::Frontend->mywarn(qq{Unknown shell command '$l'. }.
893 $autoload_recursion--;
900 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
902 # from here on only subs.
903 ################################################################################
905 sub _perl_fingerprint {
906 my($self,$other_fingerprint) = @_;
907 my $dll = eval {OS2::DLLname()};
910 $mtime_dll = (-f $dll ? (stat(_))[9] : '-1');
912 my $mtime_perl = (-f $^X ? (stat(_))[9] : '-1');
913 my $this_fingerprint = {
915 sitearchexp => $Config::Config{sitearchexp},
916 'mtime_$^X' => $mtime_perl,
917 'mtime_dll' => $mtime_dll,
919 if ($other_fingerprint) {
920 if (exists $other_fingerprint->{'stat($^X)'}) { # repair fp from rev. 1.88_57
921 $other_fingerprint->{'mtime_$^X'} = $other_fingerprint->{'stat($^X)'}[9];
923 # mandatory keys since 1.88_57
924 for my $key (qw($^X sitearchexp mtime_dll mtime_$^X)) {
925 return unless $other_fingerprint->{$key} eq $this_fingerprint->{$key};
929 return $this_fingerprint;
933 sub suggest_myconfig () {
934 SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
935 $CPAN::Frontend->myprint("You don't seem to have a user ".
936 "configuration (MyConfig.pm) yet.\n");
937 my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ".
938 "user configuration now? (Y/n)",
941 CPAN::Shell->mkmyconfig();
944 $CPAN::Frontend->mydie("OK, giving up.");
949 #-> sub CPAN::all_objects ;
951 my($mgr,$class) = @_;
952 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
953 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
955 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
958 # Called by shell, not in batch mode. In batch mode I see no risk in
959 # having many processes updating something as installations are
960 # continually checked at runtime. In shell mode I suspect it is
961 # unintentional to open more than one shell at a time
963 #-> sub CPAN::checklock ;
966 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
967 if (-f $lockfile && -M _ > 0) {
968 my $fh = FileHandle->new($lockfile) or
969 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
970 my $otherpid = <$fh>;
971 my $otherhost = <$fh>;
973 if (defined $otherpid && $otherpid) {
976 if (defined $otherhost && $otherhost) {
979 my $thishost = hostname();
980 if (defined $otherhost && defined $thishost &&
981 $otherhost ne '' && $thishost ne '' &&
982 $otherhost ne $thishost) {
983 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
984 "reports other host $otherhost and other ".
985 "process $otherpid.\n".
986 "Cannot proceed.\n"));
987 } elsif ($RUN_DEGRADED) {
988 $CPAN::Frontend->mywarn("Running in degraded mode (experimental)\n");
989 } elsif (defined $otherpid && $otherpid) {
990 return if $$ == $otherpid; # should never happen
991 $CPAN::Frontend->mywarn(
993 There seems to be running another CPAN process (pid $otherpid). Contacting...
995 if (kill 0, $otherpid) {
996 $CPAN::Frontend->mywarn(qq{Other job is running.\n});
998 CPAN::Shell::colorable_makemaker_prompt
999 (qq{Shall I try to run in degraded }.
1000 qq{mode? (Y/n)},"y");
1001 if ($ans =~ /^y/i) {
1002 $CPAN::Frontend->mywarn("Running in degraded mode (experimental).
1003 Please report if something unexpected happens\n");
1005 for ($CPAN::Config) {
1007 # $_->{build_dir_reuse} = 0; # 2006-11-17 akoenig Why was that?
1008 $_->{commandnumber_in_prompt} = 0; # visibility
1009 $_->{histfile} = ""; # who should win otherwise?
1010 $_->{cache_metadata} = 0; # better would be a lock?
1011 $_->{use_sqlite} = 0; # better would be a write lock!
1014 $CPAN::Frontend->mydie("
1015 You may want to kill the other job and delete the lockfile. On UNIX try:
1020 } elsif (-w $lockfile) {
1022 CPAN::Shell::colorable_makemaker_prompt
1023 (qq{Other job not responding. Shall I overwrite }.
1024 qq{the lockfile '$lockfile'? (Y/n)},"y");
1025 $CPAN::Frontend->myexit("Ok, bye\n")
1026 unless $ans =~ /^y/i;
1029 qq{Lockfile '$lockfile' not writeable by you. }.
1030 qq{Cannot proceed.\n}.
1031 qq{ On UNIX try:\n}.
1032 qq{ rm '$lockfile'\n}.
1033 qq{ and then rerun us.\n}
1037 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Found invalid lockfile ".
1038 "'$lockfile', please remove. Cannot proceed.\n"));
1041 my $dotcpan = $CPAN::Config->{cpan_home};
1042 eval { File::Path::mkpath($dotcpan);};
1044 # A special case at least for Jarkko.
1045 my $firsterror = $@;
1049 $symlinkcpan = readlink $dotcpan;
1050 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
1051 eval { File::Path::mkpath($symlinkcpan); };
1055 $CPAN::Frontend->mywarn(qq{
1056 Working directory $symlinkcpan created.
1060 unless (-d $dotcpan) {
1062 Your configuration suggests "$dotcpan" as your
1063 CPAN.pm working directory. I could not create this directory due
1064 to this error: $firsterror\n};
1066 As "$dotcpan" is a symlink to "$symlinkcpan",
1067 I tried to create that, but I failed with this error: $seconderror
1070 Please make sure the directory exists and is writable.
1072 $CPAN::Frontend->mywarn($mess);
1073 return suggest_myconfig;
1075 } # $@ after eval mkpath $dotcpan
1076 if (0) { # to test what happens when a race condition occurs
1077 for (reverse 1..10) {
1083 if (!$RUN_DEGRADED && !$self->{LOCKFH}) {
1085 unless ($fh = FileHandle->new("+>>$lockfile")) {
1086 if ($! =~ /Permission/) {
1087 $CPAN::Frontend->mywarn(qq{
1089 Your configuration suggests that CPAN.pm should use a working
1091 $CPAN::Config->{cpan_home}
1092 Unfortunately we could not create the lock file
1094 due to permission problems.
1096 Please make sure that the configuration variable
1097 \$CPAN::Config->{cpan_home}
1098 points to a directory where you can write a .lock file. You can set
1099 this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
1102 return suggest_myconfig;
1106 while (!CPAN::_flock($fh, LOCK_EX|LOCK_NB)) {
1108 $CPAN::Frontend->mydie("Giving up\n");
1110 $CPAN::Frontend->mysleep($sleep++);
1111 $CPAN::Frontend->mywarn("Could not lock lockfile with flock: $!; retrying\n");
1116 $fh->print($$, "\n");
1117 $fh->print(hostname(), "\n");
1118 $self->{LOCK} = $lockfile;
1119 $self->{LOCKFH} = $fh;
1124 $CPAN::Frontend->mydie("Got SIG$sig, leaving");
1129 &cleanup if $Signal;
1130 die "Got yet another signal" if $Signal > 1;
1131 $CPAN::Frontend->mydie("Got another SIG$sig") if $Signal;
1132 $CPAN::Frontend->mywarn("Caught SIG$sig, trying to continue\n");
1136 # From: Larry Wall <larry@wall.org>
1137 # Subject: Re: deprecating SIGDIE
1138 # To: perl5-porters@perl.org
1139 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
1141 # The original intent of __DIE__ was only to allow you to substitute one
1142 # kind of death for another on an application-wide basis without respect
1143 # to whether you were in an eval or not. As a global backstop, it should
1144 # not be used any more lightly (or any more heavily :-) than class
1145 # UNIVERSAL. Any attempt to build a general exception model on it should
1146 # be politely squashed. Any bug that causes every eval {} to have to be
1147 # modified should be not so politely squashed.
1149 # Those are my current opinions. It is also my optinion that polite
1150 # arguments degenerate to personal arguments far too frequently, and that
1151 # when they do, it's because both people wanted it to, or at least didn't
1152 # sufficiently want it not to.
1156 # global backstop to cleanup if we should really die
1157 $SIG{__DIE__} = \&cleanup;
1158 $self->debug("Signal handler set.") if $CPAN::DEBUG;
1161 #-> sub CPAN::DESTROY ;
1163 &cleanup; # need an eval?
1166 #-> sub CPAN::anycwd ;
1169 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
1174 sub cwd {Cwd::cwd();}
1176 #-> sub CPAN::getcwd ;
1177 sub getcwd {Cwd::getcwd();}
1179 #-> sub CPAN::fastcwd ;
1180 sub fastcwd {Cwd::fastcwd();}
1182 #-> sub CPAN::backtickcwd ;
1183 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
1185 #-> sub CPAN::find_perl ;
1187 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
1188 my $pwd = $CPAN::iCwd = CPAN::anycwd();
1189 my $candidate = File::Spec->catfile($pwd,$^X);
1190 $perl ||= $candidate if MM->maybe_command($candidate);
1193 my ($component,$perl_name);
1194 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
1195 PATH_COMPONENT: foreach $component (File::Spec->path(),
1196 $Config::Config{'binexp'}) {
1197 next unless defined($component) && $component;
1198 my($abs) = File::Spec->catfile($component,$perl_name);
1199 if (MM->maybe_command($abs)) {
1211 #-> sub CPAN::exists ;
1213 my($mgr,$class,$id) = @_;
1214 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
1215 CPAN::Index->reload;
1216 ### Carp::croak "exists called without class argument" unless $class;
1218 $id =~ s/:+/::/g if $class eq "CPAN::Module";
1220 if (CPAN::_sqlite_running) {
1221 $exists = (exists $META->{readonly}{$class}{$id} or
1222 $CPAN::SQLite->set($class, $id));
1224 $exists = exists $META->{readonly}{$class}{$id};
1226 $exists ||= exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
1229 #-> sub CPAN::delete ;
1231 my($mgr,$class,$id) = @_;
1232 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
1233 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
1236 #-> sub CPAN::has_usable
1237 # has_inst is sometimes too optimistic, we should replace it with this
1238 # has_usable whenever a case is given
1240 my($self,$mod,$message) = @_;
1241 return 1 if $HAS_USABLE->{$mod};
1242 my $has_inst = $self->has_inst($mod,$message);
1243 return unless $has_inst;
1246 LWP => [ # we frequently had "Can't locate object
1247 # method "new" via package "LWP::UserAgent" at
1248 # (eval 69) line 2006
1250 sub {require LWP::UserAgent},
1251 sub {require HTTP::Request},
1252 sub {require URI::URL},
1255 sub {require Net::FTP},
1256 sub {require Net::Config},
1258 'File::HomeDir' => [
1259 sub {require File::HomeDir;
1260 unless (File::HomeDir::->VERSION >= 0.52) {
1261 for ("Will not use File::HomeDir, need 0.52\n") {
1262 $CPAN::Frontend->mywarn($_);
1269 sub {require Archive::Tar;
1270 unless (Archive::Tar::->VERSION >= 1.00) {
1271 for ("Will not use Archive::Tar, need 1.00\n") {
1272 $CPAN::Frontend->mywarn($_);
1279 if ($usable->{$mod}) {
1280 for my $c (0..$#{$usable->{$mod}}) {
1281 my $code = $usable->{$mod}[$c];
1282 my $ret = eval { &$code() };
1283 $ret = "" unless defined $ret;
1285 # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
1290 return $HAS_USABLE->{$mod} = 1;
1293 #-> sub CPAN::has_inst
1295 my($self,$mod,$message) = @_;
1296 Carp::croak("CPAN->has_inst() called without an argument")
1297 unless defined $mod;
1298 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
1299 keys %{$CPAN::Config->{dontload_hash}||{}},
1300 @{$CPAN::Config->{dontload_list}||[]};
1301 if (defined $message && $message eq "no" # afair only used by Nox
1305 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
1313 # checking %INC is wrong, because $INC{LWP} may be true
1314 # although $INC{"URI/URL.pm"} may have failed. But as
1315 # I really want to say "bla loaded OK", I have to somehow
1317 ### warn "$file in %INC"; #debug
1319 } elsif (eval { require $file }) {
1320 # eval is good: if we haven't yet read the database it's
1321 # perfect and if we have installed the module in the meantime,
1322 # it tries again. The second require is only a NOOP returning
1323 # 1 if we had success, otherwise it's retrying
1325 my $mtime = (stat $INC{$file})[9];
1326 # privileged files loaded by has_inst; Note: we use $mtime
1327 # as a proxy for a checksum.
1328 $CPAN::Shell::reload->{$file} = $mtime;
1329 my $v = eval "\$$mod\::VERSION";
1330 $v = $v ? " (v$v)" : "";
1331 CPAN::Shell->optprint("load_module","CPAN: $mod loaded ok$v\n");
1332 if ($mod eq "CPAN::WAIT") {
1333 push @CPAN::Shell::ISA, 'CPAN::WAIT';
1336 } elsif ($mod eq "Net::FTP") {
1337 $CPAN::Frontend->mywarn(qq{
1338 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
1340 install Bundle::libnet
1342 }) unless $Have_warned->{"Net::FTP"}++;
1343 $CPAN::Frontend->mysleep(3);
1344 } elsif ($mod eq "Digest::SHA") {
1345 if ($Have_warned->{"Digest::SHA"}++) {
1346 $CPAN::Frontend->mywarn(qq{CPAN: checksum security checks disabled }.
1347 qq{because Digest::SHA not installed.\n});
1349 $CPAN::Frontend->mywarn(qq{
1350 CPAN: checksum security checks disabled because Digest::SHA not installed.
1351 Please consider installing the Digest::SHA module.
1354 $CPAN::Frontend->mysleep(2);
1356 } elsif ($mod eq "Module::Signature") {
1357 # NOT prefs_lookup, we are not a distro
1358 my $check_sigs = $CPAN::Config->{check_sigs};
1359 if (not $check_sigs) {
1360 # they do not want us:-(
1361 } elsif (not $Have_warned->{"Module::Signature"}++) {
1362 # No point in complaining unless the user can
1363 # reasonably install and use it.
1364 if (eval { require Crypt::OpenPGP; 1 } ||
1366 defined $CPAN::Config->{'gpg'}
1368 $CPAN::Config->{'gpg'} =~ /\S/
1371 $CPAN::Frontend->mywarn(qq{
1372 CPAN: Module::Signature security checks disabled because Module::Signature
1373 not installed. Please consider installing the Module::Signature module.
1374 You may also need to be able to connect over the Internet to the public
1375 keyservers like pgp.mit.edu (port 11371).
1378 $CPAN::Frontend->mysleep(2);
1382 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
1387 #-> sub CPAN::instance ;
1389 my($mgr,$class,$id) = @_;
1390 CPAN::Index->reload;
1392 # unsafe meta access, ok?
1393 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
1394 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
1402 #-> sub CPAN::cleanup ;
1404 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
1405 local $SIG{__DIE__} = '';
1410 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
1411 $ineval = 1, last if
1412 $subroutine eq '(eval)';
1414 return if $ineval && !$CPAN::End;
1415 return unless defined $META->{LOCK};
1416 return unless -f $META->{LOCK};
1418 close $META->{LOCKFH};
1419 unlink $META->{LOCK};
1421 # Carp::cluck("DEBUGGING");
1422 if ( $CPAN::CONFIG_DIRTY ) {
1423 $CPAN::Frontend->mywarn("Warning: Configuration not saved.\n");
1425 $CPAN::Frontend->myprint("Lockfile removed.\n");
1428 #-> sub CPAN::readhist
1430 my($self,$term,$histfile) = @_;
1431 my($fh) = FileHandle->new;
1432 open $fh, "<$histfile" or last;
1436 $term->AddHistory($_);
1441 #-> sub CPAN::savehist
1444 my($histfile,$histsize);
1445 unless ($histfile = $CPAN::Config->{'histfile'}) {
1446 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
1449 $histsize = $CPAN::Config->{'histsize'} || 100;
1451 unless ($CPAN::term->can("GetHistory")) {
1452 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
1458 my @h = $CPAN::term->GetHistory;
1459 splice @h, 0, @h-$histsize if @h>$histsize;
1460 my($fh) = FileHandle->new;
1461 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
1462 local $\ = local $, = "\n";
1467 #-> sub CPAN::is_tested
1469 my($self,$what,$when) = @_;
1471 Carp::cluck("DEBUG: empty what");
1474 $self->{is_tested}{$what} = $when;
1477 #-> sub CPAN::is_installed
1478 # unsets the is_tested flag: as soon as the thing is installed, it is
1479 # not needed in set_perl5lib anymore
1481 my($self,$what) = @_;
1482 delete $self->{is_tested}{$what};
1485 sub _list_sorted_descending_is_tested {
1488 { ($self->{is_tested}{$b}||0) <=> ($self->{is_tested}{$a}||0) }
1489 keys %{$self->{is_tested}}
1492 #-> sub CPAN::set_perl5lib
1494 my($self,$for) = @_;
1496 (undef,undef,undef,$for) = caller(1);
1499 $self->{is_tested} ||= {};
1500 return unless %{$self->{is_tested}};
1501 my $env = $ENV{PERL5LIB};
1502 $env = $ENV{PERLLIB} unless defined $env;
1504 push @env, $env if defined $env and length $env;
1505 #my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1506 #$CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1508 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} $self->_list_sorted_descending_is_tested;
1510 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB for '$for'\n");
1511 } elsif (@dirs < 24) {
1512 my @d = map {my $cp = $_;
1513 $cp =~ s/^\Q$CPAN::Config->{build_dir}\E/%BUILDDIR%/;
1516 $CPAN::Frontend->myprint("Prepending @d to PERL5LIB; ".
1517 "%BUILDDIR%=$CPAN::Config->{build_dir} ".
1521 my $cnt = keys %{$self->{is_tested}};
1522 $CPAN::Frontend->myprint("Prepending blib/arch and blib/lib of ".
1523 "$cnt build dirs to PERL5LIB; ".
1528 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1531 package CPAN::CacheMgr;
1534 #-> sub CPAN::CacheMgr::as_string ;
1536 eval { require Data::Dumper };
1538 return shift->SUPER::as_string;
1540 return Data::Dumper::Dumper(shift);
1544 #-> sub CPAN::CacheMgr::cachesize ;
1549 #-> sub CPAN::CacheMgr::tidyup ;
1552 return unless $CPAN::META->{LOCK};
1553 return unless -d $self->{ID};
1554 my @toremove = grep { $self->{SIZE}{$_}==0 } @{$self->{FIFO}};
1555 for my $current (0..$#toremove) {
1556 my $toremove = $toremove[$current];
1557 $CPAN::Frontend->myprint(sprintf(
1558 "DEL(%d/%d): %s \n",
1564 return if $CPAN::Signal;
1565 $self->_clean_cache($toremove);
1566 return if $CPAN::Signal;
1570 #-> sub CPAN::CacheMgr::dir ;
1575 #-> sub CPAN::CacheMgr::entries ;
1577 my($self,$dir) = @_;
1578 return unless defined $dir;
1579 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1580 $dir ||= $self->{ID};
1581 my($cwd) = CPAN::anycwd();
1582 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1583 my $dh = DirHandle->new(File::Spec->curdir)
1584 or Carp::croak("Couldn't opendir $dir: $!");
1587 next if $_ eq "." || $_ eq "..";
1589 push @entries, File::Spec->catfile($dir,$_);
1591 push @entries, File::Spec->catdir($dir,$_);
1593 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1596 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1597 sort { -M $a <=> -M $b} @entries;
1600 #-> sub CPAN::CacheMgr::disk_usage ;
1602 my($self,$dir,$fast) = @_;
1603 return if exists $self->{SIZE}{$dir};
1604 return if $CPAN::Signal;
1609 unless (chmod 0755, $dir) {
1610 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1611 "permission to change the permission; cannot ".
1612 "estimate disk usage of '$dir'\n");
1613 $CPAN::Frontend->mysleep(5);
1618 # nothing to say, no matter what the permissions
1621 $CPAN::Frontend->mywarn("File or directory '$dir' has gone, ignoring\n");
1625 $Du = 0; # placeholder
1629 $File::Find::prune++ if $CPAN::Signal;
1631 if ($^O eq 'MacOS') {
1633 my $cat = Mac::Files::FSpGetCatInfo($_);
1634 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1638 unless (chmod 0755, $_) {
1639 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1640 "the permission to change the permission; ".
1641 "can only partially estimate disk usage ".
1643 $CPAN::Frontend->mysleep(5);
1655 return if $CPAN::Signal;
1656 $self->{SIZE}{$dir} = $Du/1024/1024;
1657 unshift @{$self->{FIFO}}, $dir;
1658 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1659 $self->{DU} += $Du/1024/1024;
1663 #-> sub CPAN::CacheMgr::_clean_cache ;
1665 my($self,$dir) = @_;
1666 return unless -e $dir;
1667 unless (File::Spec->canonpath(File::Basename::dirname($dir))
1668 eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
1669 $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
1670 "will not remove\n");
1671 $CPAN::Frontend->mysleep(5);
1674 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1676 File::Path::rmtree($dir);
1678 if ($dir !~ /\.yml$/ && -f "$dir.yml") {
1679 my $yaml_module = CPAN::_yaml_module;
1680 if ($CPAN::META->has_inst($yaml_module)) {
1681 my($peek_yaml) = eval { CPAN->_yaml_loadfile("$dir.yml"); };
1683 $CPAN::Frontend->mywarn("(parse error on '$dir.yml' removing anyway)");
1684 unlink "$dir.yml" or
1685 $CPAN::Frontend->mywarn("(Could not unlink '$dir.yml': $!)");
1687 } elsif (my $id = $peek_yaml->[0]{distribution}{ID}) {
1688 $CPAN::META->delete("CPAN::Distribution", $id);
1690 # XXX we should restore the state NOW, otherise this
1691 # distro does not exist until we read an index. BUG ALERT(?)
1693 # $CPAN::Frontend->mywarn (" +++\n");
1697 unlink "$dir.yml"; # may fail
1698 unless ($id_deleted) {
1699 CPAN->debug("no distro found associated with '$dir'");
1702 $self->{DU} -= $self->{SIZE}{$dir};
1703 delete $self->{SIZE}{$dir};
1706 #-> sub CPAN::CacheMgr::new ;
1713 ID => $CPAN::Config->{build_dir},
1714 MAX => $CPAN::Config->{'build_cache'},
1715 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1718 File::Path::mkpath($self->{ID});
1719 my $dh = DirHandle->new($self->{ID});
1720 bless $self, $class;
1723 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1725 CPAN->debug($debug) if $CPAN::DEBUG;
1729 #-> sub CPAN::CacheMgr::scan_cache ;
1732 return if $self->{SCAN} eq 'never';
1733 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1734 unless $self->{SCAN} eq 'atstart';
1735 return unless $CPAN::META->{LOCK};
1736 $CPAN::Frontend->myprint(
1737 sprintf("Scanning cache %s for sizes\n",
1740 my @entries = $self->entries($self->{ID});
1745 if ($self->{DU} > $self->{MAX}) {
1747 $self->disk_usage($e,1);
1749 $self->disk_usage($e);
1752 while (($painted/76) < ($i/@entries)) {
1753 $CPAN::Frontend->myprint($symbol);
1756 return if $CPAN::Signal;
1758 $CPAN::Frontend->myprint("DONE\n");
1762 package CPAN::Shell;
1765 #-> sub CPAN::Shell::h ;
1767 my($class,$about) = @_;
1768 if (defined $about) {
1770 if (exists $Help->{$about}) {
1771 if (ref $Help->{$about}) { # aliases
1772 $about = ${$Help->{$about}};
1774 $help = $Help->{$about};
1776 $help = "No help available";
1778 $CPAN::Frontend->myprint("$about\: $help\n");
1780 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1781 $CPAN::Frontend->myprint(qq{
1782 Display Information $filler (ver $CPAN::VERSION)
1783 command argument description
1784 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1785 i WORD or /REGEXP/ about any of the above
1786 ls AUTHOR or GLOB about files in the author's directory
1787 (with WORD being a module, bundle or author name or a distribution
1788 name of the form AUTHOR/DISTRIBUTION)
1790 Download, Test, Make, Install...
1791 get download clean make clean
1792 make make (implies get) look open subshell in dist directory
1793 test make test (implies make) readme display these README files
1794 install make install (implies test) perldoc display POD documentation
1797 r WORDs or /REGEXP/ or NONE report updates for some/matching/all modules
1798 upgrade WORDs or /REGEXP/ or NONE upgrade some/matching/all modules
1801 force CMD try hard to do command fforce CMD try harder
1802 notest CMD skip testing
1805 h,? display this menu ! perl-code eval a perl command
1806 o conf [opt] set and query options q quit the cpan shell
1807 reload cpan load CPAN.pm again reload index load newer indices
1808 autobundle Snapshot recent latest CPAN uploads});
1814 #-> sub CPAN::Shell::a ;
1816 my($self,@arg) = @_;
1817 # authors are always UPPERCASE
1819 $_ = uc $_ unless /=/;
1821 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1824 #-> sub CPAN::Shell::globls ;
1826 my($self,$s,$pragmas) = @_;
1827 # ls is really very different, but we had it once as an ordinary
1828 # command in the Shell (upto rev. 321) and we could not handle
1830 my(@accept,@preexpand);
1831 if ($s =~ /[\*\?\/]/) {
1832 if ($CPAN::META->has_inst("Text::Glob")) {
1833 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1834 my $rau = Text::Glob::glob_to_regex(uc $au);
1835 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1837 push @preexpand, map { $_->id . "/" . $pathglob }
1838 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1840 my $rau = Text::Glob::glob_to_regex(uc $s);
1841 push @preexpand, map { $_->id }
1842 CPAN::Shell->expand_by_method('CPAN::Author',
1847 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1850 push @preexpand, uc $s;
1853 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1854 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1859 my $silent = @accept>1;
1860 my $last_alpha = "";
1862 for my $a (@accept) {
1863 my($author,$pathglob);
1864 if ($a =~ m|(.*?)/(.*)|) {
1867 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1870 or $CPAN::Frontend->mydie("No author found for $a2\n");
1872 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1875 or $CPAN::Frontend->mydie("No author found for $a\n");
1878 my $alpha = substr $author->id, 0, 1;
1880 if ($alpha eq $last_alpha) {
1884 $last_alpha = $alpha;
1886 $CPAN::Frontend->myprint($ad);
1888 for my $pragma (@$pragmas) {
1889 if ($author->can($pragma)) {
1893 push @results, $author->ls($pathglob,$silent); # silent if
1896 for my $pragma (@$pragmas) {
1897 my $unpragma = "un$pragma";
1898 if ($author->can($unpragma)) {
1899 $author->$unpragma();
1906 #-> sub CPAN::Shell::local_bundles ;
1908 my($self,@which) = @_;
1909 my($incdir,$bdir,$dh);
1910 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1911 my @bbase = "Bundle";
1912 while (my $bbase = shift @bbase) {
1913 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1914 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1915 if ($dh = DirHandle->new($bdir)) { # may fail
1917 for $entry ($dh->read) {
1918 next if $entry =~ /^\./;
1919 next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
1920 if (-d File::Spec->catdir($bdir,$entry)) {
1921 push @bbase, "$bbase\::$entry";
1923 next unless $entry =~ s/\.pm(?!\n)\Z//;
1924 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1932 #-> sub CPAN::Shell::b ;
1934 my($self,@which) = @_;
1935 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1936 $self->local_bundles;
1937 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1940 #-> sub CPAN::Shell::d ;
1941 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1943 #-> sub CPAN::Shell::m ;
1944 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1946 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1949 #-> sub CPAN::Shell::i ;
1953 @args = '/./' unless @args;
1955 for my $type (qw/Bundle Distribution Module/) {
1956 push @result, $self->expand($type,@args);
1958 # Authors are always uppercase.
1959 push @result, $self->expand("Author", map { uc $_ } @args);
1961 my $result = @result == 1 ?
1962 $result[0]->as_string :
1964 "No objects found of any type for argument @args\n" :
1966 (map {$_->as_glimpse} @result),
1967 scalar @result, " items found\n",
1969 $CPAN::Frontend->myprint($result);
1972 #-> sub CPAN::Shell::o ;
1974 # CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o
1975 # conf' calls through to CPAN::HandleConfig::edit. 'o conf' should
1976 # probably have been called 'set' and 'o debug' maybe 'set debug' or
1977 # 'debug'; 'o conf ARGS' calls ->edit in CPAN/HandleConfig.pm
1979 my($self,$o_type,@o_what) = @_;
1981 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1982 if ($o_type eq 'conf') {
1983 my($cfilter) = $o_what[0] =~ m|^/(.*)/$|;
1984 if (!@o_what or $cfilter) { # print all things, "o conf"
1986 my $qrfilter = eval 'qr/$cfilter/';
1988 $CPAN::Frontend->myprint("\$CPAN::Config options from ");
1990 if (exists $INC{'CPAN/Config.pm'}) {
1991 push @from, $INC{'CPAN/Config.pm'};
1993 if (exists $INC{'CPAN/MyConfig.pm'}) {
1994 push @from, $INC{'CPAN/MyConfig.pm'};
1996 $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
1997 $CPAN::Frontend->myprint(":\n");
1998 for $k (sort keys %CPAN::HandleConfig::can) {
1999 next unless $k =~ /$qrfilter/;
2000 $v = $CPAN::HandleConfig::can{$k};
2001 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
2003 $CPAN::Frontend->myprint("\n");
2004 for $k (sort keys %CPAN::HandleConfig::keys) {
2005 next unless $k =~ /$qrfilter/;
2006 CPAN::HandleConfig->prettyprint($k);
2008 $CPAN::Frontend->myprint("\n");
2010 if (CPAN::HandleConfig->edit(@o_what)) {
2012 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
2016 } elsif ($o_type eq 'debug') {
2018 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
2021 my($what) = shift @o_what;
2022 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
2023 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
2026 if ( exists $CPAN::DEBUG{$what} ) {
2027 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
2028 } elsif ($what =~ /^\d/) {
2029 $CPAN::DEBUG = $what;
2030 } elsif (lc $what eq 'all') {
2032 for (values %CPAN::DEBUG) {
2035 $CPAN::DEBUG = $max;
2038 for (keys %CPAN::DEBUG) {
2039 next unless lc($_) eq lc($what);
2040 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
2043 $CPAN::Frontend->myprint("unknown argument [$what]\n")
2048 my $raw = "Valid options for debug are ".
2049 join(", ",sort(keys %CPAN::DEBUG), 'all').
2050 qq{ or a number. Completion works on the options. }.
2051 qq{Case is ignored.};
2053 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
2054 $CPAN::Frontend->myprint("\n\n");
2057 $CPAN::Frontend->myprint("Options set for debugging ($CPAN::DEBUG):\n");
2059 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
2060 $v = $CPAN::DEBUG{$k};
2061 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
2062 if $v & $CPAN::DEBUG;
2065 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
2068 $CPAN::Frontend->myprint(qq{
2070 conf set or get configuration variables
2071 debug set or get debugging options
2076 # CPAN::Shell::paintdots_onreload
2077 sub paintdots_onreload {
2080 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
2084 # $CPAN::Frontend->myprint(".($subr)");
2085 $CPAN::Frontend->myprint(".");
2086 if ($subr =~ /\bshell\b/i) {
2087 # warn "debug[$_[0]]";
2089 # It would be nice if we could detect that a
2090 # subroutine has actually changed, but for now we
2091 # practically always set the GOTOSHELL global
2101 #-> sub CPAN::Shell::hosts ;
2104 my $fullstats = CPAN::FTP->_ftp_statistics();
2105 my $history = $fullstats->{history} || [];
2107 while (my $last = pop @$history) {
2108 my $attempts = $last->{attempts} or next;
2111 $start = $attempts->[-1]{start};
2112 if ($#$attempts > 0) {
2113 for my $i (0..$#$attempts-1) {
2114 my $url = $attempts->[$i]{url} or next;
2119 $start = $last->{start};
2121 next unless $last->{thesiteurl}; # C-C? bad filenames?
2123 $S{end} ||= $last->{end};
2124 my $dltime = $last->{end} - $start;
2125 my $dlsize = $last->{filesize} || 0;
2126 my $url = ref $last->{thesiteurl} ? $last->{thesiteurl}->text : $last->{thesiteurl};
2127 my $s = $S{ok}{$url} ||= {};
2130 $s->{dlsize} += $dlsize/1024;
2132 $s->{dltime} += $dltime;
2135 for my $url (keys %{$S{ok}}) {
2136 next if $S{ok}{$url}{dltime} == 0; # div by zero
2137 push @{$res->{ok}}, [@{$S{ok}{$url}}{qw(n dlsize dltime)},
2138 $S{ok}{$url}{dlsize}/$S{ok}{$url}{dltime},
2142 for my $url (keys %{$S{no}}) {
2143 push @{$res->{no}}, [$S{no}{$url},
2147 my $R = ""; # report
2148 if ($S{start} && $S{end}) {
2149 $R .= sprintf "Log starts: %s\n", $S{start} ? scalar(localtime $S{start}) : "unknown";
2150 $R .= sprintf "Log ends : %s\n", $S{end} ? scalar(localtime $S{end}) : "unknown";
2152 if ($res->{ok} && @{$res->{ok}}) {
2153 $R .= sprintf "\nSuccessful downloads:
2154 N kB secs kB/s url\n";
2156 for (sort { $b->[3] <=> $a->[3] } @{$res->{ok}}) {
2157 $R .= sprintf "%4d %8d %5d %9.1f %s\n", @$_;
2161 if ($res->{no} && @{$res->{no}}) {
2162 $R .= sprintf "\nUnsuccessful downloads:\n";
2164 for (sort { $b->[0] <=> $a->[0] } @{$res->{no}}) {
2165 $R .= sprintf "%4d %s\n", @$_;
2169 $CPAN::Frontend->myprint($R);
2172 #-> sub CPAN::Shell::reload ;
2174 my($self,$command,@arg) = @_;
2176 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
2177 if ($command =~ /^cpan$/i) {
2179 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
2184 "CPAN/FirstTime.pm",
2185 "CPAN/HandleConfig.pm",
2188 "CPAN/Reporter/Config.pm",
2189 "CPAN/Reporter/History.pm",
2195 MFILE: for my $f (@relo) {
2196 next unless exists $INC{$f};
2200 $CPAN::Frontend->myprint("($p");
2201 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
2202 $self->_reload_this($f) or $failed++;
2203 my $v = eval "$p\::->VERSION";
2204 $CPAN::Frontend->myprint("v$v)");
2206 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
2208 my $errors = $failed == 1 ? "error" : "errors";
2209 $CPAN::Frontend->mywarn("\n$failed $errors during reload. You better quit ".
2212 } elsif ($command =~ /^index$/i) {
2213 CPAN::Index->force_reload;
2215 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN modules
2216 index re-reads the index files\n});
2220 # reload means only load again what we have loaded before
2221 #-> sub CPAN::Shell::_reload_this ;
2223 my($self,$f,$args) = @_;
2224 CPAN->debug("f[$f]") if $CPAN::DEBUG;
2225 return 1 unless $INC{$f}; # we never loaded this, so we do not
2227 my $pwd = CPAN::anycwd();
2228 CPAN->debug("pwd[$pwd]") if $CPAN::DEBUG;
2230 for my $inc (@INC) {
2231 $file = File::Spec->catfile($inc,split /\//, $f);
2235 CPAN->debug("file[$file]") if $CPAN::DEBUG;
2237 unless ($file && -f $file) {
2238 # this thingie is not in the INC path, maybe CPAN/MyConfig.pm?
2240 unless (CPAN->has_inst("File::Basename")) {
2241 @inc = File::Basename::dirname($file);
2243 # do we ever need this?
2244 @inc = substr($file,0,-length($f)-1); # bring in back to me!
2247 CPAN->debug("file[$file]inc[@inc]") if $CPAN::DEBUG;
2249 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
2252 my $mtime = (stat $file)[9];
2253 if ($reload->{$f}) {
2254 } elsif ($^T < $mtime) {
2255 # since we started the file has changed, force it to be reloaded
2258 $reload->{$f} = $mtime;
2260 my $must_reload = $mtime != $reload->{$f};
2262 $must_reload ||= $args->{reloforce}; # o conf defaults needs this
2264 my $fh = FileHandle->new($file) or
2265 $CPAN::Frontend->mydie("Could not open $file: $!");
2268 my $content = <$fh>;
2269 CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128)))
2273 eval "require '$f'";
2278 $reload->{$f} = $mtime;
2280 $CPAN::Frontend->myprint("__unchanged__");
2285 #-> sub CPAN::Shell::mkmyconfig ;
2287 my($self, $cpanpm, %args) = @_;
2288 require CPAN::FirstTime;
2289 my $home = CPAN::HandleConfig::home;
2290 $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
2291 File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
2292 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
2293 CPAN::HandleConfig::require_myconfig_or_config;
2294 $CPAN::Config ||= {};
2299 keep_source_where => undef,
2302 CPAN::FirstTime::init($cpanpm, %args);
2305 #-> sub CPAN::Shell::_binary_extensions ;
2306 sub _binary_extensions {
2307 my($self) = shift @_;
2308 my(@result,$module,%seen,%need,$headerdone);
2309 for $module ($self->expand('Module','/./')) {
2310 my $file = $module->cpan_file;
2311 next if $file eq "N/A";
2312 next if $file =~ /^Contact Author/;
2313 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
2314 next if $dist->isa_perl;
2315 next unless $module->xs_file;
2317 $CPAN::Frontend->myprint(".");
2318 push @result, $module;
2320 # print join " | ", @result;
2321 $CPAN::Frontend->myprint("\n");
2325 #-> sub CPAN::Shell::recompile ;
2327 my($self) = shift @_;
2328 my($module,@module,$cpan_file,%dist);
2329 @module = $self->_binary_extensions();
2330 for $module (@module) { # we force now and compile later, so we
2332 $cpan_file = $module->cpan_file;
2333 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
2335 $dist{$cpan_file}++;
2337 for $cpan_file (sort keys %dist) {
2338 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
2339 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
2341 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
2342 # stop a package from recompiling,
2343 # e.g. IO-1.12 when we have perl5.003_10
2347 #-> sub CPAN::Shell::scripts ;
2349 my($self, $arg) = @_;
2350 $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n");
2352 for my $req (qw( HTML::LinkExtor Sort::Versions List::Util )) {
2353 unless ($CPAN::META->has_inst($req)) {
2354 $CPAN::Frontend->mywarn(" $req not available\n");
2357 my $p = HTML::LinkExtor->new();
2358 my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html";
2359 unless (-f $indexfile) {
2360 $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n");
2362 $p->parse_file($indexfile);
2365 if ($arg =~ s|^/(.+)/$|$1|) {
2366 $qrarg = eval 'qr/$arg/'; # hide construct from 5.004
2368 for my $l ($p->links) {
2369 my $tag = shift @$l;
2370 next unless $tag eq "a";
2372 my $href = $att{href};
2373 next unless $href =~ s|^\.\./authors/id/./../||;
2376 if ($href =~ $qrarg) {
2380 if ($href =~ /\Q$arg\E/) {
2388 # now filter for the latest version if there is more than one of a name
2394 $stems{$stem} ||= [];
2395 push @{$stems{$stem}}, $href;
2397 for (sort keys %stems) {
2399 if (@{$stems{$_}} > 1) {
2400 $highest = List::Util::reduce {
2401 Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b
2404 $highest = $stems{$_}[0];
2406 $CPAN::Frontend->myprint("$highest\n");
2410 #-> sub CPAN::Shell::report ;
2412 my($self,@args) = @_;
2413 unless ($CPAN::META->has_inst("CPAN::Reporter")) {
2414 $CPAN::Frontend->mydie("CPAN::Reporter not installed; cannot continue");
2416 local $CPAN::Config->{test_report} = 1;
2417 $self->force("test",@args); # force is there so that the test be
2418 # re-run (as documented)
2421 # compare with is_tested
2422 #-> sub CPAN::Shell::install_tested
2423 sub install_tested {
2424 my($self,@some) = @_;
2425 $CPAN::Frontend->mywarn("install_tested() must not be called with arguments.\n"),
2427 CPAN::Index->reload;
2429 for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) {
2430 my $yaml = "$b.yml";
2432 $CPAN::Frontend->mywarn("No YAML file for $b available, skipping\n");
2435 my $yaml_content = CPAN->_yaml_loadfile($yaml);
2436 my $id = $yaml_content->[0]{distribution}{ID};
2438 $CPAN::Frontend->mywarn("No ID found in '$yaml', skipping\n");
2441 my $do = CPAN::Shell->expandany($id);
2443 $CPAN::Frontend->mywarn("Could not expand ID '$id', skipping\n");
2446 unless ($do->{build_dir}) {
2447 $CPAN::Frontend->mywarn("Distro '$id' has no build_dir, skipping\n");
2450 unless ($do->{build_dir} eq $b) {
2451 $CPAN::Frontend->mywarn("Distro '$id' has build_dir '$do->{build_dir}' but expected '$b', skipping\n");
2457 $CPAN::Frontend->mywarn("No tested distributions found.\n"),
2458 return unless @some;
2460 @some = grep { $_->{make_test} && ! $_->{make_test}->failed } @some;
2461 $CPAN::Frontend->mywarn("No distributions tested with this build of perl found.\n"),
2462 return unless @some;
2464 # @some = grep { not $_->uptodate } @some;
2465 # $CPAN::Frontend->mywarn("No non-uptodate distributions tested with this build of perl found.\n"),
2466 # return unless @some;
2468 CPAN->debug("some[@some]");
2470 my $id = $d->can("pretty_id") ? $d->pretty_id : $d->id;
2471 $CPAN::Frontend->myprint("install_tested: Running for $id\n");
2472 $CPAN::Frontend->mysleep(1);
2477 #-> sub CPAN::Shell::upgrade ;
2479 my($self,@args) = @_;
2480 $self->install($self->r(@args));
2483 #-> sub CPAN::Shell::_u_r_common ;
2485 my($self) = shift @_;
2486 my($what) = shift @_;
2487 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
2488 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
2489 $what && $what =~ /^[aru]$/;
2491 @args = '/./' unless @args;
2492 my(@result,$module,%seen,%need,$headerdone,
2493 $version_undefs,$version_zeroes,
2494 @version_undefs,@version_zeroes);
2495 $version_undefs = $version_zeroes = 0;
2496 my $sprintf = "%s%-25s%s %9s %9s %s\n";
2497 my @expand = $self->expand('Module',@args);
2498 my $expand = scalar @expand;
2499 if (0) { # Looks like noise to me, was very useful for debugging
2500 # for metadata cache
2501 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
2503 MODULE: for $module (@expand) {
2504 my $file = $module->cpan_file;
2505 next MODULE unless defined $file; # ??
2506 $file =~ s!^./../!!;
2507 my($latest) = $module->cpan_version;
2508 my($inst_file) = $module->inst_file;
2510 return if $CPAN::Signal;
2513 $have = $module->inst_version;
2514 } elsif ($what eq "r") {
2515 $have = $module->inst_version;
2517 if ($have eq "undef") {
2519 push @version_undefs, $module->as_glimpse;
2520 } elsif (CPAN::Version->vcmp($have,0)==0) {
2522 push @version_zeroes, $module->as_glimpse;
2524 next MODULE unless CPAN::Version->vgt($latest, $have);
2525 # to be pedantic we should probably say:
2526 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
2527 # to catch the case where CPAN has a version 0 and we have a version undef
2528 } elsif ($what eq "u") {
2534 } elsif ($what eq "r") {
2536 } elsif ($what eq "u") {
2540 return if $CPAN::Signal; # this is sometimes lengthy
2543 push @result, sprintf "%s %s\n", $module->id, $have;
2544 } elsif ($what eq "r") {
2545 push @result, $module->id;
2546 next MODULE if $seen{$file}++;
2547 } elsif ($what eq "u") {
2548 push @result, $module->id;
2549 next MODULE if $seen{$file}++;
2550 next MODULE if $file =~ /^Contact/;
2552 unless ($headerdone++) {
2553 $CPAN::Frontend->myprint("\n");
2554 $CPAN::Frontend->myprint(sprintf(
2557 "Package namespace",
2569 $CPAN::META->has_inst("Term::ANSIColor")
2571 $module->description
2573 $color_on = Term::ANSIColor::color("green");
2574 $color_off = Term::ANSIColor::color("reset");
2576 $CPAN::Frontend->myprint(sprintf $sprintf,
2583 $need{$module->id}++;
2587 $CPAN::Frontend->myprint("No modules found for @args\n");
2588 } elsif ($what eq "r") {
2589 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
2593 if ($version_zeroes) {
2594 my $s_has = $version_zeroes > 1 ? "s have" : " has";
2595 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
2596 qq{a version number of 0\n});
2597 if ($CPAN::Config->{show_zero_versions}) {
2599 $CPAN::Frontend->myprint(qq{ they are\n\t@version_zeroes\n});
2600 $CPAN::Frontend->myprint(qq{(use 'o conf show_zero_versions 0' }.
2601 qq{to hide them)\n});
2603 $CPAN::Frontend->myprint(qq{(use 'o conf show_zero_versions 1' }.
2604 qq{to show them)\n});
2607 if ($version_undefs) {
2608 my $s_has = $version_undefs > 1 ? "s have" : " has";
2609 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
2610 qq{parseable version number\n});
2611 if ($CPAN::Config->{show_unparsable_versions}) {
2613 $CPAN::Frontend->myprint(qq{ they are\n\t@version_undefs\n});
2614 $CPAN::Frontend->myprint(qq{(use 'o conf show_unparsable_versions 0' }.
2615 qq{to hide them)\n});
2617 $CPAN::Frontend->myprint(qq{(use 'o conf show_unparsable_versions 1' }.
2618 qq{to show them)\n});
2625 #-> sub CPAN::Shell::r ;
2627 shift->_u_r_common("r",@_);
2630 #-> sub CPAN::Shell::u ;
2632 shift->_u_r_common("u",@_);
2635 #-> sub CPAN::Shell::failed ;
2637 my($self,$only_id,$silent) = @_;
2639 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
2641 NAY: for my $nosayer ( # order matters!
2650 next unless exists $d->{$nosayer};
2651 next unless defined $d->{$nosayer};
2653 UNIVERSAL::can($d->{$nosayer},"failed") ?
2654 $d->{$nosayer}->failed :
2655 $d->{$nosayer} =~ /^NO/
2657 next NAY if $only_id && $only_id != (
2658 UNIVERSAL::can($d->{$nosayer},"commandid")
2660 $d->{$nosayer}->commandid
2662 $CPAN::CurrentCommandId
2667 next DIST unless $failed;
2671 # " %-45s: %s %s\n",
2674 UNIVERSAL::can($d->{$failed},"failed") ?
2676 $d->{$failed}->commandid,
2679 $d->{$failed}->text,
2680 $d->{$failed}{TIME}||0,
2693 $scope = "this command";
2694 } elsif ($CPAN::Index::HAVE_REANIMATED) {
2695 $scope = "this or a previous session";
2696 # it might be nice to have a section for previous session and
2699 $scope = "this session";
2706 map { sprintf "%5d %-45s: %s %s\n", @$_ }
2707 sort { $a->[0] <=> $b->[0] } @failed;
2710 map { sprintf " %-45s: %s %s\n", @$_[1..3] }
2717 $CPAN::Frontend->myprint("Failed during $scope:\n$print");
2718 } elsif (!$only_id || !$silent) {
2719 $CPAN::Frontend->myprint("Nothing failed in $scope\n");
2723 # XXX intentionally undocumented because completely bogus, unportable,
2726 #-> sub CPAN::Shell::status ;
2729 require Devel::Size;
2730 my $ps = FileHandle->new;
2731 open $ps, "/proc/$$/status";
2734 next unless /VmSize:\s+(\d+)/;
2738 $CPAN::Frontend->mywarn(sprintf(
2739 "%-27s %6d\n%-27s %6d\n",
2743 Devel::Size::total_size($CPAN::META)/1024,
2745 for my $k (sort keys %$CPAN::META) {
2746 next unless substr($k,0,4) eq "read";
2747 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
2748 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
2749 warn sprintf " %-25s %6d (keys: %6d)\n",
2751 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
2752 scalar keys %{$CPAN::META->{$k}{$k2}};
2757 # compare with install_tested
2758 #-> sub CPAN::Shell::is_tested
2761 CPAN::Index->reload;
2762 for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) {
2764 if ($CPAN::META->{is_tested}{$b}) {
2765 $time = scalar(localtime $CPAN::META->{is_tested}{$b});
2767 $time = scalar localtime;
2770 $CPAN::Frontend->myprint(sprintf "%s %s\n", $time, $b);
2774 #-> sub CPAN::Shell::autobundle ;
2777 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
2778 my(@bundle) = $self->_u_r_common("a",@_);
2779 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2780 File::Path::mkpath($todir);
2781 unless (-d $todir) {
2782 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
2785 my($y,$m,$d) = (localtime)[5,4,3];
2789 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
2790 my($to) = File::Spec->catfile($todir,"$me.pm");
2792 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
2793 $to = File::Spec->catfile($todir,"$me.pm");
2795 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
2797 "package Bundle::$me;\n\n",
2798 "\$VERSION = '0.01';\n\n",
2802 "Bundle::$me - Snapshot of installation on ",
2803 $Config::Config{'myhostname'},
2806 "\n\n=head1 SYNOPSIS\n\n",
2807 "perl -MCPAN -e 'install Bundle::$me'\n\n",
2808 "=head1 CONTENTS\n\n",
2809 join("\n", @bundle),
2810 "\n\n=head1 CONFIGURATION\n\n",
2812 "\n\n=head1 AUTHOR\n\n",
2813 "This Bundle has been generated automatically ",
2814 "by the autobundle routine in CPAN.pm.\n",
2817 $CPAN::Frontend->myprint("\nWrote bundle file
2821 #-> sub CPAN::Shell::expandany ;
2824 CPAN->debug("s[$s]") if $CPAN::DEBUG;
2825 if ($s =~ m|/| or substr($s,-1,1) eq ".") { # looks like a file or a directory
2826 $s = CPAN::Distribution->normalize($s);
2827 return $CPAN::META->instance('CPAN::Distribution',$s);
2828 # Distributions spring into existence, not expand
2829 } elsif ($s =~ m|^Bundle::|) {
2830 $self->local_bundles; # scanning so late for bundles seems
2831 # both attractive and crumpy: always
2832 # current state but easy to forget
2834 return $self->expand('Bundle',$s);
2836 return $self->expand('Module',$s)
2837 if $CPAN::META->exists('CPAN::Module',$s);
2842 #-> sub CPAN::Shell::expand ;
2845 my($type,@args) = @_;
2846 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
2847 my $class = "CPAN::$type";
2848 my $methods = ['id'];
2849 for my $meth (qw(name)) {
2850 next unless $class->can($meth);
2851 push @$methods, $meth;
2853 $self->expand_by_method($class,$methods,@args);
2856 #-> sub CPAN::Shell::expand_by_method ;
2857 sub expand_by_method {
2859 my($class,$methods,@args) = @_;
2862 my($regex,$command);
2863 if ($arg =~ m|^/(.*)/$|) {
2865 } elsif ($arg =~ m/=/) {
2869 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
2871 defined $regex ? $regex : "UNDEFINED",
2872 defined $command ? $command : "UNDEFINED",
2874 if (defined $regex) {
2875 if (CPAN::_sqlite_running) {
2876 $CPAN::SQLite->search($class, $regex);
2879 $CPAN::META->all_objects($class)
2881 unless ($obj && UNIVERSAL::can($obj,"id") && $obj->id) {
2882 # BUG, we got an empty object somewhere
2883 require Data::Dumper;
2884 CPAN->debug(sprintf(
2885 "Bug in CPAN: Empty id on obj[%s][%s]",
2887 Data::Dumper::Dumper($obj)
2891 for my $method (@$methods) {
2892 my $match = eval {$obj->$method() =~ /$regex/i};
2894 my($err) = $@ =~ /^(.+) at .+? line \d+\.$/;
2895 $err ||= $@; # if we were too restrictive above
2896 $CPAN::Frontend->mydie("$err\n");
2903 } elsif ($command) {
2904 die "equal sign in command disabled (immature interface), ".
2906 ! \$CPAN::Shell::ADVANCED_QUERY=1
2907 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
2908 that may go away anytime.\n"
2909 unless $ADVANCED_QUERY;
2910 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
2911 my($matchcrit) = $criterion =~ m/^~(.+)/;
2915 $CPAN::META->all_objects($class)
2917 my $lhs = $self->$method() or next; # () for 5.00503
2919 push @m, $self if $lhs =~ m/$matchcrit/;
2921 push @m, $self if $lhs eq $criterion;
2926 if ( $class eq 'CPAN::Bundle' ) {
2927 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
2928 } elsif ($class eq "CPAN::Distribution") {
2929 $xarg = CPAN::Distribution->normalize($arg);
2933 if ($CPAN::META->exists($class,$xarg)) {
2934 $obj = $CPAN::META->instance($class,$xarg);
2935 } elsif ($CPAN::META->exists($class,$arg)) {
2936 $obj = $CPAN::META->instance($class,$arg);
2943 @m = sort {$a->id cmp $b->id} @m;
2944 if ( $CPAN::DEBUG ) {
2945 my $wantarray = wantarray;
2946 my $join_m = join ",", map {$_->id} @m;
2947 $self->debug("wantarray[$wantarray]join_m[$join_m]");
2949 return wantarray ? @m : $m[0];
2952 #-> sub CPAN::Shell::format_result ;
2955 my($type,@args) = @_;
2956 @args = '/./' unless @args;
2957 my(@result) = $self->expand($type,@args);
2958 my $result = @result == 1 ?
2959 $result[0]->as_string :
2961 "No objects of type $type found for argument @args\n" :
2963 (map {$_->as_glimpse} @result),
2964 scalar @result, " items found\n",
2969 #-> sub CPAN::Shell::report_fh ;
2971 my $installation_report_fh;
2972 my $previously_noticed = 0;
2975 return $installation_report_fh if $installation_report_fh;
2976 if ($CPAN::META->has_inst("File::Temp")) {
2977 $installation_report_fh
2979 dir => File::Spec->tmpdir,
2980 template => 'cpan_install_XXXX',
2985 unless ( $installation_report_fh ) {
2986 warn("Couldn't open installation report file; " .
2987 "no report file will be generated."
2988 ) unless $previously_noticed++;
2994 # The only reason for this method is currently to have a reliable
2995 # debugging utility that reveals which output is going through which
2996 # channel. No, I don't like the colors ;-)
2998 # to turn colordebugging on, write
2999 # cpan> o conf colorize_output 1
3001 #-> sub CPAN::Shell::print_ornamented ;
3003 my $print_ornamented_have_warned = 0;
3004 sub colorize_output {
3005 my $colorize_output = $CPAN::Config->{colorize_output};
3006 if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) {
3007 unless ($print_ornamented_have_warned++) {
3008 # no myprint/mywarn within myprint/mywarn!
3009 warn "Colorize_output is set to true but Term::ANSIColor is not
3010 installed. To activate colorized output, please install Term::ANSIColor.\n\n";
3012 $colorize_output = 0;
3014 return $colorize_output;
3019 #-> sub CPAN::Shell::print_ornamented ;
3020 sub print_ornamented {
3021 my($self,$what,$ornament) = @_;
3022 return unless defined $what;
3024 local $| = 1; # Flush immediately
3025 if ( $CPAN::Be_Silent ) {
3026 print {report_fh()} $what;
3029 my $swhat = "$what"; # stringify if it is an object
3030 if ($CPAN::Config->{term_is_latin}) {
3031 # note: deprecated, need to switch to $LANG and $LC_*
3034 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
3036 if ($self->colorize_output) {
3037 if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) {
3038 # if you want to have this configurable, please file a bugreport
3039 $ornament = $CPAN::Config->{colorize_debug} || "black on_cyan";
3041 my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
3043 print "Term::ANSIColor rejects color[$ornament]: $@\n
3044 Please choose a different color (Hint: try 'o conf init /color/')\n";
3046 # GGOLDBACH/Test-GreaterVersion-0.008 broke wthout this
3047 # $trailer construct. We want the newline be the last thing if
3048 # there is a newline at the end ensuring that the next line is
3049 # empty for other players
3051 $trailer = $1 if $swhat =~ s/([\r\n]+)\z//;
3054 Term::ANSIColor::color("reset"),
3061 #-> sub CPAN::Shell::myprint ;
3063 # where is myprint/mywarn/Frontend/etc. documented? Where to use what?
3064 # I think, we send everything to STDOUT and use print for normal/good
3065 # news and warn for news that need more attention. Yes, this is our
3066 # working contract for now.
3068 my($self,$what) = @_;
3069 $self->print_ornamented($what,
3070 $CPAN::Config->{colorize_print}||'bold blue on_white',
3075 my($self,$category,$what) = @_;
3076 my $vname = $category . "_verbosity";
3077 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
3078 if (!$CPAN::Config->{$vname}
3079 || $CPAN::Config->{$vname} =~ /^v/
3081 $CPAN::Frontend->myprint($what);
3085 #-> sub CPAN::Shell::myexit ;
3087 my($self,$what) = @_;
3088 $self->myprint($what);
3092 #-> sub CPAN::Shell::mywarn ;
3094 my($self,$what) = @_;
3095 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
3098 # only to be used for shell commands
3099 #-> sub CPAN::Shell::mydie ;
3101 my($self,$what) = @_;
3102 $self->mywarn($what);
3104 # If it is the shell, we want the following die to be silent,
3105 # but if it is not the shell, we would need a 'die $what'. We need
3106 # to take care that only shell commands use mydie. Is this
3112 # sub CPAN::Shell::colorable_makemaker_prompt ;
3113 sub colorable_makemaker_prompt {
3115 if (CPAN::Shell->colorize_output) {
3116 my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white';
3117 my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
3120 my $ans = ExtUtils::MakeMaker::prompt($foo,$bar);
3121 if (CPAN::Shell->colorize_output) {
3122 print Term::ANSIColor::color('reset');
3127 # use this only for unrecoverable errors!
3128 #-> sub CPAN::Shell::unrecoverable_error ;
3129 sub unrecoverable_error {
3130 my($self,$what) = @_;
3131 my @lines = split /\n/, $what;
3133 for my $l (@lines) {
3134 $longest = length $l if length $l > $longest;
3136 $longest = 62 if $longest > 62;
3137 for my $l (@lines) {
3138 if ($l =~ /^\s*$/) {
3143 if (length $l < 66) {
3144 $l = pack "A66 A*", $l, "<==";
3148 unshift @lines, "\n";
3149 $self->mydie(join "", @lines);
3152 #-> sub CPAN::Shell::mysleep ;
3154 my($self, $sleep) = @_;
3155 if (CPAN->has_inst("Time::HiRes")) {
3156 Time::HiRes::sleep($sleep);
3158 sleep($sleep < 1 ? 1 : int($sleep + 0.5));
3162 #-> sub CPAN::Shell::setup_output ;
3164 return if -t STDOUT;
3165 my $odef = select STDERR;
3172 #-> sub CPAN::Shell::rematein ;
3173 # RE-adme||MA-ke||TE-st||IN-stall : nearly everything runs through here
3176 my($meth,@some) = @_;
3178 while($meth =~ /^(ff?orce|notest)$/) {
3179 push @pragma, $meth;
3180 $meth = shift @some or
3181 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
3185 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
3187 # Here is the place to set "test_count" on all involved parties to
3188 # 0. We then can pass this counter on to the involved
3189 # distributions and those can refuse to test if test_count > X. In
3190 # the first stab at it we could use a 1 for "X".
3192 # But when do I reset the distributions to start with 0 again?
3193 # Jost suggested to have a random or cycling interaction ID that
3194 # we pass through. But the ID is something that is just left lying
3195 # around in addition to the counter, so I'd prefer to set the
3196 # counter to 0 now, and repeat at the end of the loop. But what
3197 # about dependencies? They appear later and are not reset, they
3198 # enter the queue but not its copy. How do they get a sensible
3201 # With configure_requires, "get" is vulnerable in recursion.
3203 my $needs_recursion_protection = "get|make|test|install";
3205 # construct the queue
3207 STHING: foreach $s (@some) {
3210 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
3212 } elsif ($s =~ m|[\$\@\%]|) { # looks like a perl variable
3213 } elsif ($s =~ m|^/|) { # looks like a regexp
3214 if (substr($s,-1,1) eq ".") {
3215 $obj = CPAN::Shell->expandany($s);
3217 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
3218 "not supported.\nRejecting argument '$s'\n");
3219 $CPAN::Frontend->mysleep(2);
3222 } elsif ($meth eq "ls") {
3223 $self->globls($s,\@pragma);
3226 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
3227 $obj = CPAN::Shell->expandany($s);
3230 } elsif (ref $obj) {
3231 if ($meth =~ /^($needs_recursion_protection)$/) {
3232 # it would be silly to check for recursion for look or dump
3233 # (we are in CPAN::Shell::rematein)
3234 CPAN->debug("Going to test against recursion") if $CPAN::DEBUG;
3235 eval { $obj->color_cmd_tmps(0,1); };
3238 and $@->isa("CPAN::Exception::RecursiveDependency")) {
3239 $CPAN::Frontend->mywarn($@);
3243 Carp::confess(sprintf "DEBUG: \$\@[%s]ref[%s]", $@, ref $@);
3249 CPAN::Queue->queue_item(qmod => $obj->id, reqtype => "c");
3251 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
3252 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
3253 if ($meth =~ /^(dump|ls|reports)$/) {
3256 $CPAN::Frontend->mywarn(
3258 "Don't be silly, you can't $meth ",
3262 $CPAN::Frontend->mysleep(2);
3264 } elsif ($s =~ m|[\$\@\%]| && $meth eq "dump") {
3265 CPAN::InfoObj->dump($s);
3268 ->mywarn(qq{Warning: Cannot $meth $s, }.
3269 qq{don't know what it is.
3274 to find objects with matching identifiers.
3276 $CPAN::Frontend->mysleep(2);
3280 # queuerunner (please be warned: when I started to change the
3281 # queue to hold objects instead of names, I made one or two
3282 # mistakes and never found which. I reverted back instead)
3283 while (my $q = CPAN::Queue->first) {
3285 my $s = $q->as_string;
3286 my $reqtype = $q->reqtype || "";
3287 $obj = CPAN::Shell->expandany($s);
3289 # don't know how this can happen, maybe we should panic,
3290 # but maybe we get a solution from the first user who hits
3291 # this unfortunate exception?
3292 $CPAN::Frontend->mywarn("Warning: Could not expand string '$s' ".
3293 "to an object. Skipping.\n");
3294 $CPAN::Frontend->mysleep(5);
3295 CPAN::Queue->delete_first($s);
3298 $obj->{reqtype} ||= "";
3300 # force debugging because CPAN::SQLite somehow delivers us
3303 # local $CPAN::DEBUG = 1024; # Shell; probably fixed now
3305 CPAN->debug("s[$s]obj-reqtype[$obj->{reqtype}]".
3306 "q-reqtype[$reqtype]") if $CPAN::DEBUG;
3308 if ($obj->{reqtype}) {
3309 if ($obj->{reqtype} eq "b" && $reqtype =~ /^[rc]$/) {
3310 $obj->{reqtype} = $reqtype;
3312 exists $obj->{install}
3315 UNIVERSAL::can($obj->{install},"failed") ?
3316 $obj->{install}->failed :
3317 $obj->{install} =~ /^NO/
3320 delete $obj->{install};
3321 $CPAN::Frontend->mywarn
3322 ("Promoting $obj->{ID} from 'build_requires' to 'requires'");
3326 $obj->{reqtype} = $reqtype;
3329 for my $pragma (@pragma) {
3332 $obj->can($pragma)) {
3333 $obj->$pragma($meth);
3336 if (UNIVERSAL::can($obj, 'called_for')) {
3337 $obj->called_for($s);
3339 CPAN->debug(qq{pragma[@pragma]meth[$meth]}.
3340 qq{ID[$obj->{ID}]}) if $CPAN::DEBUG;
3343 if ($meth =~ /^(report)$/) { # they came here with a pragma?
3345 } elsif (! UNIVERSAL::can($obj,$meth)) {
3347 my $serialized = "";
3349 } elsif ($CPAN::META->has_inst("YAML::Syck")) {
3350 $serialized = YAML::Syck::Dump($obj);
3351 } elsif ($CPAN::META->has_inst("YAML")) {
3352 $serialized = YAML::Dump($obj);
3353 } elsif ($CPAN::META->has_inst("Data::Dumper")) {
3354 $serialized = Data::Dumper::Dumper($obj);
3357 $serialized = overload::StrVal($obj);
3359 CPAN->debug("Going to panic. meth[$meth]s[$s]") if $CPAN::DEBUG;
3360 $CPAN::Frontend->mydie("Panic: obj[$serialized] cannot meth[$meth]");
3361 } elsif ($obj->$meth()) {
3362 CPAN::Queue->delete($s);
3363 CPAN->debug("From queue deleted. meth[$meth]s[$s]") if $CPAN::DEBUG;
3365 CPAN->debug("Failed. pragma[@pragma]meth[$meth]") if $CPAN::DEBUG;
3369 for my $pragma (@pragma) {
3370 my $unpragma = "un$pragma";
3371 if ($obj->can($unpragma)) {
3375 CPAN::Queue->delete_first($s);
3377 if ($meth =~ /^($needs_recursion_protection)$/) {
3378 for my $obj (@qcopy) {
3379 $obj->color_cmd_tmps(0,0);
3384 #-> sub CPAN::Shell::recent ;
3387 if ($CPAN::META->has_inst("XML::LibXML")) {
3388 my $url = $CPAN::Defaultrecent;
3389 $CPAN::Frontend->myprint("Going to fetch '$url'\n");
3390 unless ($CPAN::META->has_usable("LWP")) {
3391 $CPAN::Frontend->mydie("LWP not installed; cannot continue");
3393 CPAN::LWP::UserAgent->config;
3395 eval { $Ua = CPAN::LWP::UserAgent->new; };
3397 $CPAN::Frontend->mydie("CPAN::LWP::UserAgent->new dies with $@\n");
3399 my $resp = $Ua->get($url);
3400 unless ($resp->is_success) {
3401 $CPAN::Frontend->mydie(sprintf "Could not download '%s': %s\n", $url, $resp->code);
3403 $CPAN::Frontend->myprint("DONE\n\n");
3404 my $xml = XML::LibXML->new->parse_string($resp->content);
3406 my $s = $xml->serialize(2);
3407 $s =~ s/\n\s*\n/\n/g;
3408 $CPAN::Frontend->myprint($s);
3412 if ($url =~ /winnipeg/) {
3413 my $pubdate = $xml->findvalue("/rss/channel/pubDate");
3414 $CPAN::Frontend->myprint(" pubDate: $pubdate\n\n");
3415 for my $eitem ($xml->findnodes("/rss/channel/item")) {
3416 my $distro = $eitem->findvalue("enclosure/\@url");
3417 $distro =~ s|.*?/authors/id/./../||;
3418 my $size = $eitem->findvalue("enclosure/\@length");
3419 my $desc = $eitem->findvalue("description");
3420 \0 $desc =~ s/.+? - //;
3421 $CPAN::Frontend->myprint("$distro [$size b]\n $desc\n");
3422 push @distros, $distro;
3424 } elsif ($url =~ /search.*uploads.rdf/) {
3425 # xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
3426 # xmlns="http://purl.org/rss/1.0/"
3427 # xmlns:taxo="http://purl.org/rss/1.0/modules/taxonomy/"
3428 # xmlns:dc="http://purl.org/dc/elements/1.1/"
3429 # xmlns:syn="http://purl.org/rss/1.0/modules/syndication/"
3430 # xmlns:admin="http://webns.net/mvcb/"
3433 my $dc_date = $xml->findvalue("//*[local-name(.) = 'RDF']/*[local-name(.) = 'channel']/*[local-name(.) = 'date']");
3434 $CPAN::Frontend->myprint(" dc:date: $dc_date\n\n");
3435 my $finish_eitem = 0;
3436 local $SIG{INT} = sub { $finish_eitem = 1 };
3437 EITEM: for my $eitem ($xml->findnodes("//*[local-name(.) = 'RDF']/*[local-name(.) = 'item']")) {
3438 my $distro = $eitem->findvalue("\@rdf:about");
3439 $distro =~ s|.*~||; # remove up to the tilde before the name
3440 $distro =~ s|/$||; # remove trailing slash
3441 $distro =~ s|([^/]+)|\U$1\E|; # upcase the name
3442 my $author = uc $1 or die "distro[$distro] without author, cannot continue";
3443 my $desc = $eitem->findvalue("*[local-name(.) = 'description']");
3445 SUBDIRTEST: while () {
3446 last SUBDIRTEST if ++$i >= 6; # half a dozen must do!
3447 if (my @ret = $self->globls("$distro*")) {
3448 @ret = grep {$_->[2] !~ /meta/} @ret;
3449 @ret = grep {length $_->[2]} @ret;
3451 $distro = "$author/$ret[0][2]";
3455 $distro =~ s|/|/*/|; # allow it to reside in a subdirectory
3458 next EITEM if $distro =~ m|\*|; # did not find the thing
3459 $CPAN::Frontend->myprint("____$desc\n");
3460 push @distros, $distro;
3461 last EITEM if $finish_eitem;
3466 # deprecated old version
3467 $CPAN::Frontend->mydie("no XML::LibXML installed, cannot continue\n");
3471 #-> sub CPAN::Shell::smoke ;
3474 my $distros = $self->recent;
3475 DISTRO: for my $distro (@$distros) {
3476 $CPAN::Frontend->myprint(sprintf "Going to download and test '$distro'\n");
3479 local $SIG{INT} = sub { $skip = 1 };
3481 $CPAN::Frontend->myprint(sprintf "\r%2d (Hit ^C to skip)", 10-$_);
3484 $CPAN::Frontend->myprint(" skipped\n");
3489 $CPAN::Frontend->myprint("\r \n"); # leave the dirty line with a newline
3490 $self->test($distro);
3495 # set up the dispatching methods
3497 for my $command (qw(
3514 *$command = sub { shift->rematein($command, @_); };
3518 package CPAN::LWP::UserAgent;
3522 return if $SETUPDONE;
3523 if ($CPAN::META->has_usable('LWP::UserAgent')) {
3524 require LWP::UserAgent;
3525 @ISA = qw(Exporter LWP::UserAgent);
3528 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
3532 sub get_basic_credentials {
3533 my($self, $realm, $uri, $proxy) = @_;
3534 if ($USER && $PASSWD) {
3535 return ($USER, $PASSWD);
3538 ($USER,$PASSWD) = $self->get_proxy_credentials();
3540 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
3542 return($USER,$PASSWD);
3545 sub get_proxy_credentials {
3547 my ($user, $password);
3548 if ( defined $CPAN::Config->{proxy_user} &&
3549 defined $CPAN::Config->{proxy_pass}) {
3550 $user = $CPAN::Config->{proxy_user};
3551 $password = $CPAN::Config->{proxy_pass};
3552 return ($user, $password);
3554 my $username_prompt = "\nProxy authentication needed!
3555 (Note: to permanently configure username and password run
3556 o conf proxy_user your_username
3557 o conf proxy_pass your_password
3559 ($user, $password) =
3560 _get_username_and_password_from_user($username_prompt);
3561 return ($user,$password);
3564 sub get_non_proxy_credentials {
3566 my ($user,$password);
3567 if ( defined $CPAN::Config->{username} &&
3568 defined $CPAN::Config->{password}) {
3569 $user = $CPAN::Config->{username};
3570 $password = $CPAN::Config->{password};
3571 return ($user, $password);
3573 my $username_prompt = "\nAuthentication needed!
3574 (Note: to permanently configure username and password run
3575 o conf username your_username
3576 o conf password your_password
3579 ($user, $password) =
3580 _get_username_and_password_from_user($username_prompt);
3581 return ($user,$password);
3584 sub _get_username_and_password_from_user {
3585 my $username_message = shift;
3586 my ($username,$password);
3588 ExtUtils::MakeMaker->import(qw(prompt));
3589 $username = prompt($username_message);
3590 if ($CPAN::META->has_inst("Term::ReadKey")) {
3591 Term::ReadKey::ReadMode("noecho");
3594 $CPAN::Frontend->mywarn(
3595 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
3598 $password = prompt("Password:");
3600 if ($CPAN::META->has_inst("Term::ReadKey")) {
3601 Term::ReadKey::ReadMode("restore");
3603 $CPAN::Frontend->myprint("\n\n");
3604 return ($username,$password);
3607 # mirror(): Its purpose is to deal with proxy authentication. When we
3608 # call SUPER::mirror, we relly call the mirror method in
3609 # LWP::UserAgent. LWP::UserAgent will then call
3610 # $self->get_basic_credentials or some equivalent and this will be
3611 # $self->dispatched to our own get_basic_credentials method.
3613 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
3615 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
3616 # although we have gone through our get_basic_credentials, the proxy
3617 # server refuses to connect. This could be a case where the username or
3618 # password has changed in the meantime, so I'm trying once again without
3619 # $USER and $PASSWD to give the get_basic_credentials routine another
3620 # chance to set $USER and $PASSWD.
3622 # mirror(): Its purpose is to deal with proxy authentication. When we
3623 # call SUPER::mirror, we relly call the mirror method in
3624 # LWP::UserAgent. LWP::UserAgent will then call
3625 # $self->get_basic_credentials or some equivalent and this will be
3626 # $self->dispatched to our own get_basic_credentials method.
3628 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
3630 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
3631 # although we have gone through our get_basic_credentials, the proxy
3632 # server refuses to connect. This could be a case where the username or
3633 # password has changed in the meantime, so I'm trying once again without
3634 # $USER and $PASSWD to give the get_basic_credentials routine another
3635 # chance to set $USER and $PASSWD.
3638 my($self,$url,$aslocal) = @_;
3639 my $result = $self->SUPER::mirror($url,$aslocal);
3640 if ($result->code == 407) {
3643 $result = $self->SUPER::mirror($url,$aslocal);
3651 #-> sub CPAN::FTP::ftp_statistics
3652 # if they want to rewrite, they need to pass in a filehandle
3653 sub _ftp_statistics {
3655 my $locktype = $fh ? LOCK_EX : LOCK_SH;
3656 $fh ||= FileHandle->new;
3657 my $file = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
3658 open $fh, "+>>$file" or $CPAN::Frontend->mydie("Could not open '$file': $!");
3661 while (!CPAN::_flock($fh, $locktype|LOCK_NB)) {
3662 $waitstart ||= localtime();
3664 $CPAN::Frontend->mywarn("Waiting for a read lock on '$file' (since $waitstart)\n");
3666 $CPAN::Frontend->mysleep($sleep);
3669 } elsif ($sleep <=6) {
3673 my $stats = eval { CPAN->_yaml_loadfile($file); };
3676 if (ref $@ eq "CPAN::Exception::yaml_not_installed") {
3677 $CPAN::Frontend->myprint("Warning (usually harmless): $@");
3679 } elsif (ref $@ eq "CPAN::Exception::yaml_process_error") {
3680 $CPAN::Frontend->mydie($@);
3683 $CPAN::Frontend->mydie($@);
3689 #-> sub CPAN::FTP::_mytime
3691 if (CPAN->has_inst("Time::HiRes")) {
3692 return Time::HiRes::time();
3698 #-> sub CPAN::FTP::_new_stats
3700 my($self,$file) = @_;
3709 #-> sub CPAN::FTP::_add_to_statistics
3710 sub _add_to_statistics {
3711 my($self,$stats) = @_;
3712 my $yaml_module = CPAN::_yaml_module;
3713 $self->debug("yaml_module[$yaml_module]") if $CPAN::DEBUG;
3714 if ($CPAN::META->has_inst($yaml_module)) {
3715 $stats->{thesiteurl} = $ThesiteURL;
3716 if (CPAN->has_inst("Time::HiRes")) {
3717 $stats->{end} = Time::HiRes::time();
3719 $stats->{end} = time;
3721 my $fh = FileHandle->new;
3725 @debug = $time if $sdebug;
3726 my $fullstats = $self->_ftp_statistics($fh);
3728 $fullstats->{history} ||= [];
3729 push @debug, scalar @{$fullstats->{history}} if $sdebug;
3730 push @debug, time if $sdebug;
3731 push @{$fullstats->{history}}, $stats;
3732 # arbitrary hardcoded constants until somebody demands to have
3733 # them settable; YAML.pm 0.62 is unacceptably slow with 999;
3734 # YAML::Syck 0.82 has no noticable performance problem with 999;
3736 @{$fullstats->{history}} > 99
3737 || $time - $fullstats->{history}[0]{start} > 14*86400
3739 shift @{$fullstats->{history}}
3741 push @debug, scalar @{$fullstats->{history}} if $sdebug;
3742 push @debug, time if $sdebug;
3743 push @debug, scalar localtime($fullstats->{history}[0]{start}) if $sdebug;
3744 # need no eval because if this fails, it is serious
3745 my $sfile = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
3746 CPAN->_yaml_dumpfile("$sfile.$$",$fullstats);
3748 local $CPAN::DEBUG = 512; # FTP
3750 CPAN->debug(sprintf("DEBUG history: before_read[%d]before[%d]at[%d]".
3751 "after[%d]at[%d]oldest[%s]dumped backat[%d]",
3755 # Win32 cannot rename a file to an existing filename
3756 unlink($sfile) if ($^O eq 'MSWin32');
3757 rename "$sfile.$$", $sfile
3758 or $CPAN::Frontend->mydie("Could not rename '$sfile.$$' to '$sfile': $!\n");
3762 # if file is CHECKSUMS, suggest the place where we got the file to be
3763 # checked from, maybe only for young files?
3764 #-> sub CPAN::FTP::_recommend_url_for
3765 sub _recommend_url_for {
3766 my($self, $file) = @_;
3767 my $urllist = $self->_get_urllist;
3768 if ($file =~ s|/CHECKSUMS(.gz)?$||) {
3769 my $fullstats = $self->_ftp_statistics();
3770 my $history = $fullstats->{history} || [];
3771 while (my $last = pop @$history) {
3772 last if $last->{end} - time > 3600; # only young results are interesting
3773 next unless $last->{file}; # dirname of nothing dies!
3774 next unless $file eq File::Basename::dirname($last->{file});
3775 return $last->{thesiteurl};
3778 if ($CPAN::Config->{randomize_urllist}
3780 rand(1) < $CPAN::Config->{randomize_urllist}
3782 $urllist->[int rand scalar @$urllist];
3788 #-> sub CPAN::FTP::_get_urllist
3791 $CPAN::Config->{urllist} ||= [];
3792 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
3793 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
3794 $CPAN::Config->{urllist} = [];
3796 my @urllist = grep { defined $_ and length $_ } @{$CPAN::Config->{urllist}};
3797 for my $u (@urllist) {
3798 CPAN->debug("u[$u]") if $CPAN::DEBUG;
3799 if (UNIVERSAL::can($u,"text")) {
3800 $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
3802 $u .= "/" unless substr($u,-1) eq "/";
3803 $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
3809 #-> sub CPAN::FTP::ftp_get ;
3811 my($class,$host,$dir,$file,$target) = @_;
3813 qq[Going to fetch file [$file] from dir [$dir]
3814 on host [$host] as local [$target]\n]
3816 my $ftp = Net::FTP->new($host);
3818 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
3821 return 0 unless defined $ftp;
3822 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
3823 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
3824 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ) {
3825 my $msg = $ftp->message;
3826 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
3829 unless ( $ftp->cwd($dir) ) {
3830 my $msg = $ftp->message;
3831 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
3835 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
3836 unless ( $ftp->get($file,$target) ) {
3837 my $msg = $ftp->message;
3838 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
3841 $ftp->quit; # it's ok if this fails
3845 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
3847 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
3848 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
3850 # > *** 1562,1567 ****
3851 # > --- 1562,1580 ----
3852 # > return 1 if substr($url,0,4) eq "file";
3853 # > return 1 unless $url =~ m|://([^/]+)|;
3855 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
3857 # > + $proxy =~ m|://([^/:]+)|;
3859 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
3860 # > + if ($noproxy) {
3861 # > + if ($host !~ /$noproxy$/) {
3862 # > + $host = $proxy;
3865 # > + $host = $proxy;
3868 # > require Net::Ping;
3869 # > return 1 unless $Net::Ping::VERSION >= 2;
3873 #-> sub CPAN::FTP::localize ;
3875 my($self,$file,$aslocal,$force) = @_;
3877 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
3878 unless defined $aslocal;
3879 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
3882 if ($^O eq 'MacOS') {
3883 # Comment by AK on 2000-09-03: Uniq short filenames would be
3884 # available in CHECKSUMS file
3885 my($name, $path) = File::Basename::fileparse($aslocal, '');
3886 if (length($name) > 31) {
3897 my $size = 31 - length($suf);
3898 while (length($name) > $size) {
3902 $aslocal = File::Spec->catfile($path, $name);
3906 if (-f $aslocal && -r _ && !($force & 1)) {
3908 if ($size = -s $aslocal) {
3909 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
3912 # empty file from a previous unsuccessful attempt to download it
3914 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
3915 "could not remove.");
3918 my($maybe_restore) = 0;
3920 rename $aslocal, "$aslocal.bak$$";
3924 my($aslocal_dir) = File::Basename::dirname($aslocal);
3925 $self->mymkpath($aslocal_dir); # too early for file URLs / RT #28438
3926 # Inheritance is not easier to manage than a few if/else branches
3927 if ($CPAN::META->has_usable('LWP::UserAgent')) {
3929 CPAN::LWP::UserAgent->config;
3930 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
3932 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
3936 $Ua->proxy('ftp', $var)
3937 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
3938 $Ua->proxy('http', $var)
3939 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
3941 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
3945 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
3946 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
3949 # Try the list of urls for each single object. We keep a record
3950 # where we did get a file from
3951 my(@reordered,$last);
3952 my $ccurllist = $self->_get_urllist;
3953 $last = $#$ccurllist;
3954 if ($force & 2) { # local cpans probably out of date, don't reorder
3955 @reordered = (0..$last);
3959 (substr($ccurllist->[$b],0,4) eq "file")
3961 (substr($ccurllist->[$a],0,4) eq "file")
3963 defined($ThesiteURL)
3965 ($ccurllist->[$b] eq $ThesiteURL)
3967 ($ccurllist->[$a] eq $ThesiteURL)
3972 $self->debug("Themethod[$Themethod]reordered[@reordered]") if $CPAN::DEBUG;
3978 ["dleasy", "http","defaultsites"],
3979 ["dlhard", "http","defaultsites"],
3980 ["dleasy", "ftp", "defaultsites"],
3981 ["dlhard", "ftp", "defaultsites"],
3982 ["dlhardest","", "defaultsites"],
3985 @levels = grep {$_->[0] eq $Themethod} @all_levels;
3986 push @levels, grep {$_->[0] ne $Themethod} @all_levels;
3988 @levels = @all_levels;
3990 @levels = qw/dleasy/ if $^O eq 'MacOS';
3992 local $ENV{FTP_PASSIVE} =
3993 exists $CPAN::Config->{ftp_passive} ?
3994 $CPAN::Config->{ftp_passive} : 1;
3996 my $stats = $self->_new_stats($file);
3997 LEVEL: for $levelno (0..$#levels) {
3998 my $level_tuple = $levels[$levelno];
3999 my($level,$scheme,$sitetag) = @$level_tuple;
4000 my $defaultsites = $sitetag && $sitetag eq "defaultsites";
4002 if ($defaultsites) {
4003 unless (defined $connect_to_internet_ok) {
4004 $CPAN::Frontend->myprint(sprintf qq{
4005 I would like to connect to one of the following sites to get '%s':
4010 join("",map { " ".$_->text."\n" } @CPAN::Defaultsites),
4012 my $answer = CPAN::Shell::colorable_makemaker_prompt("Is it OK to try to connect to the Internet?", "yes");
4013 if ($answer =~ /^y/i) {
4014 $connect_to_internet_ok = 1;
4016 $connect_to_internet_ok = 0;
4019 if ($connect_to_internet_ok) {
4020 @urllist = @CPAN::Defaultsites;
4025 my @host_seq = $level =~ /dleasy/ ?
4026 @reordered : 0..$last; # reordered has file and $Thesiteurl first
4027 @urllist = map { $ccurllist->[$_] } @host_seq;
4029 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
4030 my $aslocal_tempfile = $aslocal . ".tmp" . $$;
4031 if (my $recommend = $self->_recommend_url_for($file)) {
4032 @urllist = grep { $_ ne $recommend } @urllist;
4033 unshift @urllist, $recommend;
4035 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
4036 $ret = $self->hostdlxxx($level,$scheme,\@urllist,$file,$aslocal_tempfile,$stats);
4038 CPAN->debug("ret[$ret]aslocal[$aslocal]") if $CPAN::DEBUG;
4039 if ($ret eq $aslocal_tempfile) {
4040 # if we got it exactly as we asked for, only then we
4042 rename $aslocal_tempfile, $aslocal
4043 or $CPAN::Frontend->mydie("Error while trying to rename ".
4044 "'$ret' to '$aslocal': $!");
4047 $Themethod = $level;
4049 # utime $now, $now, $aslocal; # too bad, if we do that, we
4050 # might alter a local mirror
4051 $self->debug("level[$level]") if $CPAN::DEBUG;
4054 unlink $aslocal_tempfile;
4055 last if $CPAN::Signal; # need to cleanup
4059 $stats->{filesize} = -s $ret;
4061 $self->debug("before _add_to_statistics") if $CPAN::DEBUG;
4062 $self->_add_to_statistics($stats);
4063 $self->debug("after _add_to_statistics") if $CPAN::DEBUG;
4065 unlink "$aslocal.bak$$";
4068 unless ($CPAN::Signal) {
4071 if (@{$CPAN::Config->{urllist}}) {
4073 qq{Please check, if the URLs I found in your configuration file \(}.
4074 join(", ", @{$CPAN::Config->{urllist}}).
4077 push @mess, qq{Your urllist is empty!};
4079 push @mess, qq{The urllist can be edited.},
4080 qq{E.g. with 'o conf urllist push ftp://myurl/'};
4081 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
4082 $CPAN::Frontend->mywarn("Could not fetch $file\n");
4083 $CPAN::Frontend->mysleep(2);
4085 if ($maybe_restore) {
4086 rename "$aslocal.bak$$", $aslocal;
4087 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
4088 $self->ls($aslocal));
4095 my($self, $aslocal_dir) = @_;
4096 File::Path::mkpath($aslocal_dir);
4097 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
4098 qq{directory "$aslocal_dir".
4099 I\'ll continue, but if you encounter problems, they may be due
4100 to insufficient permissions.\n}) unless -w $aslocal_dir;
4108 $h = [ grep /^\Q$scheme\E:/, @$h ] if $scheme;
4109 my $method = "host$level";
4110 $self->$method($h, @_);
4114 my($self,$stats,$method,$url) = @_;
4115 push @{$stats->{attempts}}, {
4122 # package CPAN::FTP;
4124 my($self,$host_seq,$file,$aslocal,$stats) = @_;
4126 HOSTEASY: for $ro_url (@$host_seq) {
4127 $self->_set_attempt($stats,"dleasy",$ro_url);
4128 my $url .= "$ro_url$file";
4129 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
4130 if ($url =~ /^file:/) {
4132 if ($CPAN::META->has_inst('URI::URL')) {
4133 my $u = URI::URL->new($url);
4135 } else { # works only on Unix, is poorly constructed, but
4136 # hopefully better than nothing.
4137 # RFC 1738 says fileurl BNF is
4138 # fileurl = "file://" [ host | "localhost" ] "/" fpath
4139 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
4141 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
4142 $l =~ s|^file:||; # assume they
4146 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
4148 $self->debug("local file[$l]") if $CPAN::DEBUG;
4149 if ( -f $l && -r _) {
4150 $ThesiteURL = $ro_url;
4153 if ($l =~ /(.+)\.gz$/) {
4155 if ( -f $ungz && -r _) {
4156 $ThesiteURL = $ro_url;
4160 # Maybe mirror has compressed it?
4162 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
4163 eval { CPAN::Tarzip->new("$l.gz")->gunzip($aslocal) };
4165 $ThesiteURL = $ro_url;
4169 $CPAN::Frontend->mywarn("Could not find '$l'\n");
4171 $self->debug("it was not a file URL") if $CPAN::DEBUG;
4172 if ($CPAN::META->has_usable('LWP')) {
4173 $CPAN::Frontend->myprint("Fetching with LWP:
4177 CPAN::LWP::UserAgent->config;
4178 eval { $Ua = CPAN::LWP::UserAgent->new; };
4180 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
4183 my $res = $Ua->mirror($url, $aslocal);
4184 if ($res->is_success) {
4185 $ThesiteURL = $ro_url;
4187 utime $now, $now, $aslocal; # download time is more
4188 # important than upload
4191 } elsif ($url !~ /\.gz(?!\n)\Z/) {
4192 my $gzurl = "$url.gz";
4193 $CPAN::Frontend->myprint("Fetching with LWP:
4196 $res = $Ua->mirror($gzurl, "$aslocal.gz");
4197 if ($res->is_success) {
4198 if (eval {CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)}) {
4199 $ThesiteURL = $ro_url;
4204 $CPAN::Frontend->myprint(sprintf(
4205 "LWP failed with code[%s] message[%s]\n",
4209 # Alan Burlison informed me that in firewall environments
4210 # Net::FTP can still succeed where LWP fails. So we do not
4211 # skip Net::FTP anymore when LWP is available.
4214 $CPAN::Frontend->mywarn(" LWP not available\n");
4216 return if $CPAN::Signal;
4217 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
4218 # that's the nice and easy way thanks to Graham
4219 $self->debug("recognized ftp") if $CPAN::DEBUG;
4220 my($host,$dir,$getfile) = ($1,$2,$3);
4221 if ($CPAN::META->has_usable('Net::FTP')) {
4223 $CPAN::Frontend->myprint("Fetching with Net::FTP:
4226 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
4227 "aslocal[$aslocal]") if $CPAN::DEBUG;
4228 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
4229 $ThesiteURL = $ro_url;
4232 if ($aslocal !~ /\.gz(?!\n)\Z/) {
4233 my $gz = "$aslocal.gz";
4234 $CPAN::Frontend->myprint("Fetching with Net::FTP
4237 if (CPAN::FTP->ftp_get($host,
4241 eval{CPAN::Tarzip->new($gz)->gunzip($aslocal)}
4243 $ThesiteURL = $ro_url;
4249 CPAN->debug("Net::FTP does not count as usable atm") if $CPAN::DEBUG;
4253 UNIVERSAL::can($ro_url,"text")
4255 $ro_url->{FROM} eq "USER"
4257 ##address #17973: default URLs should not try to override
4258 ##user-defined URLs just because LWP is not available
4259 my $ret = $self->hostdlhard([$ro_url],$file,$aslocal,$stats);
4260 return $ret if $ret;
4262 return if $CPAN::Signal;
4266 # package CPAN::FTP;
4268 my($self,$host_seq,$file,$aslocal,$stats) = @_;
4270 # Came back if Net::FTP couldn't establish connection (or
4271 # failed otherwise) Maybe they are behind a firewall, but they
4272 # gave us a socksified (or other) ftp program...
4275 my($devnull) = $CPAN::Config->{devnull} || "";
4277 my($aslocal_dir) = File::Basename::dirname($aslocal);
4278 File::Path::mkpath($aslocal_dir);
4279 HOSTHARD: for $ro_url (@$host_seq) {
4280 $self->_set_attempt($stats,"dlhard",$ro_url);
4281 my $url = "$ro_url$file";
4282 my($proto,$host,$dir,$getfile);
4284 # Courtesy Mark Conty mark_conty@cargill.com change from
4285 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
4287 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
4288 # proto not yet used
4289 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
4291 next HOSTHARD; # who said, we could ftp anything except ftp?
4293 next HOSTHARD if $proto eq "file"; # file URLs would have had
4294 # success above. Likely a bogus URL
4296 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
4298 # Try the most capable first and leave ncftp* for last as it only
4300 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
4301 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
4302 next unless defined $funkyftp;
4303 next if $funkyftp =~ /^\s*$/;
4305 my($asl_ungz, $asl_gz);
4306 ($asl_ungz = $aslocal) =~ s/\.gz//;
4307 $asl_gz = "$asl_ungz.gz";
4309 my($src_switch) = "";
4311 my($stdout_redir) = " > $asl_ungz";
4313 $src_switch = " -source";
4314 } elsif ($f eq "ncftp") {
4315 $src_switch = " -c";
4316 } elsif ($f eq "wget") {
4317 $src_switch = " -O $asl_ungz";
4319 } elsif ($f eq 'curl') {
4320 $src_switch = ' -L -f -s -S --netrc-optional';
4323 if ($f eq "ncftpget") {
4324 $chdir = "cd $aslocal_dir && ";
4327 $CPAN::Frontend->myprint(
4329 Trying with "$funkyftp$src_switch" to get
4333 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
4334 $self->debug("system[$system]") if $CPAN::DEBUG;
4335 my($wstatus) = system($system);
4337 # lynx returns 0 when it fails somewhere
4339 my $content = do { local *FH;
4340 open FH, $asl_ungz or die;
4343 if ($content =~ /^<.*(<title>[45]|Error [45])/si) {
4344 $CPAN::Frontend->mywarn(qq{
4345 No success, the file that lynx has downloaded looks like an error message:
4348 $CPAN::Frontend->mysleep(1);
4352 $CPAN::Frontend->myprint(qq{
4353 No success, the file that lynx has downloaded is an empty file.
4358 if ($wstatus == 0) {
4361 } elsif ($asl_ungz ne $aslocal) {
4362 # test gzip integrity
4363 if (eval{CPAN::Tarzip->new($asl_ungz)->gtest}) {
4364 # e.g. foo.tar is gzipped --> foo.tar.gz
4365 rename $asl_ungz, $aslocal;
4367 eval{CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz)};
4370 $ThesiteURL = $ro_url;
4372 } elsif ($url !~ /\.gz(?!\n)\Z/) {
4374 -f $asl_ungz && -s _ == 0;
4375 my $gz = "$aslocal.gz";
4376 my $gzurl = "$url.gz";
4377 $CPAN::Frontend->myprint(
4379 Trying with "$funkyftp$src_switch" to get
4382 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
4383 $self->debug("system[$system]") if $CPAN::DEBUG;
4385 if (($wstatus = system($system)) == 0
4389 # test gzip integrity
4390 my $ct = eval{CPAN::Tarzip->new($asl_gz)};
4391 if ($ct && $ct->gtest) {
4392 $ct->gunzip($aslocal);
4394 # somebody uncompressed file for us?
4395 rename $asl_ungz, $aslocal;
4397 $ThesiteURL = $ro_url;
4400 unlink $asl_gz if -f $asl_gz;
4403 my $estatus = $wstatus >> 8;
4404 my $size = -f $aslocal ?
4405 ", left\n$aslocal with size ".-s _ :
4406 "\nWarning: expected file [$aslocal] doesn't exist";
4407 $CPAN::Frontend->myprint(qq{
4408 System call "$system"
4409 returned status $estatus (wstat $wstatus)$size
4412 return if $CPAN::Signal;
4413 } # transfer programs
4417 # package CPAN::FTP;
4419 my($self,$host_seq,$file,$aslocal,$stats) = @_;
4421 return unless @$host_seq;
4423 my($aslocal_dir) = File::Basename::dirname($aslocal);
4424 File::Path::mkpath($aslocal_dir);
4425 my $ftpbin = $CPAN::Config->{ftp};
4426 unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) {
4427 $CPAN::Frontend->myprint("No external ftp command available\n\n");
4430 $CPAN::Frontend->mywarn(qq{
4431 As a last ressort we now switch to the external ftp command '$ftpbin'
4434 Doing so often leads to problems that are hard to diagnose.
4436 If you're victim of such problems, please consider unsetting the ftp
4437 config variable with
4443 $CPAN::Frontend->mysleep(2);
4444 HOSTHARDEST: for $ro_url (@$host_seq) {
4445 $self->_set_attempt($stats,"dlhardest",$ro_url);
4446 my $url = "$ro_url$file";
4447 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
4448 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
4451 my($host,$dir,$getfile) = ($1,$2,$3);
4453 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
4454 $ctime,$blksize,$blocks) = stat($aslocal);
4455 $timestamp = $mtime ||= 0;
4456 my($netrc) = CPAN::FTP::netrc->new;
4457 my($netrcfile) = $netrc->netrc;
4458 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
4459 my $targetfile = File::Basename::basename($aslocal);
4465 map("cd $_", split /\//, $dir), # RFC 1738
4467 "get $getfile $targetfile",
4471 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
4472 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
4473 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
4475 $netrc->contains($host))) if $CPAN::DEBUG;
4476 if ($netrc->protected) {
4477 my $dialog = join "", map { " $_\n" } @dialog;
4479 if ($netrc->contains($host)) {
4480 $netrc_explain = "Relying that your .netrc entry for '$host' ".
4481 "manages the login";
4483 $netrc_explain = "Relying that your default .netrc entry ".
4484 "manages the login";
4486 $CPAN::Frontend->myprint(qq{
4487 Trying with external ftp to get
4490 Going to send the dialog
4494 $self->talk_ftp("$ftpbin$verbose $host",
4496 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4497 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
4499 if ($mtime > $timestamp) {
4500 $CPAN::Frontend->myprint("GOT $aslocal\n");
4501 $ThesiteURL = $ro_url;
4504 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
4506 return if $CPAN::Signal;
4508 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
4509 qq{correctly protected.\n});
4512 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
4513 nor does it have a default entry\n");
4516 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
4517 # then and login manually to host, using e-mail as
4519 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
4523 "user anonymous $Config::Config{'cf_email'}"
4525 my $dialog = join "", map { " $_\n" } @dialog;
4526 $CPAN::Frontend->myprint(qq{
4527 Trying with external ftp to get
4529 Going to send the dialog
4533 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
4534 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4535 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
4537 if ($mtime > $timestamp) {
4538 $CPAN::Frontend->myprint("GOT $aslocal\n");
4539 $ThesiteURL = $ro_url;
4542 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
4544 return if $CPAN::Signal;
4545 $CPAN::Frontend->mywarn("Can't access URL $url.\n\n");
4546 $CPAN::Frontend->mysleep(2);
4550 # package CPAN::FTP;
4552 my($self,$command,@dialog) = @_;
4553 my $fh = FileHandle->new;
4554 $fh->open("|$command") or die "Couldn't open ftp: $!";
4555 foreach (@dialog) { $fh->print("$_\n") }
4556 $fh->close; # Wait for process to complete
4558 my $estatus = $wstatus >> 8;
4559 $CPAN::Frontend->myprint(qq{
4560 Subprocess "|$command"
4561 returned status $estatus (wstat $wstatus)
4565 # find2perl needs modularization, too, all the following is stolen
4569 my($self,$name) = @_;
4570 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
4571 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
4573 my($perms,%user,%group);
4577 $blocks = int(($blocks + 1) / 2);
4580 $blocks = int(($sizemm + 1023) / 1024);
4583 if (-f _) { $perms = '-'; }
4584 elsif (-d _) { $perms = 'd'; }
4585 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
4586 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
4587 elsif (-p _) { $perms = 'p'; }
4588 elsif (-S _) { $perms = 's'; }
4589 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
4591 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
4592 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
4593 my $tmpmode = $mode;
4594 my $tmp = $rwx[$tmpmode & 7];
4596 $tmp = $rwx[$tmpmode & 7] . $tmp;
4598 $tmp = $rwx[$tmpmode & 7] . $tmp;
4599 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
4600 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
4601 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
4604 my $user = $user{$uid} || $uid; # too lazy to implement lookup
4605 my $group = $group{$gid} || $gid;
4607 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
4609 my($moname) = $moname[$mon];
4610 if (-M _ > 365.25 / 2) {
4611 $timeyear = $year + 1900;
4614 $timeyear = sprintf("%02d:%02d", $hour, $min);
4617 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
4631 package CPAN::FTP::netrc;
4634 # package CPAN::FTP::netrc;
4637 my $home = CPAN::HandleConfig::home;
4638 my $file = File::Spec->catfile($home,".netrc");
4640 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4641 $atime,$mtime,$ctime,$blksize,$blocks)
4646 my($fh,@machines,$hasdefault);
4648 $fh = FileHandle->new or die "Could not create a filehandle";
4650 if($fh->open($file)) {
4651 $protected = ($mode & 077) == 0;
4653 NETRC: while (<$fh>) {
4654 my(@tokens) = split " ", $_;
4655 TOKEN: while (@tokens) {
4656 my($t) = shift @tokens;
4657 if ($t eq "default") {
4661 last TOKEN if $t eq "macdef";
4662 if ($t eq "machine") {
4663 push @machines, shift @tokens;
4668 $file = $hasdefault = $protected = "";
4672 'mach' => [@machines],
4674 'hasdefault' => $hasdefault,
4675 'protected' => $protected,
4679 # CPAN::FTP::netrc::hasdefault;
4680 sub hasdefault { shift->{'hasdefault'} }
4681 sub netrc { shift->{'netrc'} }
4682 sub protected { shift->{'protected'} }
4684 my($self,$mach) = @_;
4685 for ( @{$self->{'mach'}} ) {
4686 return 1 if $_ eq $mach;
4691 package CPAN::Complete;
4695 my($text, $line, $start, $end) = @_;
4696 my(@perlret) = cpl($text, $line, $start);
4697 # find longest common match. Can anybody show me how to peruse
4698 # T::R::Gnu to have this done automatically? Seems expensive.
4699 return () unless @perlret;
4700 my($newtext) = $text;
4701 for (my $i = length($text)+1;;$i++) {
4702 last unless length($perlret[0]) && length($perlret[0]) >= $i;
4703 my $try = substr($perlret[0],0,$i);
4704 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
4705 # warn "try[$try]tries[@tries]";
4706 if (@tries == @perlret) {
4712 ($newtext,@perlret);
4715 #-> sub CPAN::Complete::cpl ;
4717 my($word,$line,$pos) = @_;
4721 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4723 if ($line =~ s/^((?:notest|f?force)\s*)//) {
4727 if ($pos == 0 || $line =~ /^(?:h(?:elp)?|\?)\s/) {
4728 @return = grep /^\Q$word\E/, @CPAN::Complete::COMMANDS;
4729 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
4731 } elsif ($line =~ /^(a|ls)\s/) {
4732 @return = cplx('CPAN::Author',uc($word));
4733 } elsif ($line =~ /^b\s/) {
4734 CPAN::Shell->local_bundles;
4735 @return = cplx('CPAN::Bundle',$word);
4736 } elsif ($line =~ /^d\s/) {
4737 @return = cplx('CPAN::Distribution',$word);
4738 } elsif ($line =~ m/^(
4739 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
4741 if ($word =~ /^Bundle::/) {
4742 CPAN::Shell->local_bundles;
4744 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
4745 } elsif ($line =~ /^i\s/) {
4746 @return = cpl_any($word);
4747 } elsif ($line =~ /^reload\s/) {
4748 @return = cpl_reload($word,$line,$pos);
4749 } elsif ($line =~ /^o\s/) {
4750 @return = cpl_option($word,$line,$pos);
4751 } elsif ($line =~ m/^\S+\s/ ) {
4752 # fallback for future commands and what we have forgotten above
4753 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
4760 #-> sub CPAN::Complete::cplx ;
4762 my($class, $word) = @_;
4763 if (CPAN::_sqlite_running) {
4764 $CPAN::SQLite->search($class, "^\Q$word\E");
4766 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
4769 #-> sub CPAN::Complete::cpl_any ;
4773 cplx('CPAN::Author',$word),
4774 cplx('CPAN::Bundle',$word),
4775 cplx('CPAN::Distribution',$word),
4776 cplx('CPAN::Module',$word),
4780 #-> sub CPAN::Complete::cpl_reload ;
4782 my($word,$line,$pos) = @_;
4784 my(@words) = split " ", $line;
4785 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4786 my(@ok) = qw(cpan index);
4787 return @ok if @words == 1;
4788 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
4791 #-> sub CPAN::Complete::cpl_option ;
4793 my($word,$line,$pos) = @_;
4795 my(@words) = split " ", $line;
4796 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4797 my(@ok) = qw(conf debug);
4798 return @ok if @words == 1;
4799 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
4801 } elsif ($words[1] eq 'index') {
4803 } elsif ($words[1] eq 'conf') {
4804 return CPAN::HandleConfig::cpl(@_);
4805 } elsif ($words[1] eq 'debug') {
4806 return sort grep /^\Q$word\E/i,
4807 sort keys %CPAN::DEBUG, 'all';
4811 package CPAN::Index;
4814 #-> sub CPAN::Index::force_reload ;
4817 $CPAN::Index::LAST_TIME = 0;
4821 #-> sub CPAN::Index::reload ;
4823 my($self,$force) = @_;
4826 # XXX check if a newer one is available. (We currently read it
4827 # from time to time)
4828 for ($CPAN::Config->{index_expire}) {
4829 $_ = 0.001 unless $_ && $_ > 0.001;
4831 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
4832 # debug here when CPAN doesn't seem to read the Metadata
4834 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
4836 unless ($CPAN::META->{PROTOCOL}) {
4837 $self->read_metadata_cache;
4838 $CPAN::META->{PROTOCOL} ||= "1.0";
4840 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
4841 # warn "Setting last_time to 0";
4842 $LAST_TIME = 0; # No warning necessary
4844 if ($LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
4847 # CPAN->debug("LAST_TIME[$LAST_TIME]index_expire[$CPAN::Config->{index_expire}]time[$time]");
4849 # IFF we are developing, it helps to wipe out the memory
4850 # between reloads, otherwise it is not what a user expects.
4851 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
4852 $CPAN::META = CPAN->new;
4855 local $LAST_TIME = $time;
4856 local $CPAN::META->{PROTOCOL} = PROTOCOL;
4858 my $needshort = $^O eq "dos";
4860 $self->rd_authindex($self
4862 "authors/01mailrc.txt.gz",
4864 File::Spec->catfile('authors', '01mailrc.gz') :
4865 File::Spec->catfile('authors', '01mailrc.txt.gz'),
4868 $debug = "timing reading 01[".($t2 - $time)."]";
4870 return if $CPAN::Signal; # this is sometimes lengthy
4871 $self->rd_modpacks($self
4873 "modules/02packages.details.txt.gz",
4875 File::Spec->catfile('modules', '02packag.gz') :
4876 File::Spec->catfile('modules', '02packages.details.txt.gz'),
4879 $debug .= "02[".($t2 - $time)."]";
4881 return if $CPAN::Signal; # this is sometimes lengthy
4882 $self->rd_modlist($self
4884 "modules/03modlist.data.gz",
4886 File::Spec->catfile('modules', '03mlist.gz') :
4887 File::Spec->catfile('modules', '03modlist.data.gz'),
4889 $self->write_metadata_cache;
4891 $debug .= "03[".($t2 - $time)."]";
4893 CPAN->debug($debug) if $CPAN::DEBUG;
4895 if ($CPAN::Config->{build_dir_reuse}) {
4896 $self->reanimate_build_dir;
4898 if (CPAN::_sqlite_running) {
4899 $CPAN::SQLite->reload(time => $time, force => $force)
4903 $CPAN::META->{PROTOCOL} = PROTOCOL;
4906 #-> sub CPAN::Index::reanimate_build_dir ;
4907 sub reanimate_build_dir {
4909 unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module}||"YAML")) {
4912 return if $HAVE_REANIMATED++;
4913 my $d = $CPAN::Config->{build_dir};
4914 my $dh = DirHandle->new;
4915 opendir $dh, $d or return; # does not exist
4920 $CPAN::Frontend->myprint("Going to read $CPAN::Config->{build_dir}/\n");
4921 my @candidates = map { $_->[0] }
4922 sort { $b->[1] <=> $a->[1] }
4923 map { [ $_, -M File::Spec->catfile($d,$_) ] }
4924 grep {/\.yml$/} readdir $dh;
4925 DISTRO: for $i (0..$#candidates) {
4926 my $dirent = $candidates[$i];
4927 my $y = eval {CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))};
4929 warn "Error while parsing file '$dirent'; error: '$@'";
4933 if ($c && CPAN->_perl_fingerprint($c->{perl})) {
4934 my $key = $c->{distribution}{ID};
4935 for my $k (keys %{$c->{distribution}}) {
4936 if ($c->{distribution}{$k}
4937 && ref $c->{distribution}{$k}
4938 && UNIVERSAL::isa($c->{distribution}{$k},"CPAN::Distrostatus")) {
4939 $c->{distribution}{$k}{COMMANDID} = $i - @candidates;
4943 #we tried to restore only if element already
4944 #exists; but then we do not work with metadata
4947 = $CPAN::META->{readwrite}{'CPAN::Distribution'}{$key}
4948 = $c->{distribution};
4949 for my $skipper (qw(
4951 configure_requires_later
4952 configure_requires_later_for
4960 delete $do->{$skipper};
4963 if ($do->{make_test}
4965 && !(UNIVERSAL::can($do->{make_test},"failed") ?
4966 $do->{make_test}->failed :
4967 $do->{make_test} =~ /^YES/
4972 $do->{install}->failed
4975 $CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME});
4980 while (($painted/76) < ($i/@candidates)) {
4981 $CPAN::Frontend->myprint(".");
4985 $CPAN::Frontend->myprint(sprintf(
4986 "DONE\nFound %s old build%s, restored the state of %s\n",
4987 @candidates ? sprintf("%d",scalar @candidates) : "no",
4988 @candidates==1 ? "" : "s",
4989 $restored || "none",
4994 #-> sub CPAN::Index::reload_x ;
4996 my($cl,$wanted,$localname,$force) = @_;
4997 $force |= 2; # means we're dealing with an index here
4998 CPAN::HandleConfig->load; # we should guarantee loading wherever
4999 # we rely on Config XXX
5000 $localname ||= $wanted;
5001 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
5005 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
5008 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
5009 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
5010 qq{day$s. I\'ll use that.});
5013 $force |= 1; # means we're quite serious about it.
5015 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
5018 #-> sub CPAN::Index::rd_authindex ;
5020 my($cl, $index_target) = @_;
5021 return unless defined $index_target;
5022 return if CPAN::_sqlite_running;
5024 $CPAN::Frontend->myprint("Going to read $index_target\n");
5026 tie *FH, 'CPAN::Tarzip', $index_target;
5029 push @lines, split /\012/ while <FH>;
5033 my($userid,$fullname,$email) =
5034 m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/;
5035 $fullname ||= $email;
5036 if ($userid && $fullname && $email) {
5037 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
5038 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
5040 CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG;
5043 while (($painted/76) < ($i/@lines)) {
5044 $CPAN::Frontend->myprint(".");
5047 return if $CPAN::Signal;
5049 $CPAN::Frontend->myprint("DONE\n");
5053 my($self,$dist) = @_;
5054 $dist = $self->{'id'} unless defined $dist;
5055 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
5059 #-> sub CPAN::Index::rd_modpacks ;
5061 my($self, $index_target) = @_;
5062 return unless defined $index_target;
5063 return if CPAN::_sqlite_running;
5064 $CPAN::Frontend->myprint("Going to read $index_target\n");
5065 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
5067 CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
5070 while (my $bytes = $fh->READ(\$chunk,8192)) {
5073 my @lines = split /\012/, $slurp;
5074 CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG;
5077 my($line_count,$last_updated);
5079 my $shift = shift(@lines);
5080 last if $shift =~ /^\s*$/;
5081 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
5082 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
5084 CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
5085 if (not defined $line_count) {
5087 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
5088 Please check the validity of the index file by comparing it to more
5089 than one CPAN mirror. I'll continue but problems seem likely to
5093 $CPAN::Frontend->mysleep(5);
5094 } elsif ($line_count != scalar @lines) {
5096 $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
5097 contains a Line-Count header of %d but I see %d lines there. Please
5098 check the validity of the index file by comparing it to more than one
5099 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
5100 $index_target, $line_count, scalar(@lines));
5103 if (not defined $last_updated) {
5105 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
5106 Please check the validity of the index file by comparing it to more
5107 than one CPAN mirror. I'll continue but problems seem likely to
5111 $CPAN::Frontend->mysleep(5);
5115 ->myprint(sprintf qq{ Database was generated on %s\n},
5117 $DATE_OF_02 = $last_updated;
5120 if ($CPAN::META->has_inst('HTTP::Date')) {
5122 $age -= HTTP::Date::str2time($last_updated);
5124 $CPAN::Frontend->mywarn(" HTTP::Date not available\n");
5125 require Time::Local;
5126 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
5127 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
5128 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
5135 qq{Warning: This index file is %d days old.
5136 Please check the host you chose as your CPAN mirror for staleness.
5137 I'll continue but problems seem likely to happen.\a\n},
5140 } elsif ($age < -1) {
5144 qq{Warning: Your system date is %d days behind this index file!
5146 Timestamp index file: %s
5147 Please fix your system time, problems with the make command expected.\n},
5157 # A necessity since we have metadata_cache: delete what isn't
5159 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
5160 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
5165 # before 1.56 we split into 3 and discarded the rest. From
5166 # 1.57 we assign remaining text to $comment thus allowing to
5167 # influence isa_perl
5168 my($mod,$version,$dist,$comment) = split " ", $_, 4;
5169 my($bundle,$id,$userid);
5171 if ($mod eq 'CPAN' &&
5173 CPAN::Queue->exists('Bundle::CPAN') ||
5174 CPAN::Queue->exists('CPAN')
5178 if ($version > $CPAN::VERSION) {
5179 $CPAN::Frontend->mywarn(qq{
5180 New CPAN.pm version (v$version) available.
5181 [Currently running version is v$CPAN::VERSION]
5182 You might want to try
5185 to both upgrade CPAN.pm and run the new version without leaving
5186 the current session.
5189 $CPAN::Frontend->mysleep(2);
5190 $CPAN::Frontend->myprint(qq{\n});
5192 last if $CPAN::Signal;
5193 } elsif ($mod =~ /^Bundle::(.*)/) {
5198 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
5199 # Let's make it a module too, because bundles have so much
5200 # in common with modules.
5202 # Changed in 1.57_63: seems like memory bloat now without
5203 # any value, so commented out
5205 # $CPAN::META->instance('CPAN::Module',$mod);
5209 # instantiate a module object
5210 $id = $CPAN::META->instance('CPAN::Module',$mod);
5214 # Although CPAN prohibits same name with different version the
5215 # indexer may have changed the version for the same distro
5216 # since the last time ("Force Reindexing" feature)
5217 if ($id->cpan_file ne $dist
5219 $id->cpan_version ne $version
5221 $userid = $id->userid || $self->userid($dist);
5223 'CPAN_USERID' => $userid,
5224 'CPAN_VERSION' => $version,
5225 'CPAN_FILE' => $dist,
5229 # instantiate a distribution object
5230 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
5231 # we do not need CONTAINSMODS unless we do something with
5232 # this dist, so we better produce it on demand.
5234 ## my $obj = $CPAN::META->instance(
5235 ## 'CPAN::Distribution' => $dist
5237 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
5239 $CPAN::META->instance(
5240 'CPAN::Distribution' => $dist
5242 'CPAN_USERID' => $userid,
5243 'CPAN_COMMENT' => $comment,
5247 for my $name ($mod,$dist) {
5248 # $self->debug("exists name[$name]") if $CPAN::DEBUG;
5249 $exists{$name} = undef;
5253 while (($painted/76) < ($i/@lines)) {
5254 $CPAN::Frontend->myprint(".");
5257 return if $CPAN::Signal;
5259 $CPAN::Frontend->myprint("DONE\n");
5261 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
5262 for my $o ($CPAN::META->all_objects($class)) {
5263 next if exists $exists{$o->{ID}};
5264 $CPAN::META->delete($class,$o->{ID});
5265 # CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
5272 #-> sub CPAN::Index::rd_modlist ;
5274 my($cl,$index_target) = @_;
5275 return unless defined $index_target;
5276 return if CPAN::_sqlite_running;
5277 $CPAN::Frontend->myprint("Going to read $index_target\n");
5278 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
5282 while (my $bytes = $fh->READ(\$chunk,8192)) {
5285 my @eval2 = split /\012/, $slurp;
5288 my $shift = shift(@eval2);
5289 if ($shift =~ /^Date:\s+(.*)/) {
5290 if ($DATE_OF_03 eq $1) {
5291 $CPAN::Frontend->myprint("Unchanged.\n");
5296 last if $shift =~ /^\s*$/;
5298 push @eval2, q{CPAN::Modulelist->data;};
5300 my($comp) = Safe->new("CPAN::Safe1");
5301 my($eval2) = join("\n", @eval2);
5302 CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
5303 my $ret = $comp->reval($eval2);
5304 Carp::confess($@) if $@;
5305 return if $CPAN::Signal;
5307 my $until = keys(%$ret);
5309 CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
5311 my $obj = $CPAN::META->instance("CPAN::Module",$_);
5312 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
5313 $obj->set(%{$ret->{$_}});
5315 while (($painted/76) < ($i/$until)) {
5316 $CPAN::Frontend->myprint(".");
5319 return if $CPAN::Signal;
5321 $CPAN::Frontend->myprint("DONE\n");
5324 #-> sub CPAN::Index::write_metadata_cache ;
5325 sub write_metadata_cache {
5327 return unless $CPAN::Config->{'cache_metadata'};
5328 return if CPAN::_sqlite_running;
5329 return unless $CPAN::META->has_usable("Storable");
5331 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
5332 CPAN::Distribution)) {
5333 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
5335 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
5336 $cache->{last_time} = $LAST_TIME;
5337 $cache->{DATE_OF_02} = $DATE_OF_02;
5338 $cache->{PROTOCOL} = PROTOCOL;
5339 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
5340 eval { Storable::nstore($cache, $metadata_file) };
5341 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
5344 #-> sub CPAN::Index::read_metadata_cache ;
5345 sub read_metadata_cache {
5347 return unless $CPAN::Config->{'cache_metadata'};
5348 return if CPAN::_sqlite_running;
5349 return unless $CPAN::META->has_usable("Storable");
5350 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
5351 return unless -r $metadata_file and -f $metadata_file;
5352 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
5354 eval { $cache = Storable::retrieve($metadata_file) };
5355 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
5356 if (!$cache || !UNIVERSAL::isa($cache, 'HASH')) {
5360 if (exists $cache->{PROTOCOL}) {
5361 if (PROTOCOL > $cache->{PROTOCOL}) {
5362 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
5363 "with protocol v%s, requiring v%s\n",
5370 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
5371 "with protocol v1.0\n");
5376 while(my($class,$v) = each %$cache) {
5377 next unless $class =~ /^CPAN::/;
5378 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
5379 while (my($id,$ro) = each %$v) {
5380 $CPAN::META->{readwrite}{$class}{$id} ||=
5381 $class->new(ID=>$id, RO=>$ro);
5386 unless ($clcnt) { # sanity check
5387 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
5390 if ($idcnt < 1000) {
5391 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
5392 "in $metadata_file\n");
5395 $CPAN::META->{PROTOCOL} ||=
5396 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
5397 # does initialize to some protocol
5398 $LAST_TIME = $cache->{last_time};
5399 $DATE_OF_02 = $cache->{DATE_OF_02};
5400 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
5401 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
5405 package CPAN::InfoObj;
5410 exists $self->{RO} and return $self->{RO};
5413 #-> sub CPAN::InfoObj::cpan_userid
5418 return $ro->{CPAN_USERID} || "N/A";
5420 $self->debug("ID[$self->{ID}]");
5421 # N/A for bundles found locally
5426 sub id { shift->{ID}; }
5428 #-> sub CPAN::InfoObj::new ;
5430 my $this = bless {}, shift;
5435 # The set method may only be used by code that reads index data or
5436 # otherwise "objective" data from the outside world. All session
5437 # related material may do anything else with instance variables but
5438 # must not touch the hash under the RO attribute. The reason is that
5439 # the RO hash gets written to Metadata file and is thus persistent.
5441 #-> sub CPAN::InfoObj::safe_chdir ;
5443 my($self,$todir) = @_;
5444 # we die if we cannot chdir and we are debuggable
5445 Carp::confess("safe_chdir called without todir argument")
5446 unless defined $todir and length $todir;
5448 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
5452 unless (-x $todir) {
5453 unless (chmod 0755, $todir) {
5454 my $cwd = CPAN::anycwd();
5455 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
5456 "permission to change the permission; cannot ".
5457 "chdir to '$todir'\n");
5458 $CPAN::Frontend->mysleep(5);
5459 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
5460 qq{to todir[$todir]: $!});
5464 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
5467 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
5470 my $cwd = CPAN::anycwd();
5471 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
5472 qq{to todir[$todir] (a chmod has been issued): $!});
5477 #-> sub CPAN::InfoObj::set ;
5479 my($self,%att) = @_;
5480 my $class = ref $self;
5482 # This must be ||=, not ||, because only if we write an empty
5483 # reference, only then the set method will write into the readonly
5484 # area. But for Distributions that spring into existence, maybe
5485 # because of a typo, we do not like it that they are written into
5486 # the readonly area and made permanent (at least for a while) and
5487 # that is why we do not "allow" other places to call ->set.
5488 unless ($self->id) {
5489 CPAN->debug("Bug? Empty ID, rejecting");
5492 my $ro = $self->{RO} =
5493 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
5495 while (my($k,$v) = each %att) {
5500 #-> sub CPAN::InfoObj::as_glimpse ;
5504 my $class = ref($self);
5505 $class =~ s/^CPAN:://;
5506 my $id = $self->can("pretty_id") ? $self->pretty_id : $self->{ID};
5507 push @m, sprintf "%-15s %s\n", $class, $id;
5511 #-> sub CPAN::InfoObj::as_string ;
5515 my $class = ref($self);
5516 $class =~ s/^CPAN:://;
5517 push @m, $class, " id = $self->{ID}\n";
5519 unless ($ro = $self->ro) {
5520 if (substr($self->{ID},-1,1) eq ".") { # directory
5523 $CPAN::Frontend->mywarn("Unknown object $self->{ID}\n");
5524 $CPAN::Frontend->mysleep(5);
5528 for (sort keys %$ro) {
5529 # next if m/^(ID|RO)$/;
5531 if ($_ eq "CPAN_USERID") {
5533 $extra .= $self->fullname;
5534 my $email; # old perls!
5535 if ($email = $CPAN::META->instance("CPAN::Author",
5538 $extra .= " <$email>";
5540 $extra .= " <no email>";
5543 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
5544 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
5547 next unless defined $ro->{$_};
5548 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
5550 KEY: for (sort keys %$self) {
5551 next if m/^(ID|RO)$/;
5552 unless (defined $self->{$_}) {
5556 if (ref($self->{$_}) eq "ARRAY") {
5557 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
5558 } elsif (ref($self->{$_}) eq "HASH") {
5560 if (/^CONTAINSMODS$/) {
5561 $value = join(" ",sort keys %{$self->{$_}});
5562 } elsif (/^prereq_pm$/) {
5564 my $v = $self->{$_};
5565 for my $x (sort keys %$v) {
5567 for my $y (sort keys %{$v->{$x}}) {
5568 push @svalue, "$y=>$v->{$x}{$y}";
5570 push @value, "$x\:" . join ",", @svalue if @svalue;
5572 $value = join ";", @value;
5574 $value = $self->{$_};
5582 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
5588 #-> sub CPAN::InfoObj::fullname ;
5591 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
5594 #-> sub CPAN::InfoObj::dump ;
5596 my($self, $what) = @_;
5597 unless ($CPAN::META->has_inst("Data::Dumper")) {
5598 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
5600 local $Data::Dumper::Sortkeys;
5601 $Data::Dumper::Sortkeys = 1;
5602 my $out = Data::Dumper::Dumper($what ? eval $what : $self);
5603 if (length $out > 100000) {
5604 my $fh_pager = FileHandle->new;
5605 local($SIG{PIPE}) = "IGNORE";
5606 my $pager = $CPAN::Config->{'pager'} || "cat";
5607 $fh_pager->open("|$pager")
5608 or die "Could not open pager $pager\: $!";
5609 $fh_pager->print($out);
5612 $CPAN::Frontend->myprint($out);
5616 package CPAN::Author;
5619 #-> sub CPAN::Author::force
5625 #-> sub CPAN::Author::force
5628 delete $self->{force};
5631 #-> sub CPAN::Author::id
5634 my $id = $self->{ID};
5635 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
5639 #-> sub CPAN::Author::as_glimpse ;
5643 my $class = ref($self);
5644 $class =~ s/^CPAN:://;
5645 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
5653 #-> sub CPAN::Author::fullname ;
5655 shift->ro->{FULLNAME};
5659 #-> sub CPAN::Author::email ;
5660 sub email { shift->ro->{EMAIL}; }
5662 #-> sub CPAN::Author::ls ;
5665 my $glob = shift || "";
5666 my $silent = shift || 0;
5669 # adapted from CPAN::Distribution::verifyCHECKSUM ;
5670 my(@csf); # chksumfile
5671 @csf = $self->id =~ /(.)(.)(.*)/;
5672 $csf[1] = join "", @csf[0,1];
5673 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
5675 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
5676 unless (grep {$_->[2] eq $csf[1]} @dl) {
5677 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
5680 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
5681 unless (grep {$_->[2] eq $csf[2]} @dl) {
5682 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
5685 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
5687 if ($CPAN::META->has_inst("Text::Glob")) {
5688 my $rglob = Text::Glob::glob_to_regex($glob);
5689 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
5691 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
5694 unless ($silent >= 2) {
5695 $CPAN::Frontend->myprint(join "", map {
5696 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
5697 } sort { $a->[2] cmp $b->[2] } @dl);
5702 # returns an array of arrays, the latter contain (size,mtime,filename)
5703 #-> sub CPAN::Author::dir_listing ;
5706 my $chksumfile = shift;
5707 my $recursive = shift;
5708 my $may_ftp = shift;
5711 File::Spec->catfile($CPAN::Config->{keep_source_where},
5712 "authors", "id", @$chksumfile);
5716 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
5717 # hazard. (Without GPG installed they are not that much better,
5719 $fh = FileHandle->new;
5720 if (open($fh, $lc_want)) {
5721 my $line = <$fh>; close $fh;
5722 unlink($lc_want) unless $line =~ /PGP/;
5726 # connect "force" argument with "index_expire".
5727 my $force = $self->{force};
5728 if (my @stat = stat $lc_want) {
5729 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
5733 $lc_file = CPAN::FTP->localize(
5734 "authors/id/@$chksumfile",
5739 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
5740 $chksumfile->[-1] .= ".gz";
5741 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
5744 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
5745 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
5751 $lc_file = $lc_want;
5752 # we *could* second-guess and if the user has a file: URL,
5753 # then we could look there. But on the other hand, if they do
5754 # have a file: URL, wy did they choose to set
5755 # $CPAN::Config->{show_upload_date} to false?
5758 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
5759 $fh = FileHandle->new;
5761 if (open $fh, $lc_file) {
5764 $eval =~ s/\015?\012/\n/g;
5766 my($comp) = Safe->new();
5767 $cksum = $comp->reval($eval);
5769 rename $lc_file, "$lc_file.bad";
5770 Carp::confess($@) if $@;
5772 } elsif ($may_ftp) {
5773 Carp::carp "Could not open '$lc_file' for reading.";
5775 # Maybe should warn: "You may want to set show_upload_date to a true value"
5779 for $f (sort keys %$cksum) {
5780 if (exists $cksum->{$f}{isdir}) {
5782 my(@dir) = @$chksumfile;
5784 push @dir, $f, "CHECKSUMS";
5786 [$_->[0], $_->[1], "$f/$_->[2]"]
5787 } $self->dir_listing(\@dir,1,$may_ftp);
5789 push @result, [ 0, "-", $f ];
5793 ($cksum->{$f}{"size"}||0),
5794 $cksum->{$f}{"mtime"}||"---",
5802 #-> sub CPAN::Author::reports
5804 $CPAN::Frontend->mywarn("reports on authors not implemented.
5805 Please file a bugreport if you need this.\n");
5808 package CPAN::Distribution;
5814 my $ro = $self->ro or return;
5818 #-> CPAN::Distribution::undelay
5822 "configure_requires_later",
5823 "configure_requires_later_for",
5827 delete $self->{$delayer};
5831 #-> CPAN::Distribution::is_dot_dist
5834 return substr($self->id,-1,1) eq ".";
5837 # add the A/AN/ stuff
5838 #-> CPAN::Distribution::normalize
5841 $s = $self->id unless defined $s;
5842 if (substr($s,-1,1) eq ".") {
5843 # using a global because we are sometimes called as static method
5844 if (!$CPAN::META->{LOCK}
5845 && !$CPAN::Have_warned->{"$s is unlocked"}++
5847 $CPAN::Frontend->mywarn("You are visiting the local directory
5849 without lock, take care that concurrent processes do not do likewise.\n");
5850 $CPAN::Frontend->mysleep(1);
5853 $s = "$CPAN::iCwd/.";
5854 } elsif (File::Spec->file_name_is_absolute($s)) {
5855 } elsif (File::Spec->can("rel2abs")) {
5856 $s = File::Spec->rel2abs($s);
5858 $CPAN::Frontend->mydie("Your File::Spec is too old, please upgrade File::Spec");
5860 CPAN->debug("s[$s]") if $CPAN::DEBUG;
5861 unless ($CPAN::META->exists("CPAN::Distribution", $s)) {
5862 for ($CPAN::META->instance("CPAN::Distribution", $s)) {
5863 $_->{build_dir} = $s;
5864 $_->{archived} = "local_directory";
5865 $_->{unwrapped} = CPAN::Distrostatus->new("YES -- local_directory");
5871 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
5873 return $s if $s =~ m:^N/A|^Contact Author: ;
5874 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
5875 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
5876 CPAN->debug("s[$s]") if $CPAN::DEBUG;
5881 #-> sub CPAN::Distribution::author ;
5885 if (substr($self->id,-1,1) eq ".") {
5886 $authorid = "LOCAL";
5888 ($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
5890 CPAN::Shell->expand("Author",$authorid);
5893 # tries to get the yaml from CPAN instead of the distro itself:
5894 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
5897 my $meta = $self->pretty_id;
5898 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
5899 my(@ls) = CPAN::Shell->globls($meta);
5900 my $norm = $self->normalize($meta);
5904 File::Spec->catfile(
5905 $CPAN::Config->{keep_source_where},
5910 $self->debug("Doing localize") if $CPAN::DEBUG;
5911 unless ($local_file =
5912 CPAN::FTP->localize("authors/id/$norm",
5914 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
5916 my $yaml = CPAN->_yaml_loadfile($local_file)->[0];
5919 #-> sub CPAN::Distribution::cpan_userid
5922 if ($self->{ID} =~ m{[A-Z]/[A-Z\-]{2}/([A-Z\-]+)/}) {
5925 return $self->SUPER::cpan_userid;
5928 #-> sub CPAN::Distribution::pretty_id
5932 return $id unless $id =~ m|^./../|;
5936 #-> sub CPAN::Distribution::base_id
5939 my $id = $self->pretty_id();
5940 my $base_id = File::Basename::basename($id);
5941 $base_id =~ s{\.(?:tar\.(bz2|gz|Z)|t(?:gz|bz)|zip)$}{}i;
5945 # mark as dirty/clean for the sake of recursion detection. $color=1
5946 # means "in use", $color=0 means "not in use anymore". $color=2 means
5947 # we have determined prereqs now and thus insist on passing this
5948 # through (at least) once again.
5950 #-> sub CPAN::Distribution::color_cmd_tmps ;
5951 sub color_cmd_tmps {
5953 my($depth) = shift || 0;
5954 my($color) = shift || 0;
5955 my($ancestors) = shift || [];
5956 # a distribution needs to recurse into its prereq_pms
5958 return if exists $self->{incommandcolor}
5960 && $self->{incommandcolor}==$color;
5961 if ($depth>=$CPAN::MAX_RECURSION) {
5962 die(CPAN::Exception::RecursiveDependency->new($ancestors));
5964 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
5965 my $prereq_pm = $self->prereq_pm;
5966 if (defined $prereq_pm) {
5967 PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
5968 keys %{$prereq_pm->{build_requires}||{}}) {
5969 next PREREQ if $pre eq "perl";
5971 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
5972 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
5973 $CPAN::Frontend->mysleep(2);
5976 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
5980 delete $self->{sponsored_mods};
5982 # as we are at the end of a command, we'll give up this
5983 # reminder of a broken test. Other commands may test this guy
5984 # again. Maybe 'badtestcnt' should be renamed to
5985 # 'make_test_failed_within_command'?
5986 delete $self->{badtestcnt};
5988 $self->{incommandcolor} = $color;
5991 #-> sub CPAN::Distribution::as_string ;
5994 $self->containsmods;
5996 $self->SUPER::as_string(@_);
5999 #-> sub CPAN::Distribution::containsmods ;
6002 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
6003 my $dist_id = $self->{ID};
6004 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
6005 my $mod_file = $mod->cpan_file or next;
6006 my $mod_id = $mod->{ID} or next;
6007 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
6009 if ($CPAN::Signal) {
6010 delete $self->{CONTAINSMODS};
6013 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
6015 keys %{$self->{CONTAINSMODS}||{}};
6018 #-> sub CPAN::Distribution::upload_date ;
6021 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
6022 my(@local_wanted) = split(/\//,$self->id);
6023 my $filename = pop @local_wanted;
6024 push @local_wanted, "CHECKSUMS";
6025 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
6026 return unless $author;
6027 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
6029 my($dirent) = grep { $_->[2] eq $filename } @dl;
6030 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
6031 return unless $dirent->[1];
6032 return $self->{UPLOAD_DATE} = $dirent->[1];
6035 #-> sub CPAN::Distribution::uptodate ;
6039 foreach $c ($self->containsmods) {
6040 my $obj = CPAN::Shell->expandany($c);
6041 unless ($obj->uptodate) {
6042 my $id = $self->pretty_id;
6043 $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG;
6050 #-> sub CPAN::Distribution::called_for ;
6053 $self->{CALLED_FOR} = $id if defined $id;
6054 return $self->{CALLED_FOR};
6057 #-> sub CPAN::Distribution::get ;
6060 $self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
6061 if (my $goto = $self->prefs->{goto}) {
6062 $CPAN::Frontend->mywarn
6064 "delegating to '%s' as specified in prefs file '%s' doc %d\n",
6066 $self->{prefs_file},
6067 $self->{prefs_file_doc},
6069 return $self->goto($goto);
6071 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
6073 : ($ENV{PERLLIB} || "");
6075 $CPAN::META->set_perl5lib;
6076 local $ENV{MAKEFLAGS}; # protect us from outer make calls
6080 my $goodbye_message;
6081 $self->debug("checking disabled id[$self->{ID}]") if $CPAN::DEBUG;
6082 if ($self->prefs->{disabled}) {
6084 "Disabled via prefs file '%s' doc %d",
6085 $self->{prefs_file},
6086 $self->{prefs_file_doc},
6089 $self->{unwrapped} = CPAN::Distrostatus->new("NO $why");
6090 $goodbye_message = "[disabled] -- NA $why";
6091 # note: not intended to be persistent but at least visible
6092 # during this session
6094 if (exists $self->{build_dir} && -d $self->{build_dir}
6095 && ($self->{modulebuild}||$self->{writemakefile})
6097 # this deserves print, not warn:
6098 $CPAN::Frontend->myprint(" Has already been unwrapped into directory ".
6099 "$self->{build_dir}\n"
6104 # although we talk about 'force' we shall not test on
6105 # force directly. New model of force tries to refrain from
6106 # direct checking of force.
6107 exists $self->{unwrapped} and (
6108 UNIVERSAL::can($self->{unwrapped},"failed") ?
6109 $self->{unwrapped}->failed :
6110 $self->{unwrapped} =~ /^NO/
6112 and push @e, "Unwrapping had some problem, won't try again without force";
6115 $CPAN::Frontend->mywarn(join "", map {"$_\n"} @e);
6116 if ($goodbye_message) {
6117 $self->goodbye($goodbye_message);
6122 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
6125 unless ($self->{build_dir} && -d $self->{build_dir}) {
6126 $self->get_file_onto_local_disk;
6127 return if $CPAN::Signal;
6128 $self->check_integrity;
6129 return if $CPAN::Signal;
6130 (my $packagedir,$local_file) = $self->run_preps_on_packagedir;
6131 $packagedir ||= $self->{build_dir};
6132 $self->{build_dir} = $packagedir;
6135 if ($CPAN::Signal) {
6136 $self->safe_chdir($sub_wd);
6139 return $self->run_MM_or_MB($local_file);
6142 #-> CPAN::Distribution::get_file_onto_local_disk
6143 sub get_file_onto_local_disk {
6146 return if $self->is_dot_dist;
6149 File::Spec->catfile(
6150 $CPAN::Config->{keep_source_where},
6153 split(/\//,$self->id)
6156 $self->debug("Doing localize") if $CPAN::DEBUG;
6157 unless ($local_file =
6158 CPAN::FTP->localize("authors/id/$self->{ID}",
6161 if ($CPAN::Index::DATE_OF_02) {
6162 $note = "Note: Current database in memory was generated ".
6163 "on $CPAN::Index::DATE_OF_02\n";
6165 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
6168 $self->debug("local_wanted[$local_wanted]local_file[$local_file]") if $CPAN::DEBUG;
6169 $self->{localfile} = $local_file;
6173 #-> CPAN::Distribution::check_integrity
6174 sub check_integrity {
6177 return if $self->is_dot_dist;
6178 if ($CPAN::META->has_inst("Digest::SHA")) {
6179 $self->debug("Digest::SHA is installed, verifying");
6180 $self->verifyCHECKSUM;
6182 $self->debug("Digest::SHA is NOT installed");
6186 #-> CPAN::Distribution::run_preps_on_packagedir
6187 sub run_preps_on_packagedir {
6189 return if $self->is_dot_dist;
6191 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
6192 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
6193 $self->safe_chdir($builddir);
6194 $self->debug("Removing tmp-$$") if $CPAN::DEBUG;
6195 File::Path::rmtree("tmp-$$");
6196 unless (mkdir "tmp-$$", 0755) {
6197 $CPAN::Frontend->unrecoverable_error(<<EOF);
6198 Couldn't mkdir '$builddir/tmp-$$': $!
6200 Cannot continue: Please find the reason why I cannot make the
6203 and fix the problem, then retry.
6207 if ($CPAN::Signal) {
6210 $self->safe_chdir("tmp-$$");
6215 my $local_file = $self->{localfile};
6216 my $ct = eval{CPAN::Tarzip->new($local_file)};
6218 $self->{unwrapped} = CPAN::Distrostatus->new("NO");
6219 delete $self->{build_dir};
6222 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i) {
6223 $self->{was_uncompressed}++ unless eval{$ct->gtest()};
6224 $self->untar_me($ct);
6225 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
6226 $self->unzip_me($ct);
6228 $self->{was_uncompressed}++ unless $ct->gtest();
6229 $local_file = $self->handle_singlefile($local_file);
6232 # we are still in the tmp directory!
6233 # Let's check if the package has its own directory.
6234 my $dh = DirHandle->new(File::Spec->curdir)
6235 or Carp::croak("Couldn't opendir .: $!");
6236 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
6239 # XXX here we want in each branch File::Temp to protect all build_dir directories
6240 if (CPAN->has_inst("File::Temp")) {
6244 if (@readdir == 1 && -d $readdir[0]) {
6245 $tdir_base = $readdir[0];
6246 $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]);
6247 my $dh2 = DirHandle->new($from_dir)
6248 or Carp::croak("Couldn't opendir $from_dir: $!");
6249 @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC??
6251 my $userid = $self->cpan_userid;
6252 CPAN->debug("userid[$userid]");
6253 if (!$userid or $userid eq "N/A") {
6256 $tdir_base = $userid;
6257 $from_dir = File::Spec->curdir;
6258 @dirents = @readdir;
6260 $packagedir = File::Temp::tempdir(
6261 "$tdir_base-XXXXXX",
6266 for $f (@dirents) { # is already without "." and ".."
6267 my $from = File::Spec->catdir($from_dir,$f);
6268 my $to = File::Spec->catdir($packagedir,$f);
6269 unless (File::Copy::move($from,$to)) {
6271 $from = File::Spec->rel2abs($from);
6272 Carp::confess("Couldn't move $from to $to: $err");
6275 } else { # older code below, still better than nothing when there is no File::Temp
6277 if (@readdir == 1 && -d $readdir[0]) {
6278 $distdir = $readdir[0];
6279 $packagedir = File::Spec->catdir($builddir,$distdir);
6280 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
6282 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
6284 File::Path::rmtree($packagedir);
6285 unless (File::Copy::move($distdir,$packagedir)) {
6286 $CPAN::Frontend->unrecoverable_error(<<EOF);
6287 Couldn't move '$distdir' to '$packagedir': $!
6289 Cannot continue: Please find the reason why I cannot move
6290 $builddir/tmp-$$/$distdir
6293 and fix the problem, then retry
6297 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
6304 my $userid = $self->cpan_userid;
6305 CPAN->debug("userid[$userid]") if $CPAN::DEBUG;
6306 if (!$userid or $userid eq "N/A") {
6309 my $pragmatic_dir = $userid . '000';
6310 $pragmatic_dir =~ s/\W_//g;
6311 $pragmatic_dir++ while -d "../$pragmatic_dir";
6312 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
6313 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
6314 File::Path::mkpath($packagedir);
6316 for $f (@readdir) { # is already without "." and ".."
6317 my $to = File::Spec->catdir($packagedir,$f);
6318 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
6322 $self->{build_dir} = $packagedir;
6323 $self->safe_chdir($builddir);
6324 File::Path::rmtree("tmp-$$");
6326 $self->safe_chdir($packagedir);
6327 $self->_signature_business();
6328 $self->safe_chdir($builddir);
6330 return($packagedir,$local_file);
6333 #-> sub CPAN::Distribution::parse_meta_yml ;
6334 sub parse_meta_yml {
6336 my $build_dir = $self->{build_dir} or die "PANIC: cannot parse yaml without a build_dir";
6337 my $yaml = File::Spec->catfile($build_dir,"META.yml");
6338 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
6339 return unless -f $yaml;
6342 require Parse::Metayaml; # hypothetical
6343 $early_yaml = Parse::Metayaml::LoadFile($yaml)->[0];
6345 unless ($early_yaml) {
6346 eval { $early_yaml = CPAN->_yaml_loadfile($yaml)->[0]; };
6348 unless ($early_yaml) {
6354 #-> sub CPAN::Distribution::satisfy_configure_requires ;
6355 sub satisfy_configure_requires {
6357 my $enable_configure_requires = 1;
6358 if (!$enable_configure_requires) {
6360 # if we return 1 here, everything is as before we introduced
6361 # configure_requires that means, things with
6362 # configure_requires simply fail, all others succeed
6364 my @prereq = $self->unsat_prereq("configure_requires_later") or return 1;
6365 if ($self->{configure_requires_later}) {
6366 for my $k (keys %{$self->{configure_requires_later_for}||{}}) {
6367 if ($self->{configure_requires_later_for}{$k}>1) {
6368 # we must not come here a second time
6369 $CPAN::Frontend->mywarn("Panic: Some prerequisites is not available, please investigate...");
6371 $CPAN::Frontend->mydie
6374 ({self=>$self, prereq=>\@prereq})
6379 if ($prereq[0][0] eq "perl") {
6380 my $need = "requires perl '$prereq[0][1]'";
6381 my $id = $self->pretty_id;
6382 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
6383 $self->{make} = CPAN::Distrostatus->new("NO $need");
6384 $self->store_persistent_state;
6385 return $self->goodbye("[prereq] -- NOT OK");
6388 $self->follow_prereqs("configure_requires_later", @prereq);
6393 } elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) {
6394 $CPAN::Frontend->mywarn($@);
6395 return $self->goodbye("[depend] -- NOT OK");
6398 die "never reached";
6401 #-> sub CPAN::Distribution::run_MM_or_MB ;
6403 my($self,$local_file) = @_;
6404 $self->satisfy_configure_requires() or return;
6405 my($mpl) = File::Spec->catfile($self->{build_dir},"Makefile.PL");
6406 my($mpl_exists) = -f $mpl;
6407 unless ($mpl_exists) {
6408 # NFS has been reported to have racing problems after the
6409 # renaming of a directory in some environments.
6411 $CPAN::Frontend->mysleep(1);
6412 my $mpldh = DirHandle->new($self->{build_dir})
6413 or Carp::croak("Couldn't opendir $self->{build_dir}: $!");
6414 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
6417 my $prefer_installer = "eumm"; # eumm|mb
6418 if (-f File::Spec->catfile($self->{build_dir},"Build.PL")) {
6419 if ($mpl_exists) { # they *can* choose
6420 if ($CPAN::META->has_inst("Module::Build")) {
6421 $prefer_installer = CPAN::HandleConfig->prefs_lookup($self,
6422 q{prefer_installer});
6425 $prefer_installer = "mb";
6428 return unless $self->patch;
6429 if (lc($prefer_installer) eq "rand") {
6430 $prefer_installer = rand()<.5 ? "eumm" : "mb";
6432 if (lc($prefer_installer) eq "mb") {
6433 $self->{modulebuild} = 1;
6434 } elsif ($self->{archived} eq "patch") {
6435 # not an edge case, nothing to install for sure
6436 my $why = "A patch file cannot be installed";
6437 $CPAN::Frontend->mywarn("Refusing to handle this file: $why\n");
6438 $self->{writemakefile} = CPAN::Distrostatus->new("NO $why");
6439 } elsif (! $mpl_exists) {
6440 $self->_edge_cases($mpl,$local_file);
6442 if ($self->{build_dir}
6444 $CPAN::Config->{build_dir_reuse}
6446 $self->store_persistent_state;
6451 #-> CPAN::Distribution::store_persistent_state
6452 sub store_persistent_state {
6454 my $dir = $self->{build_dir};
6455 unless (File::Spec->canonpath(File::Basename::dirname($dir))
6456 eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
6457 $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
6458 "will not store persistent state\n");
6461 my $file = sprintf "%s.yml", $dir;
6462 my $yaml_module = CPAN::_yaml_module;
6463 if ($CPAN::META->has_inst($yaml_module)) {
6464 CPAN->_yaml_dumpfile(
6468 perl => CPAN::_perl_fingerprint,
6469 distribution => $self,
6473 $CPAN::Frontend->myprint("Warning (usually harmless): '$yaml_module' not installed, ".
6474 "will not store persistent state\n");
6478 #-> CPAN::Distribution::patch
6480 my($self,$patch) = @_;
6481 my $norm = $self->normalize($patch);
6483 File::Spec->catfile(
6484 $CPAN::Config->{keep_source_where},
6489 $self->debug("Doing localize") if $CPAN::DEBUG;
6490 return CPAN::FTP->localize("authors/id/$norm",
6495 my $stdpatchargs = "";
6496 #-> CPAN::Distribution::patch
6499 $self->debug("checking patches id[$self->{ID}]") if $CPAN::DEBUG;
6500 my $patches = $self->prefs->{patches};
6502 $self->debug("patches[$patches]") if $CPAN::DEBUG;
6504 return unless @$patches;
6505 $self->safe_chdir($self->{build_dir});
6506 CPAN->debug("patches[$patches]") if $CPAN::DEBUG;
6507 my $patchbin = $CPAN::Config->{patch};
6508 unless ($patchbin && length $patchbin) {
6509 $CPAN::Frontend->mydie("No external patch command configured\n\n".
6510 "Please run 'o conf init /patch/'\n\n");
6512 unless (MM->maybe_command($patchbin)) {
6513 $CPAN::Frontend->mydie("No external patch command available\n\n".
6514 "Please run 'o conf init /patch/'\n\n");
6516 $patchbin = CPAN::HandleConfig->safe_quote($patchbin);
6517 local $ENV{PATCH_GET} = 0; # formerly known as -g0
6518 unless ($stdpatchargs) {
6519 my $system = "$patchbin --version |";
6521 open FH, $system or die "Could not fork '$system': $!";
6524 PARSEVERSION: while (<FH>) {
6525 if (/^patch\s+([\d\.]+)/) {
6531 $stdpatchargs = "-N --fuzz=3";
6533 $stdpatchargs = "-N";
6536 my $countedpatches = @$patches == 1 ? "1 patch" : (scalar @$patches . " patches");
6537 $CPAN::Frontend->myprint("Going to apply $countedpatches:\n");
6538 for my $patch (@$patches) {
6539 unless (-f $patch) {
6540 if (my $trydl = $self->try_download($patch)) {
6543 my $fail = "Could not find patch '$patch'";
6544 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
6545 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
6546 delete $self->{build_dir};
6550 $CPAN::Frontend->myprint(" $patch\n");
6551 my $readfh = CPAN::Tarzip->TIEHANDLE($patch);
6554 my $ppp = $self->_patch_p_parameter($readfh);
6555 if ($ppp eq "applypatch") {
6556 $pcommand = "$CPAN::Config->{applypatch} -verbose";
6558 my $thispatchargs = join " ", $stdpatchargs, $ppp;
6559 $pcommand = "$patchbin $thispatchargs";
6562 $readfh = CPAN::Tarzip->TIEHANDLE($patch); # open again
6563 my $writefh = FileHandle->new;
6564 $CPAN::Frontend->myprint(" $pcommand\n");
6565 unless (open $writefh, "|$pcommand") {
6566 my $fail = "Could not fork '$pcommand'";
6567 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
6568 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
6569 delete $self->{build_dir};
6572 while (my $x = $readfh->READLINE) {
6575 unless (close $writefh) {
6576 my $fail = "Could not apply patch '$patch'";
6577 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
6578 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
6579 delete $self->{build_dir};
6589 sub _patch_p_parameter {
6592 my $cnt_p0files = 0;
6594 while ($_ = $fh->READLINE) {
6596 $CPAN::Config->{applypatch}
6598 /\#\#\#\# ApplyPatch data follows \#\#\#\#/
6602 next unless /^[\*\+]{3}\s(\S+)/;
6605 $cnt_p0files++ if -f $file;
6606 CPAN->debug("file[$file]cnt_files[$cnt_files]cnt_p0files[$cnt_p0files]")
6609 return "-p1" unless $cnt_files;
6610 return $cnt_files==$cnt_p0files ? "-p0" : "-p1";
6613 #-> sub CPAN::Distribution::_edge_cases
6614 # with "configure" or "Makefile" or single file scripts
6616 my($self,$mpl,$local_file) = @_;
6617 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
6621 my $build_dir = $self->{build_dir};
6622 my($configure) = File::Spec->catfile($build_dir,"Configure");
6623 if (-f $configure) {
6624 # do we have anything to do?
6625 $self->{configure} = $configure;
6626 } elsif (-f File::Spec->catfile($build_dir,"Makefile")) {
6627 $CPAN::Frontend->mywarn(qq{
6628 Package comes with a Makefile and without a Makefile.PL.
6629 We\'ll try to build it with that Makefile then.
6631 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
6632 $CPAN::Frontend->mysleep(2);
6634 my $cf = $self->called_for || "unknown";
6639 $cf =~ s|[/\\:]||g; # risk of filesystem damage
6640 $cf = "unknown" unless length($cf);
6641 $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
6642 (The test -f "$mpl" returned false.)
6643 Writing one on our own (setting NAME to $cf)\a\n});
6644 $self->{had_no_makefile_pl}++;
6645 $CPAN::Frontend->mysleep(3);
6647 # Writing our own Makefile.PL
6650 if ($self->{archived} eq "maybe_pl") {
6651 my $fh = FileHandle->new;
6652 my $script_file = File::Spec->catfile($build_dir,$local_file);
6653 $fh->open($script_file)
6654 or Carp::croak("Could not open script '$script_file': $!");
6656 # name parsen und prereq
6657 my($state) = "poddir";
6658 my($name, $prereq) = ("", "");
6660 if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
6663 } elsif ($1 eq 'PREREQUISITES') {
6666 } elsif ($state =~ m{^(name|prereq)$}) {
6671 } elsif ($state eq "name") {
6676 } elsif ($state eq "prereq") {
6679 } elsif (/^=cut\b/) {
6686 s{.*<}{}; # strip X<...>
6690 $prereq = join " ", split /\s+/, $prereq;
6691 my($PREREQ_PM) = join("\n", map {
6692 s{.*<}{}; # strip X<...>
6694 if (/[\s\'\"]/) { # prose?
6696 s/[^\w:]$//; # period?
6697 " "x28 . "'$_' => 0,";
6699 } split /\s*,\s*/, $prereq);
6702 EXE_FILES => ['$name'],
6708 my $to_file = File::Spec->catfile($build_dir, $name);
6709 rename $script_file, $to_file
6710 or die "Can't rename $script_file to $to_file: $!";
6714 my $fh = FileHandle->new;
6716 or Carp::croak("Could not open >$mpl: $!");
6718 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
6719 # because there was no Makefile.PL supplied.
6720 # Autogenerated on: }.scalar localtime().qq{
6722 use ExtUtils::MakeMaker;
6724 NAME => q[$cf],$script
6731 #-> CPAN::Distribution::_signature_business
6732 sub _signature_business {
6734 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
6737 if ($CPAN::META->has_inst("Module::Signature")) {
6738 if (-f "SIGNATURE") {
6739 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
6740 my $rv = Module::Signature::verify();
6741 if ($rv != Module::Signature::SIGNATURE_OK() and
6742 $rv != Module::Signature::SIGNATURE_MISSING()) {
6743 $CPAN::Frontend->mywarn(
6744 qq{\nSignature invalid for }.
6745 qq{distribution file. }.
6746 qq{Please investigate.\n\n}
6750 sprintf(qq{I'd recommend removing %s. Some error occured }.
6751 qq{while checking its signature, so it could }.
6752 qq{be invalid. Maybe you have configured }.
6753 qq{your 'urllist' with a bad URL. Please check this }.
6754 qq{array with 'o conf urllist' and retry. Or }.
6755 qq{examine the distribution in a subshell. Try
6763 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
6764 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
6765 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
6767 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
6768 $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
6771 $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n});
6774 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
6779 #-> CPAN::Distribution::untar_me ;
6782 $self->{archived} = "tar";
6784 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6786 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- untar failed");
6790 # CPAN::Distribution::unzip_me ;
6793 $self->{archived} = "zip";
6795 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6797 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- unzip failed");
6802 sub handle_singlefile {
6803 my($self,$local_file) = @_;
6805 if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ) {
6806 $self->{archived} = "pm";
6807 } elsif ( $local_file =~ /\.patch(\.(gz|bz2))?(?!\n)\Z/ ) {
6808 $self->{archived} = "patch";
6810 $self->{archived} = "maybe_pl";
6813 my $to = File::Basename::basename($local_file);
6814 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
6815 if (eval{CPAN::Tarzip->new($local_file)->gunzip($to)}) {
6816 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6818 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- uncompressing failed");
6821 if (File::Copy::cp($local_file,".")) {
6822 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6824 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- copying failed");
6830 #-> sub CPAN::Distribution::new ;
6832 my($class,%att) = @_;
6834 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
6836 my $this = { %att };
6837 return bless $this, $class;
6840 #-> sub CPAN::Distribution::look ;
6844 if ($^O eq 'MacOS') {
6845 $self->Mac::BuildTools::look;
6849 if ( $CPAN::Config->{'shell'} ) {
6850 $CPAN::Frontend->myprint(qq{
6851 Trying to open a subshell in the build directory...
6854 $CPAN::Frontend->myprint(qq{
6855 Your configuration does not define a value for subshells.
6856 Please define it with "o conf shell <your shell>"
6860 my $dist = $self->id;
6862 unless ($dir = $self->dir) {
6865 unless ($dir ||= $self->dir) {
6866 $CPAN::Frontend->mywarn(qq{
6867 Could not determine which directory to use for looking at $dist.
6871 my $pwd = CPAN::anycwd();
6872 $self->safe_chdir($dir);
6873 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
6875 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
6876 $ENV{CPAN_SHELL_LEVEL} += 1;
6877 my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
6878 unless (system($shell) == 0) {
6880 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
6883 $self->safe_chdir($pwd);
6886 # CPAN::Distribution::cvs_import ;
6890 my $dir = $self->dir;
6892 my $package = $self->called_for;
6893 my $module = $CPAN::META->instance('CPAN::Module', $package);
6894 my $version = $module->cpan_version;
6896 my $userid = $self->cpan_userid;
6898 my $cvs_dir = (split /\//, $dir)[-1];
6899 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
6901 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
6903 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
6904 if ($cvs_site_perl) {
6905 $cvs_dir = "$cvs_site_perl/$cvs_dir";
6907 my $cvs_log = qq{"imported $package $version sources"};
6908 $version =~ s/\./_/g;
6909 # XXX cvs: undocumented and unclear how it was meant to work
6910 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
6911 "$cvs_dir", $userid, "v$version");
6913 my $pwd = CPAN::anycwd();
6914 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
6916 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
6918 $CPAN::Frontend->myprint(qq{@cmd\n});
6919 system(@cmd) == 0 or
6921 $CPAN::Frontend->mydie("cvs import failed");
6922 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
6925 #-> sub CPAN::Distribution::readme ;
6928 my($dist) = $self->id;
6929 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
6930 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
6933 File::Spec->catfile(
6934 $CPAN::Config->{keep_source_where},
6937 split(/\//,"$sans.readme"),
6939 $self->debug("Doing localize") if $CPAN::DEBUG;
6940 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
6942 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
6944 if ($^O eq 'MacOS') {
6945 Mac::BuildTools::launch_file($local_file);
6949 my $fh_pager = FileHandle->new;
6950 local($SIG{PIPE}) = "IGNORE";
6951 my $pager = $CPAN::Config->{'pager'} || "cat";
6952 $fh_pager->open("|$pager")
6953 or die "Could not open pager $pager\: $!";
6954 my $fh_readme = FileHandle->new;
6955 $fh_readme->open($local_file)
6956 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
6957 $CPAN::Frontend->myprint(qq{
6962 $fh_pager->print(<$fh_readme>);
6966 #-> sub CPAN::Distribution::verifyCHECKSUM ;
6967 sub verifyCHECKSUM {
6971 $self->{CHECKSUM_STATUS} ||= "";
6972 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
6973 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6975 my($lc_want,$lc_file,@local,$basename);
6976 @local = split(/\//,$self->id);
6978 push @local, "CHECKSUMS";
6980 File::Spec->catfile($CPAN::Config->{keep_source_where},
6981 "authors", "id", @local);
6983 if (my $size = -s $lc_want) {
6984 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
6985 if ($self->CHECKSUM_check_file($lc_want,1)) {
6986 return $self->{CHECKSUM_STATUS} = "OK";
6989 $lc_file = CPAN::FTP->localize("authors/id/@local",
6992 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
6993 $local[-1] .= ".gz";
6994 $lc_file = CPAN::FTP->localize("authors/id/@local",
6997 $lc_file =~ s/\.gz(?!\n)\Z//;
6998 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
7003 if ($self->CHECKSUM_check_file($lc_file)) {
7004 return $self->{CHECKSUM_STATUS} = "OK";
7008 #-> sub CPAN::Distribution::SIG_check_file ;
7009 sub SIG_check_file {
7010 my($self,$chk_file) = @_;
7011 my $rv = eval { Module::Signature::_verify($chk_file) };
7013 if ($rv == Module::Signature::SIGNATURE_OK()) {
7014 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
7015 return $self->{SIG_STATUS} = "OK";
7017 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
7018 qq{distribution file. }.
7019 qq{Please investigate.\n\n}.
7021 $CPAN::META->instance(
7026 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
7027 is invalid. Maybe you have configured your 'urllist' with
7028 a bad URL. Please check this array with 'o conf urllist', and
7031 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
7035 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
7037 # sloppy is 1 when we have an old checksums file that maybe is good
7040 sub CHECKSUM_check_file {
7041 my($self,$chk_file,$sloppy) = @_;
7042 my($cksum,$file,$basename);
7045 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
7046 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
7049 if ($CPAN::META->has_inst("Module::Signature")) {
7050 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
7051 $self->SIG_check_file($chk_file);
7053 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
7057 $file = $self->{localfile};
7058 $basename = File::Basename::basename($file);
7059 my $fh = FileHandle->new;
7060 if (open $fh, $chk_file) {
7063 $eval =~ s/\015?\012/\n/g;
7065 my($comp) = Safe->new();
7066 $cksum = $comp->reval($eval);
7068 rename $chk_file, "$chk_file.bad";
7069 Carp::confess($@) if $@;
7072 Carp::carp "Could not open $chk_file for reading";
7075 if (! ref $cksum or ref $cksum ne "HASH") {
7076 $CPAN::Frontend->mywarn(qq{
7077 Warning: checksum file '$chk_file' broken.
7079 When trying to read that file I expected to get a hash reference
7080 for further processing, but got garbage instead.
7082 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
7083 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
7084 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
7086 } elsif (exists $cksum->{$basename}{sha256}) {
7087 $self->debug("Found checksum for $basename:" .
7088 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
7092 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
7094 $fh = CPAN::Tarzip->TIEHANDLE($file);
7097 my $dg = Digest::SHA->new(256);
7100 while ($fh->READ($ref, 4096) > 0) {
7103 my $hexdigest = $dg->hexdigest;
7104 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
7108 $CPAN::Frontend->myprint("Checksum for $file ok\n");
7109 return $self->{CHECKSUM_STATUS} = "OK";
7111 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
7112 qq{distribution file. }.
7113 qq{Please investigate.\n\n}.
7115 $CPAN::META->instance(
7120 my $wrap = qq{I\'d recommend removing $file. Its
7121 checksum is incorrect. Maybe you have configured your 'urllist' with
7122 a bad URL. Please check this array with 'o conf urllist', and
7125 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
7127 # former versions just returned here but this seems a
7128 # serious threat that deserves a die
7130 # $CPAN::Frontend->myprint("\n\n");
7134 # close $fh if fileno($fh);
7137 unless ($self->{CHECKSUM_STATUS}) {
7138 $CPAN::Frontend->mywarn(qq{
7139 Warning: No checksum for $basename in $chk_file.
7141 The cause for this may be that the file is very new and the checksum
7142 has not yet been calculated, but it may also be that something is
7143 going awry right now.
7145 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes");
7146 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
7148 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
7153 #-> sub CPAN::Distribution::eq_CHECKSUM ;
7155 my($self,$fh,$expect) = @_;
7156 if ($CPAN::META->has_inst("Digest::SHA")) {
7157 my $dg = Digest::SHA->new(256);
7159 while (read($fh, $data, 4096)) {
7162 my $hexdigest = $dg->hexdigest;
7163 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
7164 return $hexdigest eq $expect;
7169 #-> sub CPAN::Distribution::force ;
7171 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
7172 # effect by autoinspection, not by inspecting a global variable. One
7173 # of the reason why this was chosen to work that way was the treatment
7174 # of dependencies. They should not automatically inherit the force
7175 # status. But this has the downside that ^C and die() will return to
7176 # the prompt but will not be able to reset the force_update
7177 # attributes. We try to correct for it currently in the read_metadata
7178 # routine, and immediately before we check for a Signal. I hope this
7179 # works out in one of v1.57_53ff
7181 # "Force get forgets previous error conditions"
7183 #-> sub CPAN::Distribution::fforce ;
7185 my($self, $method) = @_;
7186 $self->force($method,1);
7189 #-> sub CPAN::Distribution::force ;
7191 my($self, $method,$fforce) = @_;
7209 "prereq_pm_detected",
7223 my $methodmatch = 0;
7225 PHASE: for my $phase (qw(unknown get make test install)) { # order matters
7226 $methodmatch = 1 if $fforce || $phase eq $method;
7227 next unless $methodmatch;
7228 ATTRIBUTE: for my $att (@{$phase_map{$phase}}) {
7229 if ($phase eq "get") {
7230 if (substr($self->id,-1,1) eq "."
7231 && $att =~ /(unwrapped|build_dir|archived)/ ) {
7232 # cannot be undone for local distros
7235 if ($att eq "build_dir"
7236 && $self->{build_dir}
7237 && $CPAN::META->{is_tested}
7239 delete $CPAN::META->{is_tested}{$self->{build_dir}};
7241 } elsif ($phase eq "test") {
7242 if ($att eq "make_test"
7243 && $self->{make_test}
7244 && $self->{make_test}{COMMANDID}
7245 && $self->{make_test}{COMMANDID} == $CPAN::CurrentCommandId
7247 # endless loop too likely
7251 delete $self->{$att};
7252 if ($ldebug || $CPAN::DEBUG) {
7253 # local $CPAN::DEBUG = 16; # Distribution
7254 CPAN->debug(sprintf "id[%s]phase[%s]att[%s]", $self->id, $phase, $att);
7258 if ($method && $method =~ /make|test|install/) {
7259 $self->{force_update} = 1; # name should probably have been force_install
7263 #-> sub CPAN::Distribution::notest ;
7265 my($self, $method) = @_;
7266 # $CPAN::Frontend->mywarn("XDEBUG: set notest for $self $method");
7267 $self->{"notest"}++; # name should probably have been force_install
7270 #-> sub CPAN::Distribution::unnotest ;
7273 # warn "XDEBUG: deleting notest";
7274 delete $self->{notest};
7277 #-> sub CPAN::Distribution::unforce ;
7280 delete $self->{force_update};
7283 #-> sub CPAN::Distribution::isa_perl ;
7286 my $file = File::Basename::basename($self->id);
7287 if ($file =~ m{ ^ perl
7296 \.tar[._-](?:gz|bz2)
7300 } elsif ($self->cpan_comment
7302 $self->cpan_comment =~ /isa_perl\(.+?\)/) {
7308 #-> sub CPAN::Distribution::perl ;
7313 carp __PACKAGE__ . "::perl was called without parameters.";
7315 return CPAN::HandleConfig->safe_quote($CPAN::Perl);
7319 #-> sub CPAN::Distribution::make ;
7322 if (my $goto = $self->prefs->{goto}) {
7323 return $self->goto($goto);
7325 my $make = $self->{modulebuild} ? "Build" : "make";
7326 # Emergency brake if they said install Pippi and get newest perl
7327 if ($self->isa_perl) {
7329 $self->called_for ne $self->id &&
7330 ! $self->{force_update}
7332 # if we die here, we break bundles
7335 qq{The most recent version "%s" of the module "%s"
7336 is part of the perl-%s distribution. To install that, you need to run
7337 force install %s --or--
7340 $CPAN::META->instance(
7349 $self->{make} = CPAN::Distrostatus->new("NO isa perl");
7350 $CPAN::Frontend->mysleep(1);
7354 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
7356 if ($self->{configure_requires_later}) {
7359 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
7361 : ($ENV{PERLLIB} || "");
7362 $CPAN::META->set_perl5lib;
7363 local $ENV{MAKEFLAGS}; # protect us from outer make calls
7365 if ($CPAN::Signal) {
7366 delete $self->{force_update};
7373 if (!$self->{archived} || $self->{archived} eq "NO") {
7374 push @e, "Is neither a tar nor a zip archive.";
7377 if (!$self->{unwrapped}
7379 UNIVERSAL::can($self->{unwrapped},"failed") ?
7380 $self->{unwrapped}->failed :
7381 $self->{unwrapped} =~ /^NO/
7383 push @e, "Had problems unarchiving. Please build manually";
7386 unless ($self->{force_update}) {
7387 exists $self->{signature_verify} and
7389 UNIVERSAL::can($self->{signature_verify},"failed") ?
7390 $self->{signature_verify}->failed :
7391 $self->{signature_verify} =~ /^NO/
7393 and push @e, "Did not pass the signature test.";
7396 if (exists $self->{writemakefile} &&
7398 UNIVERSAL::can($self->{writemakefile},"failed") ?
7399 $self->{writemakefile}->failed :
7400 $self->{writemakefile} =~ /^NO/
7402 # XXX maybe a retry would be in order?
7403 my $err = UNIVERSAL::can($self->{writemakefile},"text") ?
7404 $self->{writemakefile}->text :
7405 $self->{writemakefile};
7407 $err ||= "Had some problem writing Makefile";
7408 $err .= ", won't make";
7412 if (defined $self->{make}) {
7413 if (UNIVERSAL::can($self->{make},"failed") ?
7414 $self->{make}->failed :
7415 $self->{make} =~ /^NO/) {
7416 if ($self->{force_update}) {
7417 # Trying an already failed 'make' (unless somebody else blocks)
7419 # introduced for turning recursion detection into a distrostatus
7420 my $error = length $self->{make}>3
7421 ? substr($self->{make},3) : "Unknown error";
7422 $CPAN::Frontend->mywarn("Could not make: $error\n");
7423 $self->store_persistent_state;
7427 push @e, "Has already been made";
7431 my $later = $self->{later} || $self->{configure_requires_later};
7432 if ($later) { # see also undelay
7438 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
7439 $builddir = $self->dir or
7440 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
7441 unless (chdir $builddir) {
7442 push @e, "Couldn't chdir to '$builddir': $!";
7444 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
7446 if ($CPAN::Signal) {
7447 delete $self->{force_update};
7450 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
7451 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
7453 if ($^O eq 'MacOS') {
7454 Mac::BuildTools::make($self);
7459 while (my($k,$v) = each %ENV) {
7460 next unless defined $v;
7465 if (my $commandline = $self->prefs->{pl}{commandline}) {
7466 $system = $commandline;
7468 } elsif ($self->{'configure'}) {
7469 $system = $self->{'configure'};
7470 } elsif ($self->{modulebuild}) {
7471 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
7472 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
7474 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
7476 # This needs a handler that can be turned on or off:
7477 # $switch = "-MExtUtils::MakeMaker ".
7478 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
7480 my $makepl_arg = $self->make_x_arg("pl");
7481 $ENV{PERL5_CPAN_IS_EXECUTING} = File::Spec->catfile($self->{build_dir},
7483 $system = sprintf("%s%s Makefile.PL%s",
7485 $switch ? " $switch" : "",
7486 $makepl_arg ? " $makepl_arg" : "",
7489 if (my $env = $self->prefs->{pl}{env}) {
7490 for my $e (keys %$env) {
7491 $ENV{$e} = $env->{$e};
7494 if (exists $self->{writemakefile}) {
7496 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
7497 my($ret,$pid,$output);
7500 if ($CPAN::Config->{inactivity_timeout}) {
7502 if ($Config::Config{d_alarm}
7504 $Config::Config{d_alarm} eq "define"
7508 $CPAN::Frontend->mywarn("Warning: you have configured the config ".
7509 "variable 'inactivity_timeout' to ".
7510 "'$CPAN::Config->{inactivity_timeout}'. But ".
7511 "on this machine the system call 'alarm' ".
7512 "isn't available. This means that we cannot ".
7513 "provide the feature of intercepting long ".
7514 "waiting code and will turn this feature off.\n"
7516 $CPAN::Config->{inactivity_timeout} = 0;
7519 if ($go_via_alarm) {
7520 if ( $self->_should_report('pl') ) {
7521 ($output, $ret) = CPAN::Reporter::record_command(
7523 $CPAN::Config->{inactivity_timeout},
7525 CPAN::Reporter::grade_PL( $self, $system, $output, $ret );
7529 alarm $CPAN::Config->{inactivity_timeout};
7530 local $SIG{CHLD}; # = sub { wait };
7531 if (defined($pid = fork)) {
7536 # note, this exec isn't necessary if
7537 # inactivity_timeout is 0. On the Mac I'd
7538 # suggest, we set it always to 0.
7542 $CPAN::Frontend->myprint("Cannot fork: $!");
7551 $CPAN::Frontend->myprint($err);
7552 $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
7554 $self->store_persistent_state;
7555 return $self->goodbye("$system -- TIMED OUT");
7559 if (my $expect_model = $self->_prefs_with_expect("pl")) {
7560 # XXX probably want to check _should_report here and warn
7561 # about not being able to use CPAN::Reporter with expect
7562 $ret = $self->_run_via_expect($system,$expect_model);
7564 && $self->{writemakefile}
7565 && $self->{writemakefile}->failed) {
7570 elsif ( $self->_should_report('pl') ) {
7571 ($output, $ret) = CPAN::Reporter::record_command($system);
7572 CPAN::Reporter::grade_PL( $self, $system, $output, $ret );
7575 $ret = system($system);
7578 $self->{writemakefile} = CPAN::Distrostatus
7579 ->new("NO '$system' returned status $ret");
7580 $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
7581 $self->store_persistent_state;
7582 return $self->goodbye("$system -- NOT OK");
7585 if (-f "Makefile" || -f "Build") {
7586 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
7587 delete $self->{make_clean}; # if cleaned before, enable next
7589 my $makefile = $self->{modulebuild} ? "Build" : "Makefile";
7590 $self->{writemakefile} = CPAN::Distrostatus
7591 ->new(qq{NO -- No $makefile created});
7592 $self->store_persistent_state;
7593 return $self->goodbye("$system -- NO $makefile created");
7596 if ($CPAN::Signal) {
7597 delete $self->{force_update};
7600 if (my @prereq = $self->unsat_prereq("later")) {
7601 if ($prereq[0][0] eq "perl") {
7602 my $need = "requires perl '$prereq[0][1]'";
7603 my $id = $self->pretty_id;
7604 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
7605 $self->{make} = CPAN::Distrostatus->new("NO $need");
7606 $self->store_persistent_state;
7607 return $self->goodbye("[prereq] -- NOT OK");
7609 my $follow = eval { $self->follow_prereqs("later",@prereq); };
7612 # signal success to the queuerunner
7614 } elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) {
7615 $CPAN::Frontend->mywarn($@);
7616 return $self->goodbye("[depend] -- NOT OK");
7620 if ($CPAN::Signal) {
7621 delete $self->{force_update};
7624 if (my $commandline = $self->prefs->{make}{commandline}) {
7625 $system = $commandline;
7628 if ($self->{modulebuild}) {
7629 unless (-f "Build") {
7630 my $cwd = CPAN::anycwd();
7631 $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'".
7632 " in cwd[$cwd]. Danger, Will Robinson!\n");
7633 $CPAN::Frontend->mysleep(5);
7635 $system = join " ", $self->_build_command(), $CPAN::Config->{mbuild_arg};
7637 $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
7639 $system =~ s/\s+$//;
7640 my $make_arg = $self->make_x_arg("make");
7641 $system = sprintf("%s%s",
7643 $make_arg ? " $make_arg" : "",
7646 if (my $env = $self->prefs->{make}{env}) { # overriding the local
7647 # ENV of PL, not the
7649 # unlikely to be a risk
7650 for my $e (keys %$env) {
7651 $ENV{$e} = $env->{$e};
7654 my $expect_model = $self->_prefs_with_expect("make");
7655 my $want_expect = 0;
7656 if ( $expect_model && @{$expect_model->{talk}} ) {
7657 my $can_expect = $CPAN::META->has_inst("Expect");
7661 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
7667 # XXX probably want to check _should_report here and
7668 # warn about not being able to use CPAN::Reporter with expect
7669 $system_ok = $self->_run_via_expect($system,$expect_model) == 0;
7671 elsif ( $self->_should_report('make') ) {
7672 my ($output, $ret) = CPAN::Reporter::record_command($system);
7673 CPAN::Reporter::grade_make( $self, $system, $output, $ret );
7674 $system_ok = ! $ret;
7677 $system_ok = system($system) == 0;
7679 $self->introduce_myself;
7681 $CPAN::Frontend->myprint(" $system -- OK\n");
7682 $self->{make} = CPAN::Distrostatus->new("YES");
7684 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
7685 $self->{make} = CPAN::Distrostatus->new("NO");
7686 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
7688 $self->store_persistent_state;
7691 # CPAN::Distribution::goodbye ;
7693 my($self,$goodbye) = @_;
7694 my $id = $self->pretty_id;
7695 $CPAN::Frontend->mywarn(" $id\n $goodbye\n");
7699 # CPAN::Distribution::_run_via_expect ;
7700 sub _run_via_expect {
7701 my($self,$system,$expect_model) = @_;
7702 CPAN->debug("system[$system]expect_model[$expect_model]") if $CPAN::DEBUG;
7703 if ($CPAN::META->has_inst("Expect")) {
7704 my $expo = Expect->new; # expo Expect object;
7705 $expo->spawn($system);
7706 $expect_model->{mode} ||= "deterministic";
7707 if ($expect_model->{mode} eq "deterministic") {
7708 return $self->_run_via_expect_deterministic($expo,$expect_model);
7709 } elsif ($expect_model->{mode} eq "anyorder") {
7710 return $self->_run_via_expect_anyorder($expo,$expect_model);
7712 die "Panic: Illegal expect mode: $expect_model->{mode}";
7715 $CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n");
7716 return system($system);
7720 sub _run_via_expect_anyorder {
7721 my($self,$expo,$expect_model) = @_;
7722 my $timeout = $expect_model->{timeout} || 5;
7723 my $reuse = $expect_model->{reuse};
7724 my @expectacopy = @{$expect_model->{talk}}; # we trash it!
7727 my($eof,$ran_into_timeout);
7728 my @match = $expo->expect($timeout,
7733 $ran_into_timeout++;
7740 $but .= $expo->clear_accum;
7743 return $expo->exitstatus();
7744 } elsif ($ran_into_timeout) {
7745 # warn "DEBUG: they are asking a question, but[$but]";
7746 for (my $i = 0; $i <= $#expectacopy; $i+=2) {
7747 my($next,$send) = @expectacopy[$i,$i+1];
7748 my $regex = eval "qr{$next}";
7749 # warn "DEBUG: will compare with regex[$regex].";
7750 if ($but =~ /$regex/) {
7751 # warn "DEBUG: will send send[$send]";
7753 # never allow reusing an QA pair unless they told us
7754 splice @expectacopy, $i, 2 unless $reuse;
7758 my $why = "could not answer a question during the dialog";
7759 $CPAN::Frontend->mywarn("Failing: $why\n");
7760 $self->{writemakefile} =
7761 CPAN::Distrostatus->new("NO $why");
7767 sub _run_via_expect_deterministic {
7768 my($self,$expo,$expect_model) = @_;
7769 my $ran_into_timeout;
7770 my $timeout = $expect_model->{timeout} || 15; # currently unsettable
7771 my $expecta = $expect_model->{talk};
7772 EXPECT: for (my $i = 0; $i <= $#$expecta; $i+=2) {
7773 my($re,$send) = @$expecta[$i,$i+1];
7774 CPAN->debug("timeout[$timeout]re[$re]") if $CPAN::DEBUG;
7775 my $regex = eval "qr{$re}";
7776 $expo->expect($timeout,
7778 my $but = $expo->clear_accum;
7779 $CPAN::Frontend->mywarn("EOF (maybe harmless)
7780 expected[$regex]\nbut[$but]\n\n");
7784 my $but = $expo->clear_accum;
7785 $CPAN::Frontend->mywarn("TIMEOUT
7786 expected[$regex]\nbut[$but]\n\n");
7787 $ran_into_timeout++;
7790 if ($ran_into_timeout) {
7791 # note that the caller expects 0 for success
7792 $self->{writemakefile} =
7793 CPAN::Distrostatus->new("NO timeout during expect dialog");
7799 return $expo->exitstatus();
7802 #-> CPAN::Distribution::_validate_distropref
7803 sub _validate_distropref {
7804 my($self,@args) = @_;
7806 $CPAN::META->has_inst("CPAN::Kwalify")
7808 $CPAN::META->has_inst("Kwalify")
7810 eval {CPAN::Kwalify::_validate("distroprefs",@args);};
7812 $CPAN::Frontend->mywarn($@);
7815 CPAN->debug("not validating '@args'") if $CPAN::DEBUG;
7819 #-> CPAN::Distribution::_find_prefs
7822 my $distroid = $self->pretty_id;
7823 #CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
7824 my $prefs_dir = $CPAN::Config->{prefs_dir};
7825 eval { File::Path::mkpath($prefs_dir); };
7827 $CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
7829 my $yaml_module = CPAN::_yaml_module;
7831 if ($CPAN::META->has_inst($yaml_module)) {
7832 push @extensions, "yml";
7835 if ($CPAN::META->has_inst("Data::Dumper")) {
7836 push @extensions, "dd";
7837 push @fallbacks, "Data::Dumper";
7839 if ($CPAN::META->has_inst("Storable")) {
7840 push @extensions, "st";
7841 push @fallbacks, "Storable";
7845 unless ($self->{have_complained_about_missing_yaml}++) {
7846 $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back ".
7847 "to @fallbacks to read prefs '$prefs_dir'\n");
7850 unless ($self->{have_complained_about_missing_yaml}++) {
7851 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot ".
7852 "read prefs '$prefs_dir'\n");
7857 my $dh = DirHandle->new($prefs_dir)
7858 or die Carp::croak("Couldn't open '$prefs_dir': $!");
7859 DIRENT: for (sort $dh->read) {
7860 next if $_ eq "." || $_ eq "..";
7861 my $exte = join "|", @extensions;
7862 next unless /\.($exte)$/;
7864 my $abs = File::Spec->catfile($prefs_dir, $_);
7866 #CPAN->debug(sprintf "abs[%s]", $abs) if $CPAN::DEBUG;
7868 if ($thisexte eq "yml") {
7869 # need no eval because if we have no YAML we do not try to read *.yml
7870 #CPAN->debug(sprintf "before yaml load abs[%s]", $abs) if $CPAN::DEBUG;
7871 @distropref = @{CPAN->_yaml_loadfile($abs)};
7872 #CPAN->debug(sprintf "after yaml load abs[%s]", $abs) if $CPAN::DEBUG;
7873 } elsif ($thisexte eq "dd") {
7876 open FH, "<$abs" or $CPAN::Frontend->mydie("Could not open '$abs': $!");
7882 $CPAN::Frontend->mydie("Error in distroprefs file $_\: $@");
7885 while (${"VAR".$i}) {
7886 push @distropref, ${"VAR".$i};
7889 } elsif ($thisexte eq "st") {
7890 # eval because Storable is never forward compatible
7891 eval { @distropref = @{scalar Storable::retrieve($abs)}; };
7893 $CPAN::Frontend->mywarn("Error reading distroprefs file ".
7894 "$_, skipping\: $@");
7895 $CPAN::Frontend->mysleep(4);
7900 #CPAN->debug(sprintf "#distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
7901 ELEMENT: for my $y (0..$#distropref) {
7902 my $distropref = $distropref[$y];
7903 $self->_validate_distropref($distropref,$abs,$y);
7904 my $match = $distropref->{match};
7906 #CPAN->debug("no 'match' in abs[$abs], skipping") if $CPAN::DEBUG;
7910 # do not take the order of C<keys %$match> because
7911 # "module" is by far the slowest
7912 my $saw_valid_subkeys = 0;
7913 for my $sub_attribute (qw(distribution perl perlconfig module)) {
7914 next unless exists $match->{$sub_attribute};
7915 $saw_valid_subkeys++;
7916 my $qr = eval "qr{$distropref->{match}{$sub_attribute}}";
7917 if ($sub_attribute eq "module") {
7919 #CPAN->debug(sprintf "distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
7920 my @modules = $self->containsmods;
7921 #CPAN->debug(sprintf "modules[%s]", join(",",@modules)) if $CPAN::DEBUG;
7922 MODULE: for my $module (@modules) {
7923 $okm ||= $module =~ /$qr/;
7924 last MODULE if $okm;
7927 } elsif ($sub_attribute eq "distribution") {
7928 my $okd = $distroid =~ /$qr/;
7930 } elsif ($sub_attribute eq "perl") {
7931 my $okp = $^X =~ /$qr/;
7933 } elsif ($sub_attribute eq "perlconfig") {
7934 for my $perlconfigkey (keys %{$match->{perlconfig}}) {
7935 my $perlconfigval = $match->{perlconfig}->{$perlconfigkey};
7936 # XXX should probably warn if Config does not exist
7937 my $okpc = $Config::Config{$perlconfigkey} =~ /$perlconfigval/;
7942 $CPAN::Frontend->mydie("Nonconforming .$thisexte file '$abs': ".
7943 "unknown sub_attribut '$sub_attribute'. ".
7945 "remove, cannot continue.");
7947 last if $ok == 0; # short circuit
7949 unless ($saw_valid_subkeys) {
7950 $CPAN::Frontend->mydie("Nonconforming .$thisexte file '$abs': ".
7951 "missing match/* subattribute. ".
7953 "remove, cannot continue.");
7955 #CPAN->debug(sprintf "ok[%d]", $ok) if $CPAN::DEBUG;
7958 prefs => $distropref,
7960 prefs_file_doc => $y,
7972 # CPAN::Distribution::prefs
7975 if (exists $self->{negative_prefs_cache}
7977 $self->{negative_prefs_cache} != $CPAN::CurrentCommandId
7979 delete $self->{negative_prefs_cache};
7980 delete $self->{prefs};
7982 if (exists $self->{prefs}) {
7983 return $self->{prefs}; # XXX comment out during debugging
7985 if ($CPAN::Config->{prefs_dir}) {
7986 CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG;
7987 my $prefs = $self->_find_prefs();
7988 $prefs ||= ""; # avoid warning next line
7989 CPAN->debug("prefs[$prefs]") if $CPAN::DEBUG;
7991 for my $x (qw(prefs prefs_file prefs_file_doc)) {
7992 $self->{$x} = $prefs->{$x};
7996 File::Basename::basename($self->{prefs_file}),
7997 $self->{prefs_file_doc},
7999 my $filler1 = "_" x 22;
8000 my $filler2 = int(66 - length($bs))/2;
8001 $filler2 = 0 if $filler2 < 0;
8002 $filler2 = " " x $filler2;
8003 $CPAN::Frontend->myprint("
8004 $filler1 D i s t r o P r e f s $filler1
8005 $filler2 $bs $filler2
8007 $CPAN::Frontend->mysleep(1);
8008 return $self->{prefs};
8011 $self->{negative_prefs_cache} = $CPAN::CurrentCommandId;
8012 return $self->{prefs} = +{};
8015 # CPAN::Distribution::make_x_arg
8017 my($self, $whixh) = @_;
8019 my $prefs = $self->prefs;
8022 && exists $prefs->{$whixh}
8023 && exists $prefs->{$whixh}{args}
8024 && $prefs->{$whixh}{args}
8026 $make_x_arg = join(" ",
8027 map {CPAN::HandleConfig
8028 ->safe_quote($_)} @{$prefs->{$whixh}{args}},
8031 my $what = sprintf "make%s_arg", $whixh eq "make" ? "" : $whixh;
8032 $make_x_arg ||= $CPAN::Config->{$what};
8036 # CPAN::Distribution::_make_command
8043 CPAN::HandleConfig->prefs_lookup($self,
8045 || $Config::Config{make}
8049 # Old style call, without object. Deprecated
8050 Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
8053 CPAN::HandleConfig->prefs_lookup($self,q{make})
8054 || $CPAN::Config->{make}
8055 || $Config::Config{make}
8060 #-> sub CPAN::Distribution::follow_prereqs ;
8061 sub follow_prereqs {
8064 my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_;
8065 return unless @prereq_tuples;
8066 my @prereq = map { $_->[0] } @prereq_tuples;
8067 my $pretty_id = $self->pretty_id;
8069 b => "build_requires",
8073 my($filler1,$filler2,$filler3,$filler4);
8075 my $unsat = "Unsatisfied dependencies detected during";
8076 my $w = length($unsat) > length($pretty_id) ? length($unsat) : length($pretty_id);
8078 my $r = int(($w - length($unsat))/2);
8079 my $l = $w - length($unsat) - $r;
8080 $filler1 = "-"x4 . " "x$l;
8081 $filler2 = " "x$r . "-"x4 . "\n";
8084 my $r = int(($w - length($pretty_id))/2);
8085 my $l = $w - length($pretty_id) - $r;
8086 $filler3 = "-"x4 . " "x$l;
8087 $filler4 = " "x$r . "-"x4 . "\n";
8090 myprint("$filler1 $unsat $filler2".
8091 "$filler3 $pretty_id $filler4".
8092 join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @prereq_tuples),
8095 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
8097 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
8098 my $answer = CPAN::Shell::colorable_makemaker_prompt(
8099 "Shall I follow them and prepend them to the queue
8100 of modules we are processing right now?", "yes");
8101 $follow = $answer =~ /^\s*y/i;
8105 myprint(" Ignoring dependencies on modules @prereq\n");
8109 # color them as dirty
8110 for my $p (@prereq) {
8111 # warn "calling color_cmd_tmps(0,1)";
8112 my $any = CPAN::Shell->expandany($p);
8113 $self->{$slot . "_for"}{$any->id}++;
8115 $any->color_cmd_tmps(0,2);
8117 $CPAN::Frontend->mywarn("Warning (maybe a bug): Cannot expand prereq '$p'\n");
8118 $CPAN::Frontend->mysleep(2);
8121 # queue them and re-queue yourself
8122 CPAN::Queue->jumpqueue({qmod => $id, reqtype => $self->{reqtype}},
8123 map {+{qmod=>$_->[0],reqtype=>$_->[1]}} reverse @prereq_tuples);
8124 $self->{$slot} = "Delayed until after prerequisites";
8125 return 1; # signal success to the queuerunner
8130 #-> sub CPAN::Distribution::unsat_prereq ;
8131 # return ([Foo=>1],[Bar=>1.2]) for normal modules
8132 # return ([perl=>5.008]) if we need a newer perl than we are running under
8134 my($self,$slot) = @_;
8135 my(%merged,$prereq_pm);
8136 my $prefs_depends = $self->prefs->{depends}||{};
8137 if ($slot eq "configure_requires_later") {
8138 my $meta_yml = $self->parse_meta_yml();
8139 %merged = (%{$meta_yml->{configure_requires}||{}},
8140 %{$prefs_depends->{configure_requires}||{}});
8141 $prereq_pm = {}; # configure_requires defined as "b"
8142 } elsif ($slot eq "later") {
8143 my $prereq_pm_0 = $self->prereq_pm || {};
8144 for my $reqtype (qw(requires build_requires)) {
8145 $prereq_pm->{$reqtype} = {%{$prereq_pm_0->{$reqtype}||{}}}; # copy to not pollute it
8146 for my $k (keys %{$prefs_depends->{$reqtype}||{}}) {
8147 $prereq_pm->{$reqtype}{$k} = $prefs_depends->{$reqtype}{$k};
8150 %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
8152 die "Panic: illegal slot '$slot'";
8155 my @merged = %merged;
8156 CPAN->debug("all merged_prereqs[@merged]") if $CPAN::DEBUG;
8157 NEED: while (my($need_module, $need_version) = each %merged) {
8158 my($available_version,$available_file,$nmo);
8159 if ($need_module eq "perl") {
8160 $available_version = $];
8161 $available_file = $^X;
8163 $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
8164 next if $nmo->uptodate;
8165 $available_file = $nmo->available_file;
8167 # if they have not specified a version, we accept any installed one
8168 if (defined $available_file
8169 and ( # a few quick shortcurcuits
8170 not defined $need_version
8171 or $need_version eq '0' # "==" would trigger warning when not numeric
8172 or $need_version eq "undef"
8177 $available_version = $nmo->available_version;
8180 # We only want to install prereqs if either they're not installed
8181 # or if the installed version is too old. We cannot omit this
8182 # check, because if 'force' is in effect, nobody else will check.
8183 if (defined $available_file) {
8184 my(@all_requirements) = split /\s*,\s*/, $need_version;
8187 RQ: for my $rq (@all_requirements) {
8188 if ($rq =~ s|>=\s*||) {
8189 } elsif ($rq =~ s|>\s*||) {
8191 if (CPAN::Version->vgt($available_version,$rq)) {
8195 } elsif ($rq =~ s|!=\s*||) {
8197 if (CPAN::Version->vcmp($available_version,$rq)) {
8203 } elsif ($rq =~ m|<=?\s*|) {
8205 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])\n");
8209 if (! CPAN::Version->vgt($rq, $available_version)) {
8212 CPAN->debug(sprintf("need_module[%s]available_file[%s]".
8213 "available_version[%s]rq[%s]ok[%d]",
8217 CPAN::Version->readable($rq),
8221 next NEED if $ok == @all_requirements;
8224 if ($need_module eq "perl") {
8225 return ["perl", $need_version];
8227 $self->{sponsored_mods}{$need_module} ||= 0;
8228 CPAN->debug("need_module[$need_module]s/s/n[$self->{sponsored_mods}{$need_module}]") if $CPAN::DEBUG;
8229 if ($self->{sponsored_mods}{$need_module}++) {
8230 # We have already sponsored it and for some reason it's still
8231 # not available. So we do ... what??
8233 # if we push it again, we have a potential infinite loop
8235 # The following "next" was a very problematic construct.
8236 # It helped a lot but broke some day and had to be
8239 # We must be able to deal with modules that come again and
8240 # again as a prereq and have themselves prereqs and the
8241 # queue becomes long but finally we would find the correct
8242 # order. The RecursiveDependency check should trigger a
8243 # die when it's becoming too weird. Unfortunately removing
8244 # this next breaks many other things.
8246 # The bug that brought this up is described in Todo under
8247 # "5.8.9 cannot install Compress::Zlib"
8249 # next; # this is the next that had to go away
8251 # The following "next NEED" are fine and the error message
8252 # explains well what is going on. For example when the DBI
8253 # fails and consequently DBD::SQLite fails and now we are
8254 # processing CPAN::SQLite. Then we must have a "next" for
8255 # DBD::SQLite. How can we get it and how can we identify
8256 # all other cases we must identify?
8258 my $do = $nmo->distribution;
8259 next NEED unless $do; # not on CPAN
8260 NOSAYER: for my $nosayer (
8269 if ($do->{$nosayer}) {
8270 if (UNIVERSAL::can($do->{$nosayer},"failed") ?
8271 $do->{$nosayer}->failed :
8272 $do->{$nosayer} =~ /^NO/) {
8273 if ($nosayer eq "make_test"
8275 $do->{make_test}{COMMANDID} != $CPAN::CurrentCommandId
8279 $CPAN::Frontend->mywarn("Warning: Prerequisite ".
8280 "'$need_module => $need_version' ".
8281 "for '$self->{ID}' failed when ".
8282 "processing '$do->{ID}' with ".
8283 "'$nosayer => $do->{$nosayer}'. Continuing, ".
8284 "but chances to succeed are limited.\n"
8287 } else { # the other guy succeeded
8288 if ($nosayer eq "install") {
8290 # DMAKI/DateTime-Calendar-Chinese-0.05.tar.gz
8292 $CPAN::Frontend->mywarn("Warning: Prerequisite ".
8293 "'$need_module => $need_version' ".
8294 "for '$self->{ID}' already installed ".
8295 "but installation looks suspicious. ".
8296 "Skipping another installation attempt, ".
8297 "to prevent looping endlessly.\n"
8305 my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
8306 push @need, [$need_module,$needed_as];
8308 my @unfolded = map { "[".join(",",@$_)."]" } @need;
8309 CPAN->debug("returning from unsat_prereq[@unfolded]") if $CPAN::DEBUG;
8313 #-> sub CPAN::Distribution::read_yaml ;
8316 return $self->{yaml_content} if exists $self->{yaml_content};
8317 my $build_dir = $self->{build_dir};
8318 my $yaml = File::Spec->catfile($build_dir,"META.yml");
8319 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
8320 return unless -f $yaml;
8321 eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml)->[0]; };
8323 $CPAN::Frontend->mywarn("Could not read ".
8324 "'$yaml'. Falling back to other ".
8325 "methods to determine prerequisites\n");
8326 return $self->{yaml_content} = undef; # if we die, then we
8327 # cannot read YAML's own
8330 # not "authoritative"
8331 if (not exists $self->{yaml_content}{dynamic_config}
8332 or $self->{yaml_content}{dynamic_config}
8334 $self->{yaml_content} = undef;
8336 $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
8338 return $self->{yaml_content};
8341 #-> sub CPAN::Distribution::prereq_pm ;
8344 $self->{prereq_pm_detected} ||= 0;
8345 CPAN->debug("ID[$self->{ID}]prereq_pm_detected[$self->{prereq_pm_detected}]") if $CPAN::DEBUG;
8346 return $self->{prereq_pm} if $self->{prereq_pm_detected};
8347 return unless $self->{writemakefile} # no need to have succeeded
8348 # but we must have run it
8349 || $self->{modulebuild};
8350 CPAN->debug(sprintf "writemakefile[%s]modulebuild[%s]",
8351 $self->{writemakefile}||"",
8352 $self->{modulebuild}||"",
8355 if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
8356 $req = $yaml->{requires} || {};
8357 $breq = $yaml->{build_requires} || {};
8358 undef $req unless ref $req eq "HASH" && %$req;
8360 if ($yaml->{generated_by} &&
8361 $yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
8362 my $eummv = do { local $^W = 0; $1+0; };
8363 if ($eummv < 6.2501) {
8364 # thanks to Slaven for digging that out: MM before
8365 # that could be wrong because it could reflect a
8372 while (my($k,$v) = each %{$req||{}}) {
8375 } elsif ($k =~ /[A-Za-z]/ &&
8377 $CPAN::META->exists("Module",$v)
8379 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
8380 "requires hash: $k => $v; I'll take both ".
8381 "key and value as a module name\n");
8382 $CPAN::Frontend->mysleep(1);
8388 $req = $areq if $do_replace;
8391 unless ($req || $breq) {
8392 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
8393 my $makefile = File::Spec->catfile($build_dir,"Makefile");
8397 $fh = FileHandle->new("<$makefile\0")) {
8398 CPAN->debug("Getting prereq from Makefile") if $CPAN::DEBUG;
8401 last if /MakeMaker post_initialize section/;
8403 \s+PREREQ_PM\s+=>\s+(.+)
8406 # warn "Found prereq expr[$p]";
8408 # Regexp modified by A.Speer to remember actual version of file
8409 # PREREQ_PM hash key wants, then add to
8410 while ( $p =~ m/(?:\s)([\w\:]+)=>(q\[.*?\]|undef),?/g ) {
8411 # In case a prereq is mentioned twice, complain.
8412 if ( defined $req->{$1} ) {
8413 warn "Warning: PREREQ_PM mentions $1 more than once, ".
8414 "last mention wins";
8416 my($m,$n) = ($1,$2);
8417 if ($n =~ /^q\[(.*?)\]$/) {
8426 unless ($req || $breq) {
8427 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
8428 my $buildfile = File::Spec->catfile($build_dir,"Build");
8429 if (-f $buildfile) {
8430 CPAN->debug("Found '$buildfile'") if $CPAN::DEBUG;
8431 my $build_prereqs = File::Spec->catfile($build_dir,"_build","prereqs");
8432 if (-f $build_prereqs) {
8433 CPAN->debug("Getting prerequisites from '$build_prereqs'") if $CPAN::DEBUG;
8434 my $content = do { local *FH;
8435 open FH, $build_prereqs
8436 or $CPAN::Frontend->mydie("Could not open ".
8437 "'$build_prereqs': $!");
8441 my $bphash = eval $content;
8444 $req = $bphash->{requires} || +{};
8445 $breq = $bphash->{build_requires} || +{};
8451 && ! -f "Makefile.PL"
8452 && ! exists $req->{"Module::Build"}
8453 && ! $CPAN::META->has_inst("Module::Build")) {
8454 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
8455 "undeclared prerequisite.\n".
8456 " Adding it now as such.\n"
8458 $CPAN::Frontend->mysleep(5);
8459 $req->{"Module::Build"} = 0;
8460 delete $self->{writemakefile};
8462 if ($req || $breq) {
8463 $self->{prereq_pm_detected}++;
8464 return $self->{prereq_pm} = { requires => $req, build_requires => $breq };
8468 #-> sub CPAN::Distribution::test ;
8471 if (my $goto = $self->prefs->{goto}) {
8472 return $self->goto($goto);
8475 if ($CPAN::Signal) {
8476 delete $self->{force_update};
8479 # warn "XDEBUG: checking for notest: $self->{notest} $self";
8480 if ($self->{notest}) {
8481 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
8485 my $make = $self->{modulebuild} ? "Build" : "make";
8487 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
8489 : ($ENV{PERLLIB} || "");
8491 $CPAN::META->set_perl5lib;
8492 local $ENV{MAKEFLAGS}; # protect us from outer make calls
8494 $CPAN::Frontend->myprint("Running $make test\n");
8498 if ($self->{make} or $self->{later}) {
8502 "Make had some problems, won't test";
8505 exists $self->{make} and
8507 UNIVERSAL::can($self->{make},"failed") ?
8508 $self->{make}->failed :
8509 $self->{make} =~ /^NO/
8510 ) and push @e, "Can't test without successful make";
8511 $self->{badtestcnt} ||= 0;
8512 if ($self->{badtestcnt} > 0) {
8513 require Data::Dumper;
8514 CPAN->debug(sprintf "NOREPEAT[%s]", Data::Dumper::Dumper($self)) if $CPAN::DEBUG;
8515 push @e, "Won't repeat unsuccessful test during this command";
8518 push @e, $self->{later} if $self->{later};
8519 push @e, $self->{configure_requires_later} if $self->{configure_requires_later};
8521 if (exists $self->{build_dir}) {
8522 if (exists $self->{make_test}) {
8524 UNIVERSAL::can($self->{make_test},"failed") ?
8525 $self->{make_test}->failed :
8526 $self->{make_test} =~ /^NO/
8529 UNIVERSAL::can($self->{make_test},"commandid")
8531 $self->{make_test}->commandid == $CPAN::CurrentCommandId
8533 push @e, "Has already been tested within this command";
8536 push @e, "Has already been tested successfully";
8540 push @e, "Has no own directory";
8542 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
8543 unless (chdir $self->{build_dir}) {
8544 push @e, "Couldn't chdir to '$self->{build_dir}': $!";
8546 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
8548 $self->debug("Changed directory to $self->{build_dir}")
8551 if ($^O eq 'MacOS') {
8552 Mac::BuildTools::make_test($self);
8556 if ($self->{modulebuild}) {
8557 my $v = CPAN::Shell->expand("Module","Test::Harness")->inst_version;
8558 if (CPAN::Version->vlt($v,2.62)) {
8559 $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only
8560 '$v', you need at least '2.62'. Please upgrade your Test::Harness.\n});
8561 $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old");
8567 my $prefs_test = $self->prefs->{test};
8569 = exists $prefs_test->{commandline} ? $prefs_test->{commandline} : "") {
8570 $system = $commandline;
8572 } elsif ($self->{modulebuild}) {
8573 $system = sprintf "%s test", $self->_build_command();
8575 $system = join " ", $self->_make_command(), "test";
8577 my $make_test_arg = $self->make_x_arg("test");
8578 $system = sprintf("%s%s",
8580 $make_test_arg ? " $make_test_arg" : "",
8584 while (my($k,$v) = each %ENV) {
8585 next unless defined $v;
8589 if (my $env = $self->prefs->{test}{env}) {
8590 for my $e (keys %$env) {
8591 $ENV{$e} = $env->{$e};
8594 my $expect_model = $self->_prefs_with_expect("test");
8595 my $want_expect = 0;
8596 if ( $expect_model && @{$expect_model->{talk}} ) {
8597 my $can_expect = $CPAN::META->has_inst("Expect");
8601 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
8602 "testing without\n");
8606 if ($self->_should_report('test')) {
8607 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is currently ".
8608 "not supported when distroprefs specify ".
8609 "an interactive test\n");
8611 $tests_ok = $self->_run_via_expect($system,$expect_model) == 0;
8612 } elsif ( $self->_should_report('test') ) {
8613 $tests_ok = CPAN::Reporter::test($self, $system);
8615 $tests_ok = system($system) == 0;
8617 $self->introduce_myself;
8622 # local $CPAN::DEBUG = 16; # Distribution
8623 for my $m (keys %{$self->{sponsored_mods}}) {
8624 next unless $self->{sponsored_mods}{$m} > 0;
8625 my $m_obj = CPAN::Shell->expand("Module",$m) or next;
8626 # XXX we need available_version which reflects
8627 # $ENV{PERL5LIB} so that already tested but not yet
8628 # installed modules are counted.
8629 my $available_version = $m_obj->available_version;
8630 my $available_file = $m_obj->available_file;
8631 if ($available_version &&
8632 !CPAN::Version->vlt($available_version,$self->{prereq_pm}{$m})
8634 CPAN->debug("m[$m] good enough available_version[$available_version]")
8636 } elsif ($available_file
8638 !$self->{prereq_pm}{$m}
8640 $self->{prereq_pm}{$m} == 0
8643 # lex Class::Accessor::Chained::Fast which has no $VERSION
8644 CPAN->debug("m[$m] have available_file[$available_file]")
8652 my $which = join ",", @prereq;
8653 my $but = $cnt == 1 ? "one dependency not OK ($which)" :
8654 "$cnt dependencies missing ($which)";
8655 $CPAN::Frontend->mywarn("Tests succeeded but $but\n");
8656 $self->{make_test} = CPAN::Distrostatus->new("NO $but");
8657 $self->store_persistent_state;
8658 return $self->goodbye("[dependencies] -- NA");
8662 $CPAN::Frontend->myprint(" $system -- OK\n");
8663 $self->{make_test} = CPAN::Distrostatus->new("YES");
8664 $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
8665 # probably impossible to need the next line because badtestcnt
8666 # has a lifespan of one command
8667 delete $self->{badtestcnt};
8669 $self->{make_test} = CPAN::Distrostatus->new("NO");
8670 $self->{badtestcnt}++;
8671 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
8672 CPAN::Shell->optprint("hint",sprintf "//hint// To get more information about failing tests, try:
8673 reports %s\n", $self->pretty_id);
8675 $self->store_persistent_state;
8678 sub _prefs_with_expect {
8679 my($self,$where) = @_;
8680 return unless my $prefs = $self->prefs;
8681 return unless my $where_prefs = $prefs->{$where};
8682 if ($where_prefs->{expect}) {
8684 mode => "deterministic",
8686 talk => $where_prefs->{expect},
8688 } elsif ($where_prefs->{"eexpect"}) {
8689 return $where_prefs->{"eexpect"};
8694 #-> sub CPAN::Distribution::clean ;
8697 my $make = $self->{modulebuild} ? "Build" : "make";
8698 $CPAN::Frontend->myprint("Running $make clean\n");
8699 unless (exists $self->{archived}) {
8700 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
8701 "/untarred, nothing done\n");
8704 unless (exists $self->{build_dir}) {
8705 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
8708 if (exists $self->{writemakefile}
8709 and $self->{writemakefile}->failed
8711 $CPAN::Frontend->mywarn("No Makefile, don't know how to 'make clean'\n");
8716 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
8717 push @e, "make clean already called once";
8718 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
8720 chdir $self->{build_dir} or
8721 Carp::confess("Couldn't chdir to $self->{build_dir}: $!");
8722 $self->debug("Changed directory to $self->{build_dir}") if $CPAN::DEBUG;
8724 if ($^O eq 'MacOS') {
8725 Mac::BuildTools::make_clean($self);
8730 if ($self->{modulebuild}) {
8731 unless (-f "Build") {
8732 my $cwd = CPAN::anycwd();
8733 $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}".
8734 " in cwd[$cwd]. Danger, Will Robinson!");
8735 $CPAN::Frontend->mysleep(5);
8737 $system = sprintf "%s clean", $self->_build_command();
8739 $system = join " ", $self->_make_command(), "clean";
8741 my $system_ok = system($system) == 0;
8742 $self->introduce_myself;
8744 $CPAN::Frontend->myprint(" $system -- OK\n");
8748 # Jost Krieger pointed out that this "force" was wrong because
8749 # it has the effect that the next "install" on this distribution
8750 # will untar everything again. Instead we should bring the
8751 # object's state back to where it is after untarring.
8762 $self->{make_clean} = CPAN::Distrostatus->new("YES");
8765 # Hmmm, what to do if make clean failed?
8767 $self->{make_clean} = CPAN::Distrostatus->new("NO");
8768 $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n});
8770 # 2006-02-27: seems silly to me to force a make now
8771 # $self->force("make"); # so that this directory won't be used again
8774 $self->store_persistent_state;
8777 #-> sub CPAN::Distribution::goto ;
8779 my($self,$goto) = @_;
8780 $goto = $self->normalize($goto);
8782 "Goto '$goto' via prefs file '%s' doc %d",
8783 $self->{prefs_file},
8784 $self->{prefs_file_doc},
8786 $self->{unwrapped} = CPAN::Distrostatus->new("NO $why");
8787 # 2007-07-16 akoenig : Better than NA would be if we could inherit
8788 # the status of the $goto distro but given the exceptional nature
8789 # of 'goto' I feel reluctant to implement it
8790 my $goodbye_message = "[goto] -- NA $why";
8791 $self->goodbye($goodbye_message);
8793 # inject into the queue
8795 CPAN::Queue->delete($self->id);
8796 CPAN::Queue->jumpqueue({qmod => $goto, reqtype => $self->{reqtype}});
8798 # and run where we left off
8800 my($method) = (caller(1))[3];
8801 CPAN->instance("CPAN::Distribution",$goto)->$method();
8802 CPAN::Queue->delete_first($goto);
8805 #-> sub CPAN::Distribution::install ;
8808 if (my $goto = $self->prefs->{goto}) {
8809 return $self->goto($goto);
8812 unless ($self->{badtestcnt}) {
8815 if ($CPAN::Signal) {
8816 delete $self->{force_update};
8819 my $make = $self->{modulebuild} ? "Build" : "make";
8820 $CPAN::Frontend->myprint("Running $make install\n");
8823 if ($self->{make} or $self->{later}) {
8827 "Make had some problems, won't install";
8830 exists $self->{make} and
8832 UNIVERSAL::can($self->{make},"failed") ?
8833 $self->{make}->failed :
8834 $self->{make} =~ /^NO/
8836 push @e, "Make had returned bad status, install seems impossible";
8838 if (exists $self->{build_dir}) {
8840 push @e, "Has no own directory";
8843 if (exists $self->{make_test} and
8845 UNIVERSAL::can($self->{make_test},"failed") ?
8846 $self->{make_test}->failed :
8847 $self->{make_test} =~ /^NO/
8849 if ($self->{force_update}) {
8850 $self->{make_test}->text("FAILED but failure ignored because ".
8851 "'force' in effect");
8853 push @e, "make test had returned bad status, ".
8854 "won't install without force"
8857 if (exists $self->{install}) {
8858 if (UNIVERSAL::can($self->{install},"text") ?
8859 $self->{install}->text eq "YES" :
8860 $self->{install} =~ /^YES/
8862 $CPAN::Frontend->myprint(" Already done\n");
8863 $CPAN::META->is_installed($self->{build_dir});
8866 # comment in Todo on 2006-02-11; maybe retry?
8867 push @e, "Already tried without success";
8871 push @e, $self->{later} if $self->{later};
8872 push @e, $self->{configure_requires_later} if $self->{configure_requires_later};
8874 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
8875 unless (chdir $self->{build_dir}) {
8876 push @e, "Couldn't chdir to '$self->{build_dir}': $!";
8878 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
8880 $self->debug("Changed directory to $self->{build_dir}")
8883 if ($^O eq 'MacOS') {
8884 Mac::BuildTools::make_install($self);
8889 if (my $commandline = $self->prefs->{install}{commandline}) {
8890 $system = $commandline;
8892 } elsif ($self->{modulebuild}) {
8893 my($mbuild_install_build_command) =
8894 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
8895 $CPAN::Config->{mbuild_install_build_command} ?
8896 $CPAN::Config->{mbuild_install_build_command} :
8897 $self->_build_command();
8898 $system = sprintf("%s install %s",
8899 $mbuild_install_build_command,
8900 $CPAN::Config->{mbuild_install_arg},
8903 my($make_install_make_command) =
8904 CPAN::HandleConfig->prefs_lookup($self,
8905 q{make_install_make_command})
8906 || $self->_make_command();
8907 $system = sprintf("%s install %s",
8908 $make_install_make_command,
8909 $CPAN::Config->{make_install_arg},
8913 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
8914 my $brip = CPAN::HandleConfig->prefs_lookup($self,
8915 q{build_requires_install_policy});
8918 my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command
8919 my $want_install = "yes";
8920 if ($reqtype eq "b") {
8921 if ($brip eq "no") {
8922 $want_install = "no";
8923 } elsif ($brip =~ m|^ask/(.+)|) {
8925 $default = "yes" unless $default =~ /^(y|n)/i;
8927 CPAN::Shell::colorable_makemaker_prompt
8928 ("$id is just needed temporarily during building or testing. ".
8929 "Do you want to install it permanently? (Y/n)",
8933 unless ($want_install =~ /^y/i) {
8934 my $is_only = "is only 'build_requires'";
8935 $CPAN::Frontend->mywarn("Not installing because $is_only\n");
8936 $self->{install} = CPAN::Distrostatus->new("NO -- $is_only");
8937 delete $self->{force_update};
8940 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
8942 : ($ENV{PERLLIB} || "");
8944 $CPAN::META->set_perl5lib;
8945 my($pipe) = FileHandle->new("$system $stderr |");
8948 print $_; # intentionally NOT use Frontend->myprint because it
8949 # looks irritating when we markup in color what we
8950 # just pass through from an external program
8954 my $close_ok = $? == 0;
8955 $self->introduce_myself;
8957 $CPAN::Frontend->myprint(" $system -- OK\n");
8958 $CPAN::META->is_installed($self->{build_dir});
8959 $self->{install} = CPAN::Distrostatus->new("YES");
8961 $self->{install} = CPAN::Distrostatus->new("NO");
8962 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
8964 CPAN::HandleConfig->prefs_lookup($self,
8965 q{make_install_make_command});
8967 $makeout =~ /permission/s
8971 || $mimc eq (CPAN::HandleConfig->prefs_lookup($self,
8975 $CPAN::Frontend->myprint(
8977 qq{ You may have to su }.
8978 qq{to root to install the package\n}.
8979 qq{ (Or you may want to run something like\n}.
8980 qq{ o conf make_install_make_command 'sudo make'\n}.
8981 qq{ to raise your permissions.}
8985 delete $self->{force_update};
8987 $self->store_persistent_state;
8990 sub introduce_myself {
8992 $CPAN::Frontend->myprint(sprintf(" %s\n",$self->pretty_id));
8995 #-> sub CPAN::Distribution::dir ;
9000 #-> sub CPAN::Distribution::perldoc ;
9004 my($dist) = $self->id;
9005 my $package = $self->called_for;
9007 $self->_display_url( $CPAN::Defaultdocs . $package );
9010 #-> sub CPAN::Distribution::_check_binary ;
9012 my ($dist,$shell,$binary) = @_;
9015 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
9018 if ($CPAN::META->has_inst("File::Which")) {
9019 return File::Which::which($binary);
9022 $pid = open README, "which $binary|"
9023 or $CPAN::Frontend->mywarn(qq{Could not fork 'which $binary': $!\n});
9029 or $CPAN::Frontend->mywarn("Could not run 'which $binary': $!\n")
9033 $CPAN::Frontend->myprint(qq{ + $out \n})
9034 if $CPAN::DEBUG && $out;
9039 #-> sub CPAN::Distribution::_display_url ;
9041 my($self,$url) = @_;
9042 my($res,$saved_file,$pid,$out);
9044 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
9047 # should we define it in the config instead?
9048 my $html_converter = "html2text.pl";
9050 my $web_browser = $CPAN::Config->{'lynx'} || undef;
9051 my $web_browser_out = $web_browser
9052 ? CPAN::Distribution->_check_binary($self,$web_browser)
9055 if ($web_browser_out) {
9056 # web browser found, run the action
9057 my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
9058 $CPAN::Frontend->myprint(qq{system[$browser $url]})
9060 $CPAN::Frontend->myprint(qq{
9063 with browser $browser
9065 $CPAN::Frontend->mysleep(1);
9066 system("$browser $url");
9067 if ($saved_file) { 1 while unlink($saved_file) }
9069 # web browser not found, let's try text only
9070 my $html_converter_out =
9071 CPAN::Distribution->_check_binary($self,$html_converter);
9072 $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
9074 if ($html_converter_out ) {
9075 # html2text found, run it
9076 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
9077 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
9078 unless defined($saved_file);
9081 $pid = open README, "$html_converter $saved_file |"
9082 or $CPAN::Frontend->mydie(qq{
9083 Could not fork '$html_converter $saved_file': $!});
9085 if ($CPAN::META->has_inst("File::Temp")) {
9086 $fh = File::Temp->new(
9087 dir => File::Spec->tmpdir,
9088 template => 'cpan_htmlconvert_XXXX',
9092 $filename = $fh->filename;
9094 $filename = "cpan_htmlconvert_$$.txt";
9095 $fh = FileHandle->new();
9096 open $fh, ">$filename" or die;
9102 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
9103 my $tmpin = $fh->filename;
9104 $CPAN::Frontend->myprint(sprintf(qq{
9106 saved output to %s\n},
9114 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
9115 my $fh_pager = FileHandle->new;
9116 local($SIG{PIPE}) = "IGNORE";
9117 my $pager = $CPAN::Config->{'pager'} || "cat";
9118 $fh_pager->open("|$pager")
9119 or $CPAN::Frontend->mydie(qq{
9120 Could not open pager '$pager': $!});
9121 $CPAN::Frontend->myprint(qq{
9126 $CPAN::Frontend->mysleep(1);
9127 $fh_pager->print(<FH>);
9130 # coldn't find the web browser or html converter
9131 $CPAN::Frontend->myprint(qq{
9132 You need to install lynx or $html_converter to use this feature.});
9137 #-> sub CPAN::Distribution::_getsave_url ;
9139 my($dist, $shell, $url) = @_;
9141 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
9145 if ($CPAN::META->has_inst("File::Temp")) {
9146 $fh = File::Temp->new(
9147 dir => File::Spec->tmpdir,
9148 template => "cpan_getsave_url_XXXX",
9152 $filename = $fh->filename;
9154 $fh = FileHandle->new;
9155 $filename = "cpan_getsave_url_$$.html";
9157 my $tmpin = $filename;
9158 if ($CPAN::META->has_usable('LWP')) {
9159 $CPAN::Frontend->myprint("Fetching with LWP:
9163 CPAN::LWP::UserAgent->config;
9164 eval { $Ua = CPAN::LWP::UserAgent->new; };
9166 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
9170 $Ua->proxy('http', $var)
9171 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
9173 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
9176 my $req = HTTP::Request->new(GET => $url);
9177 $req->header('Accept' => 'text/html');
9178 my $res = $Ua->request($req);
9179 if ($res->is_success) {
9180 $CPAN::Frontend->myprint(" + request successful.\n")
9182 print $fh $res->content;
9184 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
9188 $CPAN::Frontend->myprint(sprintf(
9189 "LWP failed with code[%s], message[%s]\n",
9196 $CPAN::Frontend->mywarn(" LWP not available\n");
9201 #-> sub CPAN::Distribution::_build_command
9202 sub _build_command {
9204 if ($^O eq "MSWin32") { # special code needed at least up to
9205 # Module::Build 0.2611 and 0.2706; a fix
9206 # in M:B has been promised 2006-01-30
9207 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
9208 return "$perl ./Build";
9213 #-> sub CPAN::Distribution::_should_report
9214 sub _should_report {
9215 my($self, $phase) = @_;
9216 die "_should_report() requires a 'phase' argument"
9217 if ! defined $phase;
9220 my $test_report = CPAN::HandleConfig->prefs_lookup($self,
9222 return unless $test_report;
9224 # don't repeat if we cached a result
9225 return $self->{should_report}
9226 if exists $self->{should_report};
9229 if ( ! $CPAN::META->has_inst("CPAN::Reporter")) {
9230 $CPAN::Frontend->mywarn(
9231 "CPAN::Reporter not installed. No reports will be sent.\n"
9233 return $self->{should_report} = 0;
9237 my $crv = CPAN::Reporter->VERSION;
9238 if ( CPAN::Version->vlt( $crv, 0.99 ) ) {
9239 # don't cache $self->{should_report} -- need to check each phase
9240 if ( $phase eq 'test' ) {
9244 $CPAN::Frontend->mywarn(
9245 "Reporting on the '$phase' phase requires CPAN::Reporter 0.99, but \n" .
9246 "you only have version $crv\. Only 'test' phase reports will be sent.\n"
9253 if ($self->is_dot_dist) {
9254 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
9255 "for local directories\n");
9256 return $self->{should_report} = 0;
9258 if ($self->prefs->{patches}
9260 @{$self->prefs->{patches}}
9264 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
9265 "when the source has been patched\n");
9266 return $self->{should_report} = 0;
9269 # proceed and cache success
9270 return $self->{should_report} = 1;
9273 #-> sub CPAN::Distribution::reports
9276 my $pathname = $self->id;
9277 $CPAN::Frontend->myprint("Distribution: $pathname\n");
9279 unless ($CPAN::META->has_inst("CPAN::DistnameInfo")) {
9280 $CPAN::Frontend->mydie("CPAN::DistnameInfo not installed; cannot continue");
9282 unless ($CPAN::META->has_usable("LWP")) {
9283 $CPAN::Frontend->mydie("LWP not installed; cannot continue");
9285 unless ($CPAN::META->has_inst("File::Temp")) {
9286 $CPAN::Frontend->mydie("File::Temp not installed; cannot continue");
9289 my $d = CPAN::DistnameInfo->new($pathname);
9291 my $dist = $d->dist; # "CPAN-DistnameInfo"
9292 my $version = $d->version; # "0.02"
9293 my $maturity = $d->maturity; # "released"
9294 my $filename = $d->filename; # "CPAN-DistnameInfo-0.02.tar.gz"
9295 my $cpanid = $d->cpanid; # "GBARR"
9296 my $distvname = $d->distvname; # "CPAN-DistnameInfo-0.02"
9298 my $url = sprintf "http://cpantesters.perl.org/show/%s.yaml", $dist;
9300 CPAN::LWP::UserAgent->config;
9302 eval { $Ua = CPAN::LWP::UserAgent->new; };
9304 $CPAN::Frontend->mydie("CPAN::LWP::UserAgent->new dies with $@\n");
9306 $CPAN::Frontend->myprint("Fetching '$url'...");
9307 my $resp = $Ua->get($url);
9308 unless ($resp->is_success) {
9309 $CPAN::Frontend->mydie(sprintf "Could not download '%s': %s\n", $url, $resp->code);
9311 $CPAN::Frontend->myprint("DONE\n\n");
9312 my $yaml = $resp->content;
9313 # was fuer ein Umweg!
9314 my $fh = File::Temp->new(
9315 dir => File::Spec->tmpdir,
9316 template => 'cpan_reports_XXXX',
9320 my $tfilename = $fh->filename;
9322 close $fh or $CPAN::Frontend->mydie("Could not close '$tfilename': $!");
9323 my $unserialized = CPAN->_yaml_loadfile($tfilename)->[0];
9324 unlink $tfilename or $CPAN::Frontend->mydie("Could not unlink '$tfilename': $!");
9326 my $this_version_seen;
9327 for my $rep (@$unserialized) {
9328 my $rversion = $rep->{version};
9329 if ($rversion eq $version) {
9330 unless ($this_version_seen++) {
9331 $CPAN::Frontend->myprint ("$rep->{version}:\n");
9333 $CPAN::Frontend->myprint
9334 (sprintf("%1s%1s%-4s %s on %s %s (%s)\n",
9335 $rep->{archname} eq $Config::Config{archname}?"*":"",
9336 $rep->{action}eq"PASS"?"+":$rep->{action}eq"FAIL"?"-":"",
9339 ucfirst $rep->{osname},
9344 $other_versions{$rep->{version}}++;
9347 unless ($this_version_seen) {
9348 $CPAN::Frontend->myprint("No reports found for version '$version'
9349 Reports for other versions:\n");
9350 for my $v (sort keys %other_versions) {
9351 $CPAN::Frontend->myprint(" $v\: $other_versions{$v}\n");
9354 $url =~ s/\.yaml/.html/;
9355 $CPAN::Frontend->myprint("See $url for details\n");
9358 package CPAN::Bundle;
9363 $CPAN::Frontend->myprint($self->as_string);
9366 #-> CPAN::Bundle::undelay
9369 delete $self->{later};
9370 for my $c ( $self->contains ) {
9371 my $obj = CPAN::Shell->expandany($c) or next;
9376 # mark as dirty/clean
9377 #-> sub CPAN::Bundle::color_cmd_tmps ;
9378 sub color_cmd_tmps {
9380 my($depth) = shift || 0;
9381 my($color) = shift || 0;
9382 my($ancestors) = shift || [];
9383 # a module needs to recurse to its cpan_file, a distribution needs
9384 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
9386 return if exists $self->{incommandcolor}
9388 && $self->{incommandcolor}==$color;
9389 if ($depth>=$CPAN::MAX_RECURSION) {
9390 die(CPAN::Exception::RecursiveDependency->new($ancestors));
9392 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
9394 for my $c ( $self->contains ) {
9395 my $obj = CPAN::Shell->expandany($c) or next;
9396 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
9397 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
9399 # never reached code?
9401 #delete $self->{badtestcnt};
9403 $self->{incommandcolor} = $color;
9406 #-> sub CPAN::Bundle::as_string ;
9410 # following line must be "=", not "||=" because we have a moving target
9411 $self->{INST_VERSION} = $self->inst_version;
9412 return $self->SUPER::as_string;
9415 #-> sub CPAN::Bundle::contains ;
9418 my($inst_file) = $self->inst_file || "";
9419 my($id) = $self->id;
9420 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
9421 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
9424 unless ($inst_file) {
9425 # Try to get at it in the cpan directory
9426 $self->debug("no inst_file") if $CPAN::DEBUG;
9428 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
9429 $cpan_file = $self->cpan_file;
9430 if ($cpan_file eq "N/A") {
9431 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
9432 Maybe stale symlink? Maybe removed during session? Giving up.\n");
9434 my $dist = $CPAN::META->instance('CPAN::Distribution',
9436 $self->debug("before get id[$dist->{ID}]") if $CPAN::DEBUG;
9438 $self->debug("after get id[$dist->{ID}]") if $CPAN::DEBUG;
9439 my($todir) = $CPAN::Config->{'cpan_home'};
9440 my(@me,$from,$to,$me);
9441 @me = split /::/, $self->id;
9443 $me = File::Spec->catfile(@me);
9444 $from = $self->find_bundle_file($dist->{build_dir},join('/',@me));
9445 $to = File::Spec->catfile($todir,$me);
9446 File::Path::mkpath(File::Basename::dirname($to));
9447 File::Copy::copy($from, $to)
9448 or Carp::confess("Couldn't copy $from to $to: $!");
9452 my $fh = FileHandle->new;
9454 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
9456 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
9458 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
9459 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
9460 next unless $in_cont;
9465 push @result, (split " ", $_, 2)[0];
9468 delete $self->{STATUS};
9469 $self->{CONTAINS} = \@result;
9470 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
9472 $CPAN::Frontend->mywarn(qq{
9473 The bundle file "$inst_file" may be a broken
9474 bundlefile. It seems not to contain any bundle definition.
9475 Please check the file and if it is bogus, please delete it.
9476 Sorry for the inconvenience.
9482 #-> sub CPAN::Bundle::find_bundle_file
9483 # $where is in local format, $what is in unix format
9484 sub find_bundle_file {
9485 my($self,$where,$what) = @_;
9486 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
9487 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
9488 ### my $bu = File::Spec->catfile($where,$what);
9489 ### return $bu if -f $bu;
9490 my $manifest = File::Spec->catfile($where,"MANIFEST");
9491 unless (-f $manifest) {
9492 require ExtUtils::Manifest;
9493 my $cwd = CPAN::anycwd();
9494 $self->safe_chdir($where);
9495 ExtUtils::Manifest::mkmanifest();
9496 $self->safe_chdir($cwd);
9498 my $fh = FileHandle->new($manifest)
9499 or Carp::croak("Couldn't open $manifest: $!");
9501 my $bundle_filename = $what;
9502 $bundle_filename =~ s|Bundle.*/||;
9503 my $bundle_unixpath;
9506 my($file) = /(\S+)/;
9507 if ($file =~ m|\Q$what\E$|) {
9508 $bundle_unixpath = $file;
9509 # return File::Spec->catfile($where,$bundle_unixpath); # bad
9512 # retry if she managed to have no Bundle directory
9513 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
9515 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
9516 if $bundle_unixpath;
9517 Carp::croak("Couldn't find a Bundle file in $where");
9520 # needs to work quite differently from Module::inst_file because of
9521 # cpan_home/Bundle/ directory and the possibility that we have
9522 # shadowing effect. As it makes no sense to take the first in @INC for
9523 # Bundles, we parse them all for $VERSION and take the newest.
9525 #-> sub CPAN::Bundle::inst_file ;
9530 @me = split /::/, $self->id;
9533 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
9534 my $bfile = File::Spec->catfile($incdir, @me);
9535 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
9536 next unless -f $bfile;
9537 my $foundv = MM->parse_version($bfile);
9538 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
9539 $self->{INST_FILE} = $bfile;
9540 $self->{INST_VERSION} = $bestv = $foundv;
9546 #-> sub CPAN::Bundle::inst_version ;
9549 $self->inst_file; # finds INST_VERSION as side effect
9550 $self->{INST_VERSION};
9553 #-> sub CPAN::Bundle::rematein ;
9555 my($self,$meth) = @_;
9556 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
9557 my($id) = $self->id;
9558 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
9559 unless $self->inst_file || $self->cpan_file;
9561 for $s ($self->contains) {
9562 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
9563 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
9564 if ($type eq 'CPAN::Distribution') {
9565 $CPAN::Frontend->mywarn(qq{
9566 The Bundle }.$self->id.qq{ contains
9567 explicitly a file '$s'.
9568 Going to $meth that.
9570 $CPAN::Frontend->mysleep(5);
9572 # possibly noisy action:
9573 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
9574 my $obj = $CPAN::META->instance($type,$s);
9575 $obj->{reqtype} = $self->{reqtype};
9580 # If a bundle contains another that contains an xs_file we have here,
9581 # we just don't bother I suppose
9582 #-> sub CPAN::Bundle::xs_file
9587 #-> sub CPAN::Bundle::force ;
9588 sub fforce { shift->rematein('fforce',@_); }
9589 #-> sub CPAN::Bundle::force ;
9590 sub force { shift->rematein('force',@_); }
9591 #-> sub CPAN::Bundle::notest ;
9592 sub notest { shift->rematein('notest',@_); }
9593 #-> sub CPAN::Bundle::get ;
9594 sub get { shift->rematein('get',@_); }
9595 #-> sub CPAN::Bundle::make ;
9596 sub make { shift->rematein('make',@_); }
9597 #-> sub CPAN::Bundle::test ;
9600 # $self->{badtestcnt} ||= 0;
9601 $self->rematein('test',@_);
9603 #-> sub CPAN::Bundle::install ;
9606 $self->rematein('install',@_);
9608 #-> sub CPAN::Bundle::clean ;
9609 sub clean { shift->rematein('clean',@_); }
9611 #-> sub CPAN::Bundle::uptodate ;
9614 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
9616 foreach $c ($self->contains) {
9617 my $obj = CPAN::Shell->expandany($c);
9618 return 0 unless $obj->uptodate;
9623 #-> sub CPAN::Bundle::readme ;
9626 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
9627 No File found for bundle } . $self->id . qq{\n}), return;
9628 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
9629 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
9632 package CPAN::Module;
9636 #-> sub CPAN::Module::userid
9641 return $ro->{userid} || $ro->{CPAN_USERID};
9643 #-> sub CPAN::Module::description
9646 my $ro = $self->ro or return "";
9650 #-> sub CPAN::Module::distribution
9653 CPAN::Shell->expand("Distribution",$self->cpan_file);
9656 #-> sub CPAN::Module::undelay
9659 delete $self->{later};
9660 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
9665 # mark as dirty/clean
9666 #-> sub CPAN::Module::color_cmd_tmps ;
9667 sub color_cmd_tmps {
9669 my($depth) = shift || 0;
9670 my($color) = shift || 0;
9671 my($ancestors) = shift || [];
9672 # a module needs to recurse to its cpan_file
9674 return if exists $self->{incommandcolor}
9676 && $self->{incommandcolor}==$color;
9677 return if $color==0 && !$self->{incommandcolor};
9679 if ( $self->uptodate ) {
9680 $self->{incommandcolor} = $color;
9682 } elsif (my $have_version = $self->available_version) {
9683 # maybe what we have is good enough
9685 my $who_asked_for_me = $ancestors->[-1];
9686 my $obj = CPAN::Shell->expandany($who_asked_for_me);
9688 } elsif ($obj->isa("CPAN::Bundle")) {
9689 # bundles cannot specify a minimum version
9691 } elsif ($obj->isa("CPAN::Distribution")) {
9692 if (my $prereq_pm = $obj->prereq_pm) {
9693 for my $k (keys %$prereq_pm) {
9694 if (my $want_version = $prereq_pm->{$k}{$self->id}) {
9695 if (CPAN::Version->vcmp($have_version,$want_version) >= 0) {
9696 $self->{incommandcolor} = $color;
9706 $self->{incommandcolor} = $color; # set me before recursion,
9707 # so we can break it
9709 if ($depth>=$CPAN::MAX_RECURSION) {
9710 die(CPAN::Exception::RecursiveDependency->new($ancestors));
9712 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
9714 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
9715 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
9719 # delete $self->{badtestcnt};
9721 $self->{incommandcolor} = $color;
9724 #-> sub CPAN::Module::as_glimpse ;
9728 my $class = ref($self);
9729 $class =~ s/^CPAN:://;
9733 $CPAN::Shell::COLOR_REGISTERED
9735 $CPAN::META->has_inst("Term::ANSIColor")
9739 $color_on = Term::ANSIColor::color("green");
9740 $color_off = Term::ANSIColor::color("reset");
9742 my $uptodateness = " ";
9743 if ($class eq "Bundle") {
9744 } elsif ($self->uptodate) {
9745 $uptodateness = "=";
9746 } elsif ($self->inst_version) {
9747 $uptodateness = "<";
9749 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
9755 ($self->distribution ?
9756 $self->distribution->pretty_id :
9763 #-> sub CPAN::Module::dslip_status
9767 # development status
9768 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
9769 pre-alpha alpha beta released
9772 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
9773 developer comp.lang.perl.*
9776 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
9778 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
9780 object-oriented pragma
9783 @{$stat->{P}}{qw,p g l b a 2 o d r n,} = qw,Standard-Perl
9785 BSD Artistic Artistic_2
9787 distribution_allowed
9788 restricted_distribution
9790 for my $x (qw(d s l i p)) {
9791 $stat->{$x}{' '} = 'unknown';
9792 $stat->{$x}{'?'} = 'unknown';
9795 return +{} unless $ro && $ro->{statd};
9802 DV => $stat->{D}{$ro->{statd}},
9803 SV => $stat->{S}{$ro->{stats}},
9804 LV => $stat->{L}{$ro->{statl}},
9805 IV => $stat->{I}{$ro->{stati}},
9806 PV => $stat->{P}{$ro->{statp}},
9810 #-> sub CPAN::Module::as_string ;
9814 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
9815 my $class = ref($self);
9816 $class =~ s/^CPAN:://;
9818 push @m, $class, " id = $self->{ID}\n";
9819 my $sprintf = " %-12s %s\n";
9820 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
9821 if $self->description;
9822 my $sprintf2 = " %-12s %s (%s)\n";
9824 $userid = $self->userid;
9827 if ($author = CPAN::Shell->expand('Author',$userid)) {
9830 if ($m = $author->email) {
9837 $author->fullname . $email
9841 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
9842 if $self->cpan_version;
9843 if (my $cpan_file = $self->cpan_file) {
9844 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
9845 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
9846 my $upload_date = $dist->upload_date;
9848 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
9852 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
9853 my $dslip = $self->dslip_status;
9857 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
9859 my $local_file = $self->inst_file;
9860 unless ($self->{MANPAGE}) {
9863 $manpage = $self->manpage_headline($local_file);
9865 # If we have already untarred it, we should look there
9866 my $dist = $CPAN::META->instance('CPAN::Distribution',
9868 # warn "dist[$dist]";
9869 # mff=manifest file; mfh=manifest handle
9874 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
9876 $mfh = FileHandle->new($mff)
9878 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
9879 my $lfre = $self->id; # local file RE
9882 my($lfl); # local file file
9884 my(@mflines) = <$mfh>;
9889 while (length($lfre)>5 and !$lfl) {
9890 ($lfl) = grep /$lfre/, @mflines;
9891 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
9894 $lfl =~ s/\s.*//; # remove comments
9895 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
9896 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
9897 # warn "lfl_abs[$lfl_abs]";
9899 $manpage = $self->manpage_headline($lfl_abs);
9903 $self->{MANPAGE} = $manpage if $manpage;
9906 for $item (qw/MANPAGE/) {
9907 push @m, sprintf($sprintf, $item, $self->{$item})
9908 if exists $self->{$item};
9910 for $item (qw/CONTAINS/) {
9911 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
9912 if exists $self->{$item} && @{$self->{$item}};
9914 push @m, sprintf($sprintf, 'INST_FILE',
9915 $local_file || "(not installed)");
9916 push @m, sprintf($sprintf, 'INST_VERSION',
9917 $self->inst_version) if $local_file;
9921 #-> sub CPAN::Module::manpage_headline
9922 sub manpage_headline {
9923 my($self,$local_file) = @_;
9924 my(@local_file) = $local_file;
9925 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
9926 push @local_file, $local_file;
9928 for $locf (@local_file) {
9929 next unless -f $locf;
9930 my $fh = FileHandle->new($locf)
9931 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
9935 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
9936 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
9953 #-> sub CPAN::Module::cpan_file ;
9954 # Note: also inherited by CPAN::Bundle
9957 # CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
9958 unless ($self->ro) {
9959 CPAN::Index->reload;
9962 if ($ro && defined $ro->{CPAN_FILE}) {
9963 return $ro->{CPAN_FILE};
9965 my $userid = $self->userid;
9967 if ($CPAN::META->exists("CPAN::Author",$userid)) {
9968 my $author = $CPAN::META->instance("CPAN::Author",
9970 my $fullname = $author->fullname;
9971 my $email = $author->email;
9972 unless (defined $fullname && defined $email) {
9973 return sprintf("Contact Author %s",
9977 return "Contact Author $fullname <$email>";
9979 return "Contact Author $userid (Email address not available)";
9987 #-> sub CPAN::Module::cpan_version ;
9993 # Can happen with modules that are not on CPAN
9996 $ro->{CPAN_VERSION} = 'undef'
9997 unless defined $ro->{CPAN_VERSION};
9998 $ro->{CPAN_VERSION};
10001 #-> sub CPAN::Module::force ;
10004 $self->{force_update} = 1;
10007 #-> sub CPAN::Module::fforce ;
10010 $self->{force_update} = 2;
10013 #-> sub CPAN::Module::notest ;
10016 # $CPAN::Frontend->mywarn("XDEBUG: set notest for Module");
10020 #-> sub CPAN::Module::rematein ;
10022 my($self,$meth) = @_;
10023 $CPAN::Frontend->myprint(sprintf("Running %s for module '%s'\n",
10026 my $cpan_file = $self->cpan_file;
10027 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/) {
10028 $CPAN::Frontend->mywarn(sprintf qq{
10029 The module %s isn\'t available on CPAN.
10031 Either the module has not yet been uploaded to CPAN, or it is
10032 temporary unavailable. Please contact the author to find out
10033 more about the status. Try 'i %s'.
10040 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
10041 $pack->called_for($self->id);
10042 if (exists $self->{force_update}) {
10043 if ($self->{force_update} == 2) {
10044 $pack->fforce($meth);
10046 $pack->force($meth);
10049 $pack->notest($meth) if exists $self->{notest} && $self->{notest};
10051 $pack->{reqtype} ||= "";
10052 CPAN->debug("dist-reqtype[$pack->{reqtype}]".
10053 "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG;
10054 if ($pack->{reqtype}) {
10055 if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) {
10056 $pack->{reqtype} = $self->{reqtype};
10058 exists $pack->{install}
10061 UNIVERSAL::can($pack->{install},"failed") ?
10062 $pack->{install}->failed :
10063 $pack->{install} =~ /^NO/
10066 delete $pack->{install};
10067 $CPAN::Frontend->mywarn
10068 ("Promoting $pack->{ID} from 'build_requires' to 'requires'");
10072 $pack->{reqtype} = $self->{reqtype};
10075 my $success = eval {
10079 $pack->unforce if $pack->can("unforce") && exists $self->{force_update};
10080 $pack->unnotest if $pack->can("unnotest") && exists $self->{notest};
10081 delete $self->{force_update};
10082 delete $self->{notest};
10089 #-> sub CPAN::Module::perldoc ;
10090 sub perldoc { shift->rematein('perldoc') }
10091 #-> sub CPAN::Module::readme ;
10092 sub readme { shift->rematein('readme') }
10093 #-> sub CPAN::Module::look ;
10094 sub look { shift->rematein('look') }
10095 #-> sub CPAN::Module::cvs_import ;
10096 sub cvs_import { shift->rematein('cvs_import') }
10097 #-> sub CPAN::Module::get ;
10098 sub get { shift->rematein('get',@_) }
10099 #-> sub CPAN::Module::make ;
10100 sub make { shift->rematein('make') }
10101 #-> sub CPAN::Module::test ;
10104 # $self->{badtestcnt} ||= 0;
10105 $self->rematein('test',@_);
10107 #-> sub CPAN::Module::uptodate ;
10110 local($_); # protect against a bug in MakeMaker 6.17
10111 my($latest) = $self->cpan_version;
10113 my($inst_file) = $self->inst_file;
10115 if (defined $inst_file) {
10116 $have = $self->inst_version;
10121 ! CPAN::Version->vgt($latest, $have)
10123 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
10124 "latest[$latest] have[$have]") if $CPAN::DEBUG;
10129 #-> sub CPAN::Module::install ;
10133 if ($self->uptodate
10135 not exists $self->{force_update}
10137 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
10139 $self->inst_version,
10144 my $ro = $self->ro;
10145 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
10146 $CPAN::Frontend->mywarn(qq{
10147 \n\n\n ***WARNING***
10148 The module $self->{ID} has no active maintainer.\n\n\n
10150 $CPAN::Frontend->mysleep(5);
10152 $self->rematein('install') if $doit;
10154 #-> sub CPAN::Module::clean ;
10155 sub clean { shift->rematein('clean') }
10157 #-> sub CPAN::Module::inst_file ;
10160 $self->_file_in_path([@INC]);
10163 #-> sub CPAN::Module::available_file ;
10164 sub available_file {
10166 my $sep = $Config::Config{path_sep};
10167 my $perllib = $ENV{PERL5LIB};
10168 $perllib = $ENV{PERLLIB} unless defined $perllib;
10169 my @perllib = split(/$sep/,$perllib) if defined $perllib;
10170 $self->_file_in_path([@perllib,@INC]);
10173 #-> sub CPAN::Module::file_in_path ;
10174 sub _file_in_path {
10175 my($self,$path) = @_;
10176 my($dir,@packpath);
10177 @packpath = split /::/, $self->{ID};
10178 $packpath[-1] .= ".pm";
10179 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
10180 unshift @packpath, "Term", "ReadLine"; # historical reasons
10182 foreach $dir (@$path) {
10183 my $pmfile = File::Spec->catfile($dir,@packpath);
10191 #-> sub CPAN::Module::xs_file ;
10194 my($dir,@packpath);
10195 @packpath = split /::/, $self->{ID};
10196 push @packpath, $packpath[-1];
10197 $packpath[-1] .= "." . $Config::Config{'dlext'};
10198 foreach $dir (@INC) {
10199 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
10207 #-> sub CPAN::Module::inst_version ;
10210 my $parsefile = $self->inst_file or return;
10211 my $have = $self->parse_version($parsefile);
10215 #-> sub CPAN::Module::inst_version ;
10216 sub available_version {
10218 my $parsefile = $self->available_file or return;
10219 my $have = $self->parse_version($parsefile);
10223 #-> sub CPAN::Module::parse_version ;
10224 sub parse_version {
10225 my($self,$parsefile) = @_;
10226 my $have = MM->parse_version($parsefile);
10227 $have = "undef" unless defined $have && length $have;
10228 $have =~ s/^ //; # since the %vd hack these two lines here are needed
10229 $have =~ s/ $//; # trailing whitespace happens all the time
10231 $have = CPAN::Version->readable($have);
10233 $have =~ s/\s*//g; # stringify to float around floating point issues
10234 $have; # no stringify needed, \s* above matches always
10237 #-> sub CPAN::Module::reports
10240 $self->distribution->reports;
10253 CPAN - query, download and build perl modules from CPAN sites
10259 perl -MCPAN -e shell
10269 cpan> install Acme::Meta # in the shell
10271 CPAN::Shell->install("Acme::Meta"); # in perl
10275 cpan> install NWCLARK/Acme-Meta-0.02.tar.gz # in the shell
10278 install("NWCLARK/Acme-Meta-0.02.tar.gz"); # in perl
10282 $mo = CPAN::Shell->expandany($mod);
10283 $mo = CPAN::Shell->expand("Module",$mod); # same thing
10285 # distribution objects:
10287 $do = CPAN::Shell->expand("Module",$mod)->distribution;
10288 $do = CPAN::Shell->expandany($distro); # same thing
10289 $do = CPAN::Shell->expand("Distribution",
10290 $distro); # same thing
10294 The CPAN module automates or at least simplifies the make and install
10295 of perl modules and extensions. It includes some primitive searching
10296 capabilities and knows how to use Net::FTP or LWP or some external
10297 download clients to fetch the distributions from the net.
10299 These are fetched from one or more of the mirrored CPAN (Comprehensive
10300 Perl Archive Network) sites and unpacked in a dedicated directory.
10302 The CPAN module also supports the concept of named and versioned
10303 I<bundles> of modules. Bundles simplify the handling of sets of
10304 related modules. See Bundles below.
10306 The package contains a session manager and a cache manager. The
10307 session manager keeps track of what has been fetched, built and
10308 installed in the current session. The cache manager keeps track of the
10309 disk space occupied by the make processes and deletes excess space
10310 according to a simple FIFO mechanism.
10312 All methods provided are accessible in a programmer style and in an
10313 interactive shell style.
10315 =head2 CPAN::shell([$prompt, $command]) Starting Interactive Mode
10317 The interactive mode is entered by running
10319 perl -MCPAN -e shell
10325 which puts you into a readline interface. If C<Term::ReadKey> and
10326 either C<Term::ReadLine::Perl> or C<Term::ReadLine::Gnu> are installed
10327 it supports both history and command completion.
10329 Once you are on the command line, type C<h> to get a one page help
10330 screen and the rest should be self-explanatory.
10332 The function call C<shell> takes two optional arguments, one is the
10333 prompt, the second is the default initial command line (the latter
10334 only works if a real ReadLine interface module is installed).
10336 The most common uses of the interactive modes are
10340 =item Searching for authors, bundles, distribution files and modules
10342 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
10343 for each of the four categories and another, C<i> for any of the
10344 mentioned four. Each of the four entities is implemented as a class
10345 with slightly differing methods for displaying an object.
10347 Arguments you pass to these commands are either strings exactly matching
10348 the identification string of an object or regular expressions that are
10349 then matched case-insensitively against various attributes of the
10350 objects. The parser recognizes a regular expression only if you
10351 enclose it between two slashes.
10353 The principle is that the number of found objects influences how an
10354 item is displayed. If the search finds one item, the result is
10355 displayed with the rather verbose method C<as_string>, but if we find
10356 more than one, we display each object with the terse method
10359 =item C<get>, C<make>, C<test>, C<install>, C<clean> modules or distributions
10361 These commands take any number of arguments and investigate what is
10362 necessary to perform the action. If the argument is a distribution
10363 file name (recognized by embedded slashes), it is processed. If it is
10364 a module, CPAN determines the distribution file in which this module
10365 is included and processes that, following any dependencies named in
10366 the module's META.yml or Makefile.PL (this behavior is controlled by
10367 the configuration parameter C<prerequisites_policy>.)
10369 C<get> downloads a distribution file and untars or unzips it, C<make>
10370 builds it, C<test> runs the test suite, and C<install> installs it.
10372 Any C<make> or C<test> are run unconditionally. An
10374 install <distribution_file>
10376 also is run unconditionally. But for
10380 CPAN checks if an install is actually needed for it and prints
10381 I<module up to date> in the case that the distribution file containing
10382 the module doesn't need to be updated.
10384 CPAN also keeps track of what it has done within the current session
10385 and doesn't try to build a package a second time regardless if it
10386 succeeded or not. It does not repeat a test run if the test
10387 has been run successfully before. Same for install runs.
10389 The C<force> pragma may precede another command (currently: C<get>,
10390 C<make>, C<test>, or C<install>) and executes the command from scratch
10391 and tries to continue in case of some errors. See the section below on
10392 the C<force> and the C<fforce> pragma.
10394 The C<notest> pragma may be used to skip the test part in the build
10399 cpan> notest install Tk
10401 A C<clean> command results in a
10405 being executed within the distribution file's working directory.
10407 =item C<readme>, C<perldoc>, C<look> module or distribution
10409 C<readme> displays the README file of the associated distribution.
10410 C<Look> gets and untars (if not yet done) the distribution file,
10411 changes to the appropriate directory and opens a subshell process in
10412 that directory. C<perldoc> displays the pod documentation of the
10413 module in html or plain text format.
10417 =item C<ls> globbing_expression
10419 The first form lists all distribution files in and below an author's
10420 CPAN directory as they are stored in the CHECKUMS files distributed on
10421 CPAN. The listing goes recursive into all subdirectories.
10423 The second form allows to limit or expand the output with shell
10424 globbing as in the following examples:
10430 The last example is very slow and outputs extra progress indicators
10431 that break the alignment of the result.
10433 Note that globbing only lists directories explicitly asked for, for
10434 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
10435 regarded as a bug and may be changed in future versions.
10439 The C<failed> command reports all distributions that failed on one of
10440 C<make>, C<test> or C<install> for some reason in the currently
10441 running shell session.
10443 =item Persistence between sessions
10445 If the C<YAML> or the c<YAML::Syck> module is installed a record of
10446 the internal state of all modules is written to disk after each step.
10447 The files contain a signature of the currently running perl version
10450 If the configurations variable C<build_dir_reuse> is set to a true
10451 value, then CPAN.pm reads the collected YAML files. If the stored
10452 signature matches the currently running perl the stored state is
10453 loaded into memory such that effectively persistence between sessions
10456 =item The C<force> and the C<fforce> pragma
10458 To speed things up in complex installation scenarios, CPAN.pm keeps
10459 track of what it has already done and refuses to do some things a
10460 second time. A C<get>, a C<make>, and an C<install> are not repeated.
10461 A C<test> is only repeated if the previous test was unsuccessful. The
10462 diagnostic message when CPAN.pm refuses to do something a second time
10463 is one of I<Has already been >C<unwrapped|made|tested successfully> or
10464 something similar. Another situation where CPAN refuses to act is an
10465 C<install> if the according C<test> was not successful.
10467 In all these cases, the user can override the goatish behaviour by
10468 prepending the command with the word force, for example:
10470 cpan> force get Foo
10471 cpan> force make AUTHOR/Bar-3.14.tar.gz
10472 cpan> force test Baz
10473 cpan> force install Acme::Meta
10475 Each I<forced> command is executed with the according part of its
10478 The C<fforce> pragma is a variant that emulates a C<force get> which
10479 erases the entire memory followed by the action specified, effectively
10480 restarting the whole get/make/test/install procedure from scratch.
10484 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>.
10485 Batch jobs can run without a lockfile and do not disturb each other.
10487 The shell offers to run in I<degraded mode> when another process is
10488 holding the lockfile. This is an experimental feature that is not yet
10489 tested very well. This second shell then does not write the history
10490 file, does not use the metadata file and has a different prompt.
10494 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
10495 in the cpan-shell it is intended that you can press C<^C> anytime and
10496 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
10497 to clean up and leave the shell loop. You can emulate the effect of a
10498 SIGTERM by sending two consecutive SIGINTs, which usually means by
10499 pressing C<^C> twice.
10501 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
10502 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
10503 Build.PL> subprocess.
10509 The commands that are available in the shell interface are methods in
10510 the package CPAN::Shell. If you enter the shell command, all your
10511 input is split by the Text::ParseWords::shellwords() routine which
10512 acts like most shells do. The first word is being interpreted as the
10513 method to be called and the rest of the words are treated as arguments
10514 to this method. Continuation lines are supported if a line ends with a
10519 C<autobundle> writes a bundle file into the
10520 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
10521 a list of all modules that are both available from CPAN and currently
10522 installed within @INC. The name of the bundle file is based on the
10523 current date and a counter.
10527 Note: this feature is still in alpha state and may change in future
10528 versions of CPAN.pm
10530 This commands provides a statistical overview over recent download
10531 activities. The data for this is collected in the YAML file
10532 C<FTPstats.yml> in your C<cpan_home> directory. If no YAML module is
10533 configured or YAML not installed, then no stats are provided.
10537 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
10538 directory so that you can save your own preferences instead of the
10541 =head2 recent ***EXPERIMENTAL COMMAND***
10543 The C<recent> command downloads a list of recent uploads to CPAN and
10544 displays them I<slowly>. While the command is running $SIG{INT} is
10545 defined to mean that the loop shall be left after having displayed the
10548 B<Note>: This command requires XML::LibXML installed.
10550 B<Note>: This whole command currently is a bit klunky and will
10551 probably change in future versions of CPAN.pm but the general
10552 approach will likely stay.
10554 B<Note>: See also L<smoke>
10558 recompile() is a very special command in that it takes no argument and
10559 runs the make/test/install cycle with brute force over all installed
10560 dynamically loadable extensions (aka XS modules) with 'force' in
10561 effect. The primary purpose of this command is to finish a network
10562 installation. Imagine, you have a common source tree for two different
10563 architectures. You decide to do a completely independent fresh
10564 installation. You start on one architecture with the help of a Bundle
10565 file produced earlier. CPAN installs the whole Bundle for you, but
10566 when you try to repeat the job on the second architecture, CPAN
10567 responds with a C<"Foo up to date"> message for all modules. So you
10568 invoke CPAN's recompile on the second architecture and you're done.
10570 Another popular use for C<recompile> is to act as a rescue in case your
10571 perl breaks binary compatibility. If one of the modules that CPAN uses
10572 is in turn depending on binary compatibility (so you cannot run CPAN
10573 commands), then you should try the CPAN::Nox module for recovery.
10575 =head2 report Bundle|Distribution|Module
10577 The C<report> command temporarily turns on the C<test_report> config
10578 variable, then runs the C<force test> command with the given
10579 arguments. The C<force> pragma is used to re-run the tests and repeat
10580 every step that might have failed before.
10582 =head2 smoke ***EXPERIMENTAL COMMAND***
10584 B<*** WARNING: this command downloads and executes software from CPAN to
10585 *** your computer of completely unknown status. You should never do
10586 *** this with your normal account and better have a dedicated well
10587 *** separated and secured machine to do this.>
10589 The C<smoke> command takes the list of recent uploads to CPAN as
10590 provided by the C<recent> command and tests them all. While the
10591 command is running $SIG{INT} is defined to mean that the current item
10594 B<Note>: This whole command currently is a bit klunky and will
10595 probably change in future versions of CPAN.pm but the general
10596 approach will likely stay.
10598 B<Note>: See also L<recent>
10600 =head2 upgrade [Module|/Regex/]...
10602 The C<upgrade> command first runs an C<r> command with the given
10603 arguments and then installs the newest versions of all modules that
10604 were listed by that.
10606 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
10608 Although it may be considered internal, the class hierarchy does matter
10609 for both users and programmer. CPAN.pm deals with above mentioned four
10610 classes, and all those classes share a set of methods. A classical
10611 single polymorphism is in effect. A metaclass object registers all
10612 objects of all kinds and indexes them with a string. The strings
10613 referencing objects have a separated namespace (well, not completely
10618 words containing a "/" (slash) Distribution
10619 words starting with Bundle:: Bundle
10620 everything else Module or Author
10622 Modules know their associated Distribution objects. They always refer
10623 to the most recent official release. Developers may mark their releases
10624 as unstable development versions (by inserting an underbar into the
10625 module version number which will also be reflected in the distribution
10626 name when you run 'make dist'), so the really hottest and newest
10627 distribution is not always the default. If a module Foo circulates
10628 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
10629 way to install version 1.23 by saying
10633 This would install the complete distribution file (say
10634 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
10635 like to install version 1.23_90, you need to know where the
10636 distribution file resides on CPAN relative to the authors/id/
10637 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
10638 so you would have to say
10640 install BAR/Foo-1.23_90.tar.gz
10642 The first example will be driven by an object of the class
10643 CPAN::Module, the second by an object of class CPAN::Distribution.
10645 =head2 Integrating local directories
10647 Note: this feature is still in alpha state and may change in future
10648 versions of CPAN.pm
10650 Distribution objects are normally distributions from the CPAN, but
10651 there is a slightly degenerate case for Distribution objects, too, of
10652 projects held on the local disk. These distribution objects have the
10653 same name as the local directory and end with a dot. A dot by itself
10654 is also allowed for the current directory at the time CPAN.pm was
10655 used. All actions such as C<make>, C<test>, and C<install> are applied
10656 directly to that directory. This gives the command C<cpan .> an
10657 interesting touch: while the normal mantra of installing a CPAN module
10658 without CPAN.pm is one of
10660 perl Makefile.PL perl Build.PL
10661 ( go and get prerequisites )
10663 make test ./Build test
10664 make install ./Build install
10666 the command C<cpan .> does all of this at once. It figures out which
10667 of the two mantras is appropriate, fetches and installs all
10668 prerequisites, cares for them recursively and finally finishes the
10669 installation of the module in the current directory, be it a CPAN
10672 The typical usage case is for private modules or working copies of
10673 projects from remote repositories on the local disk.
10675 =head1 CONFIGURATION
10677 When the CPAN module is used for the first time, a configuration
10678 dialog tries to determine a couple of site specific options. The
10679 result of the dialog is stored in a hash reference C< $CPAN::Config >
10680 in a file CPAN/Config.pm.
10682 The default values defined in the CPAN/Config.pm file can be
10683 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
10684 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
10685 added to the search path of the CPAN module before the use() or
10686 require() statements. The mkmyconfig command writes this file for you.
10688 The C<o conf> command has various bells and whistles:
10692 =item completion support
10694 If you have a ReadLine module installed, you can hit TAB at any point
10695 of the commandline and C<o conf> will offer you completion for the
10696 built-in subcommands and/or config variable names.
10698 =item displaying some help: o conf help
10700 Displays a short help
10702 =item displaying current values: o conf [KEY]
10704 Displays the current value(s) for this config variable. Without KEY
10705 displays all subcommands and config variables.
10711 If KEY starts and ends with a slash the string in between is
10712 interpreted as a regular expression and only keys matching this regex
10719 =item changing of scalar values: o conf KEY VALUE
10721 Sets the config variable KEY to VALUE. The empty string can be
10722 specified as usual in shells, with C<''> or C<"">
10726 o conf wget /usr/bin/wget
10728 =item changing of list values: o conf KEY SHIFT|UNSHIFT|PUSH|POP|SPLICE|LIST
10730 If a config variable name ends with C<list>, it is a list. C<o conf
10731 KEY shift> removes the first element of the list, C<o conf KEY pop>
10732 removes the last element of the list. C<o conf KEYS unshift LIST>
10733 prepends a list of values to the list, C<o conf KEYS push LIST>
10734 appends a list of valued to the list.
10736 Likewise, C<o conf KEY splice LIST> passes the LIST to the according
10739 Finally, any other list of arguments is taken as a new list value for
10740 the KEY variable discarding the previous value.
10744 o conf urllist unshift http://cpan.dev.local/CPAN
10745 o conf urllist splice 3 1
10746 o conf urllist http://cpan1.local http://cpan2.local ftp://ftp.perl.org
10748 =item reverting to saved: o conf defaults
10750 Reverts all config variables to the state in the saved config file.
10752 =item saving the config: o conf commit
10754 Saves all config variables to the current config file (CPAN/Config.pm
10755 or CPAN/MyConfig.pm that was loaded at start).
10759 The configuration dialog can be started any time later again by
10760 issuing the command C< o conf init > in the CPAN shell. A subset of
10761 the configuration dialog can be run by issuing C<o conf init WORD>
10762 where WORD is any valid config variable or a regular expression.
10764 =head2 Config Variables
10766 Currently the following keys in the hash reference $CPAN::Config are
10769 applypatch path to external prg
10770 auto_commit commit all changes to config variables to disk
10771 build_cache size of cache for directories to build modules
10772 build_dir locally accessible directory to build modules
10773 build_dir_reuse boolean if distros in build_dir are persistent
10774 build_requires_install_policy
10775 to install or not to install when a module is
10776 only needed for building. yes|no|ask/yes|ask/no
10777 bzip2 path to external prg
10778 cache_metadata use serializer to cache metadata
10779 commands_quote prefered character to use for quoting external
10780 commands when running them. Defaults to double
10781 quote on Windows, single tick everywhere else;
10782 can be set to space to disable quoting
10783 check_sigs if signatures should be verified
10784 colorize_debug Term::ANSIColor attributes for debugging output
10785 colorize_output boolean if Term::ANSIColor should colorize output
10786 colorize_print Term::ANSIColor attributes for normal output
10787 colorize_warn Term::ANSIColor attributes for warnings
10788 commandnumber_in_prompt
10789 boolean if you want to see current command number
10790 cpan_home local directory reserved for this package
10791 curl path to external prg
10792 dontload_hash DEPRECATED
10793 dontload_list arrayref: modules in the list will not be
10794 loaded by the CPAN::has_inst() routine
10795 ftp path to external prg
10796 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
10797 ftp_proxy proxy host for ftp requests
10799 gpg path to external prg
10800 gzip location of external program gzip
10801 histfile file to maintain history between sessions
10802 histsize maximum number of lines to keep in histfile
10803 http_proxy proxy host for http requests
10804 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
10805 after this many seconds inactivity. Set to 0 to
10807 index_expire after this many days refetch index files
10808 inhibit_startup_message
10809 if true, does not print the startup message
10810 keep_source_where directory in which to keep the source (if we do)
10811 load_module_verbosity
10812 report loading of optional modules used by CPAN.pm
10813 lynx path to external prg
10814 make location of external make program
10815 make_arg arguments that should always be passed to 'make'
10816 make_install_make_command
10817 the make command for running 'make install', for
10818 example 'sudo make'
10819 make_install_arg same as make_arg for 'make install'
10820 makepl_arg arguments passed to 'perl Makefile.PL'
10821 mbuild_arg arguments passed to './Build'
10822 mbuild_install_arg arguments passed to './Build install'
10823 mbuild_install_build_command
10824 command to use instead of './Build' when we are
10825 in the install stage, for example 'sudo ./Build'
10826 mbuildpl_arg arguments passed to 'perl Build.PL'
10827 ncftp path to external prg
10828 ncftpget path to external prg
10829 no_proxy don't proxy to these hosts/domains (comma separated list)
10830 pager location of external program more (or any pager)
10831 password your password if you CPAN server wants one
10832 patch path to external prg
10833 prefer_installer legal values are MB and EUMM: if a module comes
10834 with both a Makefile.PL and a Build.PL, use the
10835 former (EUMM) or the latter (MB); if the module
10836 comes with only one of the two, that one will be
10838 prerequisites_policy
10839 what to do if you are missing module prerequisites
10840 ('follow' automatically, 'ask' me, or 'ignore')
10841 prefs_dir local directory to store per-distro build options
10842 proxy_user username for accessing an authenticating proxy
10843 proxy_pass password for accessing an authenticating proxy
10844 randomize_urllist add some randomness to the sequence of the urllist
10845 scan_cache controls scanning of cache ('atstart' or 'never')
10846 shell your favorite shell
10847 show_unparsable_versions
10848 boolean if r command tells which modules are versionless
10849 show_upload_date boolean if commands should try to determine upload date
10850 show_zero_versions boolean if r command tells for which modules $version==0
10851 tar location of external program tar
10852 tar_verbosity verbosity level for the tar command
10853 term_is_latin deprecated: if true Unicode is translated to ISO-8859-1
10854 (and nonsense for characters outside latin range)
10855 term_ornaments boolean to turn ReadLine ornamenting on/off
10856 test_report email test reports (if CPAN::Reporter is installed)
10857 unzip location of external program unzip
10858 urllist arrayref to nearby CPAN sites (or equivalent locations)
10859 use_sqlite use CPAN::SQLite for metadata storage (fast and lean)
10860 username your username if you CPAN server wants one
10861 wait_list arrayref to a wait server to try (See CPAN::WAIT)
10862 wget path to external prg
10863 yaml_load_code enable YAML code deserialisation
10864 yaml_module which module to use to read/write YAML files
10866 You can set and query each of these options interactively in the cpan
10867 shell with the C<o conf> or the C<o conf init> command as specified below.
10871 =item C<o conf E<lt>scalar optionE<gt>>
10873 prints the current value of the I<scalar option>
10875 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
10877 Sets the value of the I<scalar option> to I<value>
10879 =item C<o conf E<lt>list optionE<gt>>
10881 prints the current value of the I<list option> in MakeMaker's
10884 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
10886 shifts or pops the array in the I<list option> variable
10888 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
10890 works like the corresponding perl commands.
10892 =item interactive editing: o conf init [MATCH|LIST]
10894 Runs an interactive configuration dialog for matching variables.
10895 Without argument runs the dialog over all supported config variables.
10896 To specify a MATCH the argument must be enclosed by slashes.
10900 o conf init ftp_passive ftp_proxy
10901 o conf init /color/
10903 Note: this method of setting config variables often provides more
10904 explanation about the functioning of a variable than the manpage.
10908 =head2 CPAN::anycwd($path): Note on config variable getcwd
10910 CPAN.pm changes the current working directory often and needs to
10911 determine its own current working directory. Per default it uses
10912 Cwd::cwd but if this doesn't work on your system for some reason,
10913 alternatives can be configured according to the following table:
10931 Calls the external command cwd.
10935 =head2 Note on the format of the urllist parameter
10937 urllist parameters are URLs according to RFC 1738. We do a little
10938 guessing if your URL is not compliant, but if you have problems with
10939 C<file> URLs, please try the correct format. Either:
10941 file://localhost/whatever/ftp/pub/CPAN/
10945 file:///home/ftp/pub/CPAN/
10947 =head2 The urllist parameter has CD-ROM support
10949 The C<urllist> parameter of the configuration table contains a list of
10950 URLs that are to be used for downloading. If the list contains any
10951 C<file> URLs, CPAN always tries to get files from there first. This
10952 feature is disabled for index files. So the recommendation for the
10953 owner of a CD-ROM with CPAN contents is: include your local, possibly
10954 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
10956 o conf urllist push file://localhost/CDROM/CPAN
10958 CPAN.pm will then fetch the index files from one of the CPAN sites
10959 that come at the beginning of urllist. It will later check for each
10960 module if there is a local copy of the most recent version.
10962 Another peculiarity of urllist is that the site that we could
10963 successfully fetch the last file from automatically gets a preference
10964 token and is tried as the first site for the next request. So if you
10965 add a new site at runtime it may happen that the previously preferred
10966 site will be tried another time. This means that if you want to disallow
10967 a site for the next transfer, it must be explicitly removed from
10970 =head2 Maintaining the urllist parameter
10972 If you have YAML.pm (or some other YAML module configured in
10973 C<yaml_module>) installed, CPAN.pm collects a few statistical data
10974 about recent downloads. You can view the statistics with the C<hosts>
10975 command or inspect them directly by looking into the C<FTPstats.yml>
10976 file in your C<cpan_home> directory.
10978 To get some interesting statistics it is recommended to set the
10979 C<randomize_urllist> parameter that introduces some amount of
10980 randomness into the URL selection.
10982 =head2 The C<requires> and C<build_requires> dependency declarations
10984 Since CPAN.pm version 1.88_51 modules declared as C<build_requires> by
10985 a distribution are treated differently depending on the config
10986 variable C<build_requires_install_policy>. By setting
10987 C<build_requires_install_policy> to C<no> such a module is not being
10988 installed. It is only built and tested and then kept in the list of
10989 tested but uninstalled modules. As such it is available during the
10990 build of the dependent module by integrating the path to the
10991 C<blib/arch> and C<blib/lib> directories in the environment variable
10992 PERL5LIB. If C<build_requires_install_policy> is set ti C<yes>, then
10993 both modules declared as C<requires> and those declared as
10994 C<build_requires> are treated alike. By setting to C<ask/yes> or
10995 C<ask/no>, CPAN.pm asks the user and sets the default accordingly.
10997 =head2 Configuration for individual distributions (I<Distroprefs>)
10999 (B<Note:> This feature has been introduced in CPAN.pm 1.8854 and is
11000 still considered beta quality)
11002 Distributions on the CPAN usually behave according to what we call the
11003 CPAN mantra. Or since the event of Module::Build we should talk about
11006 perl Makefile.PL perl Build.PL
11008 make test ./Build test
11009 make install ./Build install
11011 But some modules cannot be built with this mantra. They try to get
11012 some extra data from the user via the environment, extra arguments or
11013 interactively thus disturbing the installation of large bundles like
11014 Phalanx100 or modules with many dependencies like Plagger.
11016 The distroprefs system of C<CPAN.pm> addresses this problem by
11017 allowing the user to specify extra informations and recipes in YAML
11024 pass additional arguments to one of the four commands,
11028 set environment variables
11032 instantiate an Expect object that reads from the console, waits for
11033 some regular expressions and enters some answers
11037 temporarily override assorted C<CPAN.pm> configuration variables
11041 specify dependencies that the original maintainer forgot to specify
11045 disable the installation of an object altogether
11049 See the YAML and Data::Dumper files that come with the C<CPAN.pm>
11050 distribution in the C<distroprefs/> directory for examples.
11054 The YAML files themselves must have the C<.yml> extension, all other
11055 files are ignored (for two exceptions see I<Fallback Data::Dumper and
11056 Storable> below). The containing directory can be specified in
11057 C<CPAN.pm> in the C<prefs_dir> config variable. Try C<o conf init
11058 prefs_dir> in the CPAN shell to set and activate the distroprefs
11061 Every YAML file may contain arbitrary documents according to the YAML
11062 specification and every single document is treated as an entity that
11063 can specify the treatment of a single distribution.
11065 The names of the files can be picked freely, C<CPAN.pm> always reads
11066 all files (in alphabetical order) and takes the key C<match> (see
11067 below in I<Language Specs>) as a hashref containing match criteria
11068 that determine if the current distribution matches the YAML document
11071 =head2 Fallback Data::Dumper and Storable
11073 If neither your configured C<yaml_module> nor YAML.pm is installed
11074 CPAN.pm falls back to using Data::Dumper and Storable and looks for
11075 files with the extensions C<.dd> or C<.st> in the C<prefs_dir>
11076 directory. These files are expected to contain one or more hashrefs.
11077 For Data::Dumper generated files, this is expected to be done with by
11078 defining C<$VAR1>, C<$VAR2>, etc. The YAML shell would produce these
11081 ysh < somefile.yml > somefile.dd
11083 For Storable files the rule is that they must be constructed such that
11084 C<Storable::retrieve(file)> returns an array reference and the array
11085 elements represent one distropref object each. The conversion from
11086 YAML would look like so:
11088 perl -MYAML=LoadFile -MStorable=nstore -e '
11089 @y=LoadFile(shift);
11090 nstore(\@y, shift)' somefile.yml somefile.st
11092 In bootstrapping situations it is usually sufficient to translate only
11093 a few YAML files to Data::Dumper for the crucial modules like
11094 C<YAML::Syck>, C<YAML.pm> and C<Expect.pm>. If you prefer Storable
11095 over Data::Dumper, remember to pull out a Storable version that writes
11096 an older format than all the other Storable versions that will need to
11101 The following example contains all supported keywords and structures
11102 with the exception of C<eexpect> which can be used instead of
11108 module: "Dancing::Queen"
11109 distribution: "^CHACHACHA/Dancing-"
11110 perl: "/usr/local/cariba-perl/bin/perl"
11112 archname: "freebsd"
11118 - "--somearg=specialcase"
11123 - "Which is your favorite fruit"
11135 commendline: "echo SKIPPING make"
11148 WANT_TO_INSTALL: YES
11151 - "Do you really want to install"
11155 - "ABCDE/Fedcba-3.14-ABCDE-01.patch"
11158 configure_requires:
11161 Test::Exception: 0.25
11166 =head2 Language Specs
11168 Every YAML document represents a single hash reference. The valid keys
11169 in this hash are as follows:
11173 =item comment [scalar]
11177 =item cpanconfig [hash]
11179 Temporarily override assorted C<CPAN.pm> configuration variables.
11181 Supported are: C<build_requires_install_policy>, C<check_sigs>,
11182 C<make>, C<make_install_make_command>, C<prefer_installer>,
11183 C<test_report>. Please report as a bug when you need another one
11186 =item depends [hash] *** EXPERIMENTAL FEATURE ***
11188 All three types, namely C<configure_requires>, C<build_requires>, and
11189 C<requires> are supported in the way specified in the META.yml
11190 specification. The current implementation I<merges> the specified
11191 dependencies with those declared by the package maintainer. In a
11192 future implementation this may be changed to override the original
11195 =item disabled [boolean]
11197 Specifies that this distribution shall not be processed at all.
11199 =item goto [string]
11201 The canonical name of a delegate distribution that shall be installed
11202 instead. Useful when a new version, although it tests OK itself,
11203 breaks something else or a developer release or a fork is already
11204 uploaded that is better than the last released version.
11206 =item install [hash]
11208 Processing instructions for the C<make install> or C<./Build install>
11209 phase of the CPAN mantra. See below under I<Processiong Instructions>.
11213 Processing instructions for the C<make> or C<./Build> phase of the
11214 CPAN mantra. See below under I<Processiong Instructions>.
11218 A hashref with one or more of the keys C<distribution>, C<modules>,
11219 C<perl>, and C<perlconfig> that specify if a document is targeted at a
11220 specific CPAN distribution or installation.
11222 The corresponding values are interpreted as regular expressions. The
11223 C<distribution> related one will be matched against the canonical
11224 distribution name, e.g. "AUTHOR/Foo-Bar-3.14.tar.gz".
11226 The C<module> related one will be matched against I<all> modules
11227 contained in the distribution until one module matches.
11229 The C<perl> related one will be matched against C<$^X>.
11231 The value associated with C<perlconfig> is itself a hashref that is
11232 matched against corresponding values in the C<%Config::Config> hash
11233 living in the C< Config.pm > module.
11235 If more than one restriction of C<module>, C<distribution>, and
11236 C<perl> is specified, the results of the separately computed match
11237 values must all match. If this is the case then the hashref
11238 represented by the YAML document is returned as the preference
11239 structure for the current distribution.
11241 =item patches [array]
11243 An array of patches on CPAN or on the local disk to be applied in
11244 order via the external patch program. If the value for the C<-p>
11245 parameter is C<0> or C<1> is determined by reading the patch
11248 Note: if the C<applypatch> program is installed and C<CPAN::Config>
11249 knows about it B<and> a patch is written by the C<makepatch> program,
11250 then C<CPAN.pm> lets C<applypatch> apply the patch. Both C<makepatch>
11251 and C<applypatch> are available from CPAN in the C<JV/makepatch-*>
11256 Processing instructions for the C<perl Makefile.PL> or C<perl
11257 Build.PL> phase of the CPAN mantra. See below under I<Processiong
11262 Processing instructions for the C<make test> or C<./Build test> phase
11263 of the CPAN mantra. See below under I<Processiong Instructions>.
11267 =head2 Processing Instructions
11273 Arguments to be added to the command line
11277 A full commandline that will be executed as it stands by a system
11278 call. During the execution the environment variable PERL will is set
11279 to $^X. If C<commandline> is specified, the content of C<args> is not
11282 =item eexpect [hash]
11284 Extended C<expect>. This is a hash reference with four allowed keys,
11285 C<mode>, C<timeout>, C<reuse>, and C<talk>.
11287 C<mode> may have the values C<deterministic> for the case where all
11288 questions come in the order written down and C<anyorder> for the case
11289 where the questions may come in any order. The default mode is
11292 C<timeout> denotes a timeout in seconds. Floating point timeouts are
11293 OK. In the case of a C<mode=deterministic> the timeout denotes the
11294 timeout per question, in the case of C<mode=anyorder> it denotes the
11295 timeout per byte received from the stream or questions.
11297 C<talk> is a reference to an array that contains alternating questions
11298 and answers. Questions are regular expressions and answers are literal
11299 strings. The Expect module will then watch the stream coming from the
11300 execution of the external program (C<perl Makefile.PL>, C<perl
11301 Build.PL>, C<make>, etc.).
11303 In the case of C<mode=deterministic> the CPAN.pm will inject the
11304 according answer as soon as the stream matches the regular expression.
11306 In the case of C<mode=anyorder> CPAN.pm will answer a question as soon
11307 as the timeout is reached for the next byte in the input stream. In
11308 this mode you can use the C<reuse> parameter to decide what shall
11309 happen with a question-answer pair after it has been used. In the
11310 default case (reuse=0) it is removed from the array, so it cannot be
11311 used again accidentally. In this case, if you want to answer the
11312 question C<Do you really want to do that> several times, then it must
11313 be included in the array at least as often as you want this answer to
11314 be given. Setting the parameter C<reuse> to 1 makes this repetition
11319 Environment variables to be set during the command
11321 =item expect [array]
11323 C<< expect: <array> >> is a short notation for
11326 mode: deterministic
11332 =head2 Schema verification with C<Kwalify>
11334 If you have the C<Kwalify> module installed (which is part of the
11335 Bundle::CPANxxl), then all your distroprefs files are checked for
11336 syntactical correctness.
11338 =head2 Example Distroprefs Files
11340 C<CPAN.pm> comes with a collection of example YAML files. Note that these
11341 are really just examples and should not be used without care because
11342 they cannot fit everybody's purpose. After all the authors of the
11343 packages that ask questions had a need to ask, so you should watch
11344 their questions and adjust the examples to your environment and your
11345 needs. You have beend warned:-)
11347 =head1 PROGRAMMER'S INTERFACE
11349 If you do not enter the shell, the available shell commands are both
11350 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
11351 functions in the calling package (C<install(...)>). Before calling low-level
11352 commands it makes sense to initialize components of CPAN you need, e.g.:
11354 CPAN::HandleConfig->load;
11355 CPAN::Shell::setup_output;
11356 CPAN::Index->reload;
11358 High-level commands do such initializations automatically.
11360 There's currently only one class that has a stable interface -
11361 CPAN::Shell. All commands that are available in the CPAN shell are
11362 methods of the class CPAN::Shell. Each of the commands that produce
11363 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
11364 the IDs of all modules within the list.
11368 =item expand($type,@things)
11370 The IDs of all objects available within a program are strings that can
11371 be expanded to the corresponding real objects with the
11372 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
11373 list of CPAN::Module objects according to the C<@things> arguments
11374 given. In scalar context it only returns the first element of the
11377 =item expandany(@things)
11379 Like expand, but returns objects of the appropriate type, i.e.
11380 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
11381 CPAN::Distribution objects for distributions. Note: it does not expand
11382 to CPAN::Author objects.
11384 =item Programming Examples
11386 This enables the programmer to do operations that combine
11387 functionalities that are available in the shell.
11389 # install everything that is outdated on my disk:
11390 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
11392 # install my favorite programs if necessary:
11393 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)) {
11394 CPAN::Shell->install($mod);
11397 # list all modules on my disk that have no VERSION number
11398 for $mod (CPAN::Shell->expand("Module","/./")) {
11399 next unless $mod->inst_file;
11400 # MakeMaker convention for undefined $VERSION:
11401 next unless $mod->inst_version eq "undef";
11402 print "No VERSION in ", $mod->id, "\n";
11405 # find out which distribution on CPAN contains a module:
11406 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
11408 Or if you want to write a cronjob to watch The CPAN, you could list
11409 all modules that need updating. First a quick and dirty way:
11411 perl -e 'use CPAN; CPAN::Shell->r;'
11413 If you don't want to get any output in the case that all modules are
11414 up to date, you can parse the output of above command for the regular
11415 expression //modules are up to date// and decide to mail the output
11416 only if it doesn't match. Ick?
11418 If you prefer to do it more in a programmer style in one single
11419 process, maybe something like this suits you better:
11421 # list all modules on my disk that have newer versions on CPAN
11422 for $mod (CPAN::Shell->expand("Module","/./")) {
11423 next unless $mod->inst_file;
11424 next if $mod->uptodate;
11425 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
11426 $mod->id, $mod->inst_version, $mod->cpan_version;
11429 If that gives you too much output every day, you maybe only want to
11430 watch for three modules. You can write
11432 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")) {
11434 as the first line instead. Or you can combine some of the above
11437 # watch only for a new mod_perl module
11438 $mod = CPAN::Shell->expand("Module","mod_perl");
11439 exit if $mod->uptodate;
11440 # new mod_perl arrived, let me know all update recommendations
11445 =head2 Methods in the other Classes
11449 =item CPAN::Author::as_glimpse()
11451 Returns a one-line description of the author
11453 =item CPAN::Author::as_string()
11455 Returns a multi-line description of the author
11457 =item CPAN::Author::email()
11459 Returns the author's email address
11461 =item CPAN::Author::fullname()
11463 Returns the author's name
11465 =item CPAN::Author::name()
11467 An alias for fullname
11469 =item CPAN::Bundle::as_glimpse()
11471 Returns a one-line description of the bundle
11473 =item CPAN::Bundle::as_string()
11475 Returns a multi-line description of the bundle
11477 =item CPAN::Bundle::clean()
11479 Recursively runs the C<clean> method on all items contained in the bundle.
11481 =item CPAN::Bundle::contains()
11483 Returns a list of objects' IDs contained in a bundle. The associated
11484 objects may be bundles, modules or distributions.
11486 =item CPAN::Bundle::force($method,@args)
11488 Forces CPAN to perform a task that it normally would have refused to
11489 do. Force takes as arguments a method name to be called and any number
11490 of additional arguments that should be passed to the called method.
11491 The internals of the object get the needed changes so that CPAN.pm
11492 does not refuse to take the action. The C<force> is passed recursively
11493 to all contained objects. See also the section above on the C<force>
11494 and the C<fforce> pragma.
11496 =item CPAN::Bundle::get()
11498 Recursively runs the C<get> method on all items contained in the bundle
11500 =item CPAN::Bundle::inst_file()
11502 Returns the highest installed version of the bundle in either @INC or
11503 C<$CPAN::Config->{cpan_home}>. Note that this is different from
11504 CPAN::Module::inst_file.
11506 =item CPAN::Bundle::inst_version()
11508 Like CPAN::Bundle::inst_file, but returns the $VERSION
11510 =item CPAN::Bundle::uptodate()
11512 Returns 1 if the bundle itself and all its members are uptodate.
11514 =item CPAN::Bundle::install()
11516 Recursively runs the C<install> method on all items contained in the bundle
11518 =item CPAN::Bundle::make()
11520 Recursively runs the C<make> method on all items contained in the bundle
11522 =item CPAN::Bundle::readme()
11524 Recursively runs the C<readme> method on all items contained in the bundle
11526 =item CPAN::Bundle::test()
11528 Recursively runs the C<test> method on all items contained in the bundle
11530 =item CPAN::Distribution::as_glimpse()
11532 Returns a one-line description of the distribution
11534 =item CPAN::Distribution::as_string()
11536 Returns a multi-line description of the distribution
11538 =item CPAN::Distribution::author
11540 Returns the CPAN::Author object of the maintainer who uploaded this
11543 =item CPAN::Distribution::pretty_id()
11545 Returns a string of the form "AUTHORID/TARBALL", where AUTHORID is the
11546 author's PAUSE ID and TARBALL is the distribution filename.
11548 =item CPAN::Distribution::base_id()
11550 Returns the distribution filename without any archive suffix. E.g
11553 =item CPAN::Distribution::clean()
11555 Changes to the directory where the distribution has been unpacked and
11556 runs C<make clean> there.
11558 =item CPAN::Distribution::containsmods()
11560 Returns a list of IDs of modules contained in a distribution file.
11561 Only works for distributions listed in the 02packages.details.txt.gz
11562 file. This typically means that only the most recent version of a
11563 distribution is covered.
11565 =item CPAN::Distribution::cvs_import()
11567 Changes to the directory where the distribution has been unpacked and
11568 runs something like
11570 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
11574 =item CPAN::Distribution::dir()
11576 Returns the directory into which this distribution has been unpacked.
11578 =item CPAN::Distribution::force($method,@args)
11580 Forces CPAN to perform a task that it normally would have refused to
11581 do. Force takes as arguments a method name to be called and any number
11582 of additional arguments that should be passed to the called method.
11583 The internals of the object get the needed changes so that CPAN.pm
11584 does not refuse to take the action. See also the section above on the
11585 C<force> and the C<fforce> pragma.
11587 =item CPAN::Distribution::get()
11589 Downloads the distribution from CPAN and unpacks it. Does nothing if
11590 the distribution has already been downloaded and unpacked within the
11593 =item CPAN::Distribution::install()
11595 Changes to the directory where the distribution has been unpacked and
11596 runs the external command C<make install> there. If C<make> has not
11597 yet been run, it will be run first. A C<make test> will be issued in
11598 any case and if this fails, the install will be canceled. The
11599 cancellation can be avoided by letting C<force> run the C<install> for
11602 This install method has only the power to install the distribution if
11603 there are no dependencies in the way. To install an object and all of
11604 its dependencies, use CPAN::Shell->install.
11606 Note that install() gives no meaningful return value. See uptodate().
11608 =item CPAN::Distribution::install_tested()
11610 Install all the distributions that have been tested sucessfully but
11611 not yet installed. See also C<is_tested>.
11613 =item CPAN::Distribution::isa_perl()
11615 Returns 1 if this distribution file seems to be a perl distribution.
11616 Normally this is derived from the file name only, but the index from
11617 CPAN can contain a hint to achieve a return value of true for other
11620 =item CPAN::Distribution::is_tested()
11622 List all the distributions that have been tested sucessfully but not
11623 yet installed. See also C<install_tested>.
11625 =item CPAN::Distribution::look()
11627 Changes to the directory where the distribution has been unpacked and
11628 opens a subshell there. Exiting the subshell returns.
11630 =item CPAN::Distribution::make()
11632 First runs the C<get> method to make sure the distribution is
11633 downloaded and unpacked. Changes to the directory where the
11634 distribution has been unpacked and runs the external commands C<perl
11635 Makefile.PL> or C<perl Build.PL> and C<make> there.
11637 =item CPAN::Distribution::perldoc()
11639 Downloads the pod documentation of the file associated with a
11640 distribution (in html format) and runs it through the external
11641 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
11642 isn't available, it converts it to plain text with external
11643 command html2text and runs it through the pager specified
11644 in C<$CPAN::Config->{pager}>
11646 =item CPAN::Distribution::prefs()
11648 Returns the hash reference from the first matching YAML file that the
11649 user has deposited in the C<prefs_dir/> directory. The first
11650 succeeding match wins. The files in the C<prefs_dir/> are processed
11651 alphabetically and the canonical distroname (e.g.
11652 AUTHOR/Foo-Bar-3.14.tar.gz) is matched against the regular expressions
11653 stored in the $root->{match}{distribution} attribute value.
11654 Additionally all module names contained in a distribution are matched
11655 agains the regular expressions in the $root->{match}{module} attribute
11656 value. The two match values are ANDed together. Each of the two
11657 attributes are optional.
11659 =item CPAN::Distribution::prereq_pm()
11661 Returns the hash reference that has been announced by a distribution
11662 as the the C<requires> and C<build_requires> elements. These can be
11663 declared either by the C<META.yml> (if authoritative) or can be
11664 deposited after the run of C<Build.PL> in the file C<./_build/prereqs>
11665 or after the run of C<Makfile.PL> written as the C<PREREQ_PM> hash in
11666 a comment in the produced C<Makefile>. I<Note>: this method only works
11667 after an attempt has been made to C<make> the distribution. Returns
11670 =item CPAN::Distribution::readme()
11672 Downloads the README file associated with a distribution and runs it
11673 through the pager specified in C<$CPAN::Config->{pager}>.
11675 =item CPAN::Distribution::reports()
11677 Downloads report data for this distribution from cpantesters.perl.org
11678 and displays a subset of them.
11680 =item CPAN::Distribution::read_yaml()
11682 Returns the content of the META.yml of this distro as a hashref. Note:
11683 works only after an attempt has been made to C<make> the distribution.
11684 Returns undef otherwise. Also returns undef if the content of META.yml
11685 is not authoritative. (The rules about what exactly makes the content
11686 authoritative are still in flux.)
11688 =item CPAN::Distribution::test()
11690 Changes to the directory where the distribution has been unpacked and
11691 runs C<make test> there.
11693 =item CPAN::Distribution::uptodate()
11695 Returns 1 if all the modules contained in the distribution are
11696 uptodate. Relies on containsmods.
11698 =item CPAN::Index::force_reload()
11700 Forces a reload of all indices.
11702 =item CPAN::Index::reload()
11704 Reloads all indices if they have not been read for more than
11705 C<$CPAN::Config->{index_expire}> days.
11707 =item CPAN::InfoObj::dump()
11709 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
11710 inherit this method. It prints the data structure associated with an
11711 object. Useful for debugging. Note: the data structure is considered
11712 internal and thus subject to change without notice.
11714 =item CPAN::Module::as_glimpse()
11716 Returns a one-line description of the module in four columns: The
11717 first column contains the word C<Module>, the second column consists
11718 of one character: an equals sign if this module is already installed
11719 and uptodate, a less-than sign if this module is installed but can be
11720 upgraded, and a space if the module is not installed. The third column
11721 is the name of the module and the fourth column gives maintainer or
11722 distribution information.
11724 =item CPAN::Module::as_string()
11726 Returns a multi-line description of the module
11728 =item CPAN::Module::clean()
11730 Runs a clean on the distribution associated with this module.
11732 =item CPAN::Module::cpan_file()
11734 Returns the filename on CPAN that is associated with the module.
11736 =item CPAN::Module::cpan_version()
11738 Returns the latest version of this module available on CPAN.
11740 =item CPAN::Module::cvs_import()
11742 Runs a cvs_import on the distribution associated with this module.
11744 =item CPAN::Module::description()
11746 Returns a 44 character description of this module. Only available for
11747 modules listed in The Module List (CPAN/modules/00modlist.long.html
11748 or 00modlist.long.txt.gz)
11750 =item CPAN::Module::distribution()
11752 Returns the CPAN::Distribution object that contains the current
11753 version of this module.
11755 =item CPAN::Module::dslip_status()
11757 Returns a hash reference. The keys of the hash are the letters C<D>,
11758 C<S>, C<L>, C<I>, and <P>, for development status, support level,
11759 language, interface and public licence respectively. The data for the
11760 DSLIP status are collected by pause.perl.org when authors register
11761 their namespaces. The values of the 5 hash elements are one-character
11762 words whose meaning is described in the table below. There are also 5
11763 hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
11764 verbose value of the 5 status variables.
11766 Where the 'DSLIP' characters have the following meanings:
11768 D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
11769 i - Idea, listed to gain consensus or as a placeholder
11770 c - under construction but pre-alpha (not yet released)
11771 a/b - Alpha/Beta testing
11773 M - Mature (no rigorous definition)
11774 S - Standard, supplied with Perl 5
11779 u - Usenet newsgroup comp.lang.perl.modules
11780 n - None known, try comp.lang.perl.modules
11781 a - abandoned; volunteers welcome to take over maintainance
11784 p - Perl-only, no compiler needed, should be platform independent
11785 c - C and perl, a C compiler will be needed
11786 h - Hybrid, written in perl with optional C code, no compiler needed
11787 + - C++ and perl, a C++ compiler will be needed
11788 o - perl and another language other than C or C++
11790 I - Interface Style
11791 f - plain Functions, no references used
11792 h - hybrid, object and function interfaces available
11793 n - no interface at all (huh?)
11794 r - some use of unblessed References or ties
11795 O - Object oriented using blessed references and/or inheritance
11798 p - Standard-Perl: user may choose between GPL and Artistic
11799 g - GPL: GNU General Public License
11800 l - LGPL: "GNU Lesser General Public License" (previously known as
11801 "GNU Library General Public License")
11802 b - BSD: The BSD License
11803 a - Artistic license alone
11804 2 - Artistic license 2.0 or later
11805 o - open source: appoved by www.opensource.org
11806 d - allows distribution without restrictions
11807 r - restricted distribtion
11808 n - no license at all
11810 =item CPAN::Module::force($method,@args)
11812 Forces CPAN to perform a task that it normally would have refused to
11813 do. Force takes as arguments a method name to be called and any number
11814 of additional arguments that should be passed to the called method.
11815 The internals of the object get the needed changes so that CPAN.pm
11816 does not refuse to take the action. See also the section above on the
11817 C<force> and the C<fforce> pragma.
11819 =item CPAN::Module::get()
11821 Runs a get on the distribution associated with this module.
11823 =item CPAN::Module::inst_file()
11825 Returns the filename of the module found in @INC. The first file found
11826 is reported just like perl itself stops searching @INC when it finds a
11829 =item CPAN::Module::available_file()
11831 Returns the filename of the module found in PERL5LIB or @INC. The
11832 first file found is reported. The advantage of this method over
11833 C<inst_file> is that modules that have been tested but not yet
11834 installed are included because PERL5LIB keeps track of tested modules.
11836 =item CPAN::Module::inst_version()
11838 Returns the version number of the installed module in readable format.
11840 =item CPAN::Module::available_version()
11842 Returns the version number of the available module in readable format.
11844 =item CPAN::Module::install()
11846 Runs an C<install> on the distribution associated with this module.
11848 =item CPAN::Module::look()
11850 Changes to the directory where the distribution associated with this
11851 module has been unpacked and opens a subshell there. Exiting the
11854 =item CPAN::Module::make()
11856 Runs a C<make> on the distribution associated with this module.
11858 =item CPAN::Module::manpage_headline()
11860 If module is installed, peeks into the module's manpage, reads the
11861 headline and returns it. Moreover, if the module has been downloaded
11862 within this session, does the equivalent on the downloaded module even
11863 if it is not installed.
11865 =item CPAN::Module::perldoc()
11867 Runs a C<perldoc> on this module.
11869 =item CPAN::Module::readme()
11871 Runs a C<readme> on the distribution associated with this module.
11873 =item CPAN::Module::reports()
11875 Calls the reports() method on the associated distribution object.
11877 =item CPAN::Module::test()
11879 Runs a C<test> on the distribution associated with this module.
11881 =item CPAN::Module::uptodate()
11883 Returns 1 if the module is installed and up-to-date.
11885 =item CPAN::Module::userid()
11887 Returns the author's ID of the module.
11891 =head2 Cache Manager
11893 Currently the cache manager only keeps track of the build directory
11894 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
11895 deletes complete directories below C<build_dir> as soon as the size of
11896 all directories there gets bigger than $CPAN::Config->{build_cache}
11897 (in MB). The contents of this cache may be used for later
11898 re-installations that you intend to do manually, but will never be
11899 trusted by CPAN itself. This is due to the fact that the user might
11900 use these directories for building modules on different architectures.
11902 There is another directory ($CPAN::Config->{keep_source_where}) where
11903 the original distribution files are kept. This directory is not
11904 covered by the cache manager and must be controlled by the user. If
11905 you choose to have the same directory as build_dir and as
11906 keep_source_where directory, then your sources will be deleted with
11907 the same fifo mechanism.
11911 A bundle is just a perl module in the namespace Bundle:: that does not
11912 define any functions or methods. It usually only contains documentation.
11914 It starts like a perl module with a package declaration and a $VERSION
11915 variable. After that the pod section looks like any other pod with the
11916 only difference being that I<one special pod section> exists starting with
11921 In this pod section each line obeys the format
11923 Module_Name [Version_String] [- optional text]
11925 The only required part is the first field, the name of a module
11926 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
11927 of the line is optional. The comment part is delimited by a dash just
11928 as in the man page header.
11930 The distribution of a bundle should follow the same convention as
11931 other distributions.
11933 Bundles are treated specially in the CPAN package. If you say 'install
11934 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
11935 the modules in the CONTENTS section of the pod. You can install your
11936 own Bundles locally by placing a conformant Bundle file somewhere into
11937 your @INC path. The autobundle() command which is available in the
11938 shell interface does that for you by including all currently installed
11939 modules in a snapshot bundle file.
11941 =head1 PREREQUISITES
11943 If you have a local mirror of CPAN and can access all files with
11944 "file:" URLs, then you only need a perl better than perl5.003 to run
11945 this module. Otherwise Net::FTP is strongly recommended. LWP may be
11946 required for non-UNIX systems or if your nearest CPAN site is
11947 associated with a URL that is not C<ftp:>.
11949 If you have neither Net::FTP nor LWP, there is a fallback mechanism
11950 implemented for an external ftp command or for an external lynx
11955 =head2 Finding packages and VERSION
11957 This module presumes that all packages on CPAN
11963 declare their $VERSION variable in an easy to parse manner. This
11964 prerequisite can hardly be relaxed because it consumes far too much
11965 memory to load all packages into the running program just to determine
11966 the $VERSION variable. Currently all programs that are dealing with
11967 version use something like this
11969 perl -MExtUtils::MakeMaker -le \
11970 'print MM->parse_version(shift)' filename
11972 If you are author of a package and wonder if your $VERSION can be
11973 parsed, please try the above method.
11977 come as compressed or gzipped tarfiles or as zip files and contain a
11978 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
11979 without much enthusiasm).
11985 The debugging of this module is a bit complex, because we have
11986 interferences of the software producing the indices on CPAN, of the
11987 mirroring process on CPAN, of packaging, of configuration, of
11988 synchronicity, and of bugs within CPAN.pm.
11990 For debugging the code of CPAN.pm itself in interactive mode some more
11991 or less useful debugging aid can be turned on for most packages within
11992 CPAN.pm with one of
11996 =item o debug package...
11998 sets debug mode for packages.
12000 =item o debug -package...
12002 unsets debug mode for packages.
12006 turns debugging on for all packages.
12008 =item o debug number
12012 which sets the debugging packages directly. Note that C<o debug 0>
12013 turns debugging off.
12015 What seems quite a successful strategy is the combination of C<reload
12016 cpan> and the debugging switches. Add a new debug statement while
12017 running in the shell and then issue a C<reload cpan> and see the new
12018 debugging messages immediately without losing the current context.
12020 C<o debug> without an argument lists the valid package names and the
12021 current set of packages in debugging mode. C<o debug> has built-in
12022 completion support.
12024 For debugging of CPAN data there is the C<dump> command which takes
12025 the same arguments as make/test/install and outputs each object's
12026 Data::Dumper dump. If an argument looks like a perl variable and
12027 contains one of C<$>, C<@> or C<%>, it is eval()ed and fed to
12028 Data::Dumper directly.
12030 =head2 Floppy, Zip, Offline Mode
12032 CPAN.pm works nicely without network too. If you maintain machines
12033 that are not networked at all, you should consider working with file:
12034 URLs. Of course, you have to collect your modules somewhere first. So
12035 you might use CPAN.pm to put together all you need on a networked
12036 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
12037 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
12038 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
12039 with this floppy. See also below the paragraph about CD-ROM support.
12041 =head2 Basic Utilities for Programmers
12045 =item has_inst($module)
12047 Returns true if the module is installed. Used to load all modules into
12048 the running CPAN.pm which are considered optional. The config variable
12049 C<dontload_list> can be used to intercept the C<has_inst()> call such
12050 that an optional module is not loaded despite being available. For
12051 example the following command will prevent that C<YAML.pm> is being
12054 cpan> o conf dontload_list push YAML
12056 See the source for details.
12058 =item has_usable($module)
12060 Returns true if the module is installed and is in a usable state. Only
12061 useful for a handful of modules that are used internally. See the
12062 source for details.
12064 =item instance($module)
12066 The constructor for all the singletons used to represent modules,
12067 distributions, authors and bundles. If the object already exists, this
12068 method returns the object, otherwise it calls the constructor.
12074 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
12075 install foreign, unmasked, unsigned code on your machine. We compare
12076 to a checksum that comes from the net just as the distribution file
12077 itself. But we try to make it easy to add security on demand:
12079 =head2 Cryptographically signed modules
12081 Since release 1.77 CPAN.pm has been able to verify cryptographically
12082 signed module distributions using Module::Signature. The CPAN modules
12083 can be signed by their authors, thus giving more security. The simple
12084 unsigned MD5 checksums that were used before by CPAN protect mainly
12085 against accidental file corruption.
12087 You will need to have Module::Signature installed, which in turn
12088 requires that you have at least one of Crypt::OpenPGP module or the
12089 command-line F<gpg> tool installed.
12091 You will also need to be able to connect over the Internet to the public
12092 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
12094 The configuration parameter check_sigs is there to turn signature
12095 checking on or off.
12099 Most functions in package CPAN are exported per default. The reason
12100 for this is that the primary use is intended for the cpan shell or for
12105 When the CPAN shell enters a subshell via the look command, it sets
12106 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
12109 When CPAN runs, it sets the environment variable PERL5_CPAN_IS_RUNNING
12110 to the ID of the running process. It also sets
12111 PERL5_CPANPLUS_IS_RUNNING to prevent runaway processes which could
12112 happen with older versions of Module::Install.
12114 When running C<perl Makefile.PL>, the environment variable
12115 C<PERL5_CPAN_IS_EXECUTING> is set to the full path of the
12116 C<Makefile.PL> that is being executed. This prevents runaway processes
12117 with newer versions of Module::Install.
12119 When the config variable ftp_passive is set, all downloads will be run
12120 with the environment variable FTP_PASSIVE set to this value. This is
12121 in general a good idea as it influences both Net::FTP and LWP based
12122 connections. The same effect can be achieved by starting the cpan
12123 shell with this environment variable set. For Net::FTP alone, one can
12124 also always set passive mode by running libnetcfg.
12126 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
12128 Populating a freshly installed perl with my favorite modules is pretty
12129 easy if you maintain a private bundle definition file. To get a useful
12130 blueprint of a bundle definition file, the command autobundle can be used
12131 on the CPAN shell command line. This command writes a bundle definition
12132 file for all modules that are installed for the currently running perl
12133 interpreter. It's recommended to run this command only once and from then
12134 on maintain the file manually under a private name, say
12135 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
12137 cpan> install Bundle::my_bundle
12139 then answer a few questions and then go out for a coffee.
12141 Maintaining a bundle definition file means keeping track of two
12142 things: dependencies and interactivity. CPAN.pm sometimes fails on
12143 calculating dependencies because not all modules define all MakeMaker
12144 attributes correctly, so a bundle definition file should specify
12145 prerequisites as early as possible. On the other hand, it's a bit
12146 annoying that many distributions need some interactive configuring. So
12147 what I try to accomplish in my private bundle file is to have the
12148 packages that need to be configured early in the file and the gentle
12149 ones later, so I can go out after a few minutes and leave CPAN.pm
12152 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
12154 Thanks to Graham Barr for contributing the following paragraphs about
12155 the interaction between perl, and various firewall configurations. For
12156 further information on firewalls, it is recommended to consult the
12157 documentation that comes with the ncftp program. If you are unable to
12158 go through the firewall with a simple Perl setup, it is very likely
12159 that you can configure ncftp so that it works for your firewall.
12161 =head2 Three basic types of firewalls
12163 Firewalls can be categorized into three basic types.
12167 =item http firewall
12169 This is where the firewall machine runs a web server and to access the
12170 outside world you must do it via the web server. If you set environment
12171 variables like http_proxy or ftp_proxy to a values beginning with http://
12172 or in your web browser you have to set proxy information then you know
12173 you are running an http firewall.
12175 To access servers outside these types of firewalls with perl (even for
12176 ftp) you will need to use LWP.
12180 This where the firewall machine runs an ftp server. This kind of
12181 firewall will only let you access ftp servers outside the firewall.
12182 This is usually done by connecting to the firewall with ftp, then
12183 entering a username like "user@outside.host.com"
12185 To access servers outside these type of firewalls with perl you
12186 will need to use Net::FTP.
12188 =item One way visibility
12190 I say one way visibility as these firewalls try to make themselves look
12191 invisible to the users inside the firewall. An FTP data connection is
12192 normally created by sending the remote server your IP address and then
12193 listening for the connection. But the remote server will not be able to
12194 connect to you because of the firewall. So for these types of firewall
12195 FTP connections need to be done in a passive mode.
12197 There are two that I can think off.
12203 If you are using a SOCKS firewall you will need to compile perl and link
12204 it with the SOCKS library, this is what is normally called a 'socksified'
12205 perl. With this executable you will be able to connect to servers outside
12206 the firewall as if it is not there.
12208 =item IP Masquerade
12210 This is the firewall implemented in the Linux kernel, it allows you to
12211 hide a complete network behind one IP address. With this firewall no
12212 special compiling is needed as you can access hosts directly.
12214 For accessing ftp servers behind such firewalls you usually need to
12215 set the environment variable C<FTP_PASSIVE> or the config variable
12216 ftp_passive to a true value.
12222 =head2 Configuring lynx or ncftp for going through a firewall
12224 If you can go through your firewall with e.g. lynx, presumably with a
12227 /usr/local/bin/lynx -pscott:tiger
12229 then you would configure CPAN.pm with the command
12231 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
12233 That's all. Similarly for ncftp or ftp, you would configure something
12236 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
12238 Your mileage may vary...
12246 I installed a new version of module X but CPAN keeps saying,
12247 I have the old version installed
12249 Most probably you B<do> have the old version installed. This can
12250 happen if a module installs itself into a different directory in the
12251 @INC path than it was previously installed. This is not really a
12252 CPAN.pm problem, you would have the same problem when installing the
12253 module manually. The easiest way to prevent this behaviour is to add
12254 the argument C<UNINST=1> to the C<make install> call, and that is why
12255 many people add this argument permanently by configuring
12257 o conf make_install_arg UNINST=1
12261 So why is UNINST=1 not the default?
12263 Because there are people who have their precise expectations about who
12264 may install where in the @INC path and who uses which @INC array. In
12265 fine tuned environments C<UNINST=1> can cause damage.
12269 I want to clean up my mess, and install a new perl along with
12270 all modules I have. How do I go about it?
12272 Run the autobundle command for your old perl and optionally rename the
12273 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
12274 with the Configure option prefix, e.g.
12276 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
12278 Install the bundle file you produced in the first step with something like
12280 cpan> install Bundle::mybundle
12286 When I install bundles or multiple modules with one command
12287 there is too much output to keep track of.
12289 You may want to configure something like
12291 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
12292 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
12294 so that STDOUT is captured in a file for later inspection.
12299 I am not root, how can I install a module in a personal directory?
12301 First of all, you will want to use your own configuration, not the one
12302 that your root user installed. If you do not have permission to write
12303 in the cpan directory that root has configured, you will be asked if
12304 you want to create your own config. Answering "yes" will bring you into
12305 CPAN's configuration stage, using the system config for all defaults except
12306 things that have to do with CPAN's work directory, saving your choices to
12307 your MyConfig.pm file.
12309 You can also manually initiate this process with the following command:
12311 % perl -MCPAN -e 'mkmyconfig'
12317 from the CPAN shell.
12319 You will most probably also want to configure something like this:
12321 o conf makepl_arg "LIB=~/myperl/lib \
12322 INSTALLMAN1DIR=~/myperl/man/man1 \
12323 INSTALLMAN3DIR=~/myperl/man/man3 \
12324 INSTALLSCRIPT=~/myperl/bin \
12325 INSTALLBIN=~/myperl/bin"
12327 and then (oh joy) the equivalent command for Module::Build. That would
12330 o conf mbuildpl_arg "--lib=~/myperl/lib \
12331 --installman1dir=~/myperl/man/man1 \
12332 --installman3dir=~/myperl/man/man3 \
12333 --installscript=~/myperl/bin \
12334 --installbin=~/myperl/bin"
12336 You can make this setting permanent like all C<o conf> settings with
12337 C<o conf commit> or by setting C<auto_commit> beforehand.
12339 You will have to add ~/myperl/man to the MANPATH environment variable
12340 and also tell your perl programs to look into ~/myperl/lib, e.g. by
12343 use lib "$ENV{HOME}/myperl/lib";
12345 or setting the PERL5LIB environment variable.
12347 While we're speaking about $ENV{HOME}, it might be worth mentioning,
12348 that for Windows we use the File::HomeDir module that provides an
12349 equivalent to the concept of the home directory on Unix.
12351 Another thing you should bear in mind is that the UNINST parameter can
12352 be dangerous when you are installing into a private area because you
12353 might accidentally remove modules that other people depend on that are
12354 not using the private area.
12358 How to get a package, unwrap it, and make a change before building it?
12360 Have a look at the C<look> (!) command.
12364 I installed a Bundle and had a couple of fails. When I
12365 retried, everything resolved nicely. Can this be fixed to work
12368 The reason for this is that CPAN does not know the dependencies of all
12369 modules when it starts out. To decide about the additional items to
12370 install, it just uses data found in the META.yml file or the generated
12371 Makefile. An undetected missing piece breaks the process. But it may
12372 well be that your Bundle installs some prerequisite later than some
12373 depending item and thus your second try is able to resolve everything.
12374 Please note, CPAN.pm does not know the dependency tree in advance and
12375 cannot sort the queue of things to install in a topologically correct
12376 order. It resolves perfectly well IF all modules declare the
12377 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
12378 the C<requires> stanza of Module::Build. For bundles which fail and
12379 you need to install often, it is recommended to sort the Bundle
12380 definition file manually.
12384 In our intranet we have many modules for internal use. How
12385 can I integrate these modules with CPAN.pm but without uploading
12386 the modules to CPAN?
12388 Have a look at the CPAN::Site module.
12392 When I run CPAN's shell, I get an error message about things in my
12393 /etc/inputrc (or ~/.inputrc) file.
12395 These are readline issues and can only be fixed by studying readline
12396 configuration on your architecture and adjusting the referenced file
12397 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
12398 and edit them. Quite often harmless changes like uppercasing or
12399 lowercasing some arguments solves the problem.
12403 Some authors have strange characters in their names.
12405 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
12406 expecting ISO-8859-1 charset, a converter can be activated by setting
12407 term_is_latin to a true value in your config file. One way of doing so
12410 cpan> o conf term_is_latin 1
12412 If other charset support is needed, please file a bugreport against
12413 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
12414 the support or maybe UTF-8 terminals become widely available.
12416 Note: this config variable is deprecated and will be removed in a
12417 future version of CPAN.pm. It will be replaced with the conventions
12418 around the family of $LANG and $LC_* environment variables.
12422 When an install fails for some reason and then I correct the error
12423 condition and retry, CPAN.pm refuses to install the module, saying
12424 C<Already tried without success>.
12426 Use the force pragma like so
12428 force install Foo::Bar
12434 and then 'make install' directly in the subshell.
12438 How do I install a "DEVELOPER RELEASE" of a module?
12440 By default, CPAN will install the latest non-developer release of a
12441 module. If you want to install a dev release, you have to specify the
12442 partial path starting with the author id to the tarball you wish to
12445 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
12447 Note that you can use the C<ls> command to get this path listed.
12451 How do I install a module and all its dependencies from the commandline,
12452 without being prompted for anything, despite my CPAN configuration
12455 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
12456 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
12457 asked any questions at all (assuming the modules you are installing are
12458 nice about obeying that variable as well):
12460 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
12464 How do I create a Module::Build based Build.PL derived from an
12465 ExtUtils::MakeMaker focused Makefile.PL?
12467 http://search.cpan.org/search?query=Module::Build::Convert
12469 http://www.refcnt.org/papers/module-build-convert
12473 What's the best CPAN site for me?
12475 The urllist config parameter is yours. You can add and remove sites at
12476 will. You should find out which sites have the best uptodateness,
12477 bandwidth, reliability, etc. and are topologically close to you. Some
12478 people prefer fast downloads, others uptodateness, others reliability.
12479 You decide which to try in which order.
12481 Henk P. Penning maintains a site that collects data about CPAN sites:
12483 http://www.cs.uu.nl/people/henkp/mirmon/cpan.html
12487 Why do I get asked the same questions every time I start the shell?
12489 You can make your configuration changes permanent by calling the
12490 command C<o conf commit>. Alternatively set the C<auto_commit>
12491 variable to true by running C<o conf init auto_commit> and answering
12492 the following question with yes.
12496 =head1 COMPATIBILITY
12498 =head2 OLD PERL VERSIONS
12500 CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
12501 newer versions. It is getting more and more difficult to get the
12502 minimal prerequisites working on older perls. It is close to
12503 impossible to get the whole Bundle::CPAN working there. If you're in
12504 the position to have only these old versions, be advised that CPAN is
12505 designed to work fine without the Bundle::CPAN installed.
12507 To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
12508 compatible with ancient perls and that File::Temp is listed as a
12509 prerequisite but CPAN has reasonable workarounds if it is missing.
12513 This module and its competitor, the CPANPLUS module, are both much
12514 cooler than the other. CPAN.pm is older. CPANPLUS was designed to be
12515 more modular but it was never tried to make it compatible with CPAN.pm.
12517 =head1 SECURITY ADVICE
12519 This software enables you to upgrade software on your computer and so
12520 is inherently dangerous because the newly installed software may
12521 contain bugs and may alter the way your computer works or even make it
12522 unusable. Please consider backing up your data before every upgrade.
12526 Please report bugs via http://rt.cpan.org/
12528 Before submitting a bug, please make sure that the traditional method
12529 of building a Perl module package from a shell by following the
12530 installation instructions of that package still works in your
12535 Andreas Koenig C<< <andk@cpan.org> >>
12539 This program is free software; you can redistribute it and/or
12540 modify it under the same terms as Perl itself.
12542 See L<http://www.perl.com/perl/misc/Artistic.html>
12544 =head1 TRANSLATIONS
12546 Kawai,Takanori provides a Japanese translation of this manpage at
12547 http://homepage3.nifty.com/hippo2000/perltips/CPAN.htm
12551 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)