1 package CPAN::Distribution;
6 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
13 my $ro = $self->ro or return;
17 #-> CPAN::Distribution::undelay
21 "configure_requires_later",
22 "configure_requires_later_for",
26 delete $self->{$delayer};
30 #-> CPAN::Distribution::is_dot_dist
33 return substr($self->id,-1,1) eq ".";
37 #-> CPAN::Distribution::normalize
40 $s = $self->id unless defined $s;
41 if (substr($s,-1,1) eq ".") {
42 # using a global because we are sometimes called as static method
43 if (!$CPAN::META->{LOCK}
44 && !$CPAN::Have_warned->{"$s is unlocked"}++
46 $CPAN::Frontend->mywarn("You are visiting the local directory
48 without lock, take care that concurrent processes do not do likewise.\n");
49 $CPAN::Frontend->mysleep(1);
53 } elsif (File::Spec->file_name_is_absolute($s)) {
54 } elsif (File::Spec->can("rel2abs")) {
55 $s = File::Spec->rel2abs($s);
57 $CPAN::Frontend->mydie("Your File::Spec is too old, please upgrade File::Spec");
59 CPAN->debug("s[$s]") if $CPAN::DEBUG;
60 unless ($CPAN::META->exists("CPAN::Distribution", $s)) {
61 for ($CPAN::META->instance("CPAN::Distribution", $s)) {
63 $_->{archived} = "local_directory";
64 $_->{unwrapped} = CPAN::Distrostatus->new("YES -- local_directory");
70 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
72 return $s if $s =~ m:^N/A|^Contact Author: ;
73 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4|;
74 CPAN->debug("s[$s]") if $CPAN::DEBUG;
79 #-> sub CPAN::Distribution::author ;
83 if (substr($self->id,-1,1) eq ".") {
86 ($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
88 CPAN::Shell->expand("Author",$authorid);
91 # tries to get the yaml from CPAN instead of the distro itself:
92 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
95 my $meta = $self->pretty_id;
96 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
97 my(@ls) = CPAN::Shell->globls($meta);
98 my $norm = $self->normalize($meta);
103 $CPAN::Config->{keep_source_where},
108 $self->debug("Doing localize") if $CPAN::DEBUG;
109 unless ($local_file =
110 CPAN::FTP->localize("authors/id/$norm",
112 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
114 my $yaml = CPAN->_yaml_loadfile($local_file)->[0];
117 #-> sub CPAN::Distribution::cpan_userid
120 if ($self->{ID} =~ m{[A-Z]/[A-Z\-]{2}/([A-Z\-]+)/}) {
123 return $self->SUPER::cpan_userid;
126 #-> sub CPAN::Distribution::pretty_id
130 return $id unless $id =~ m|^./../|;
134 #-> sub CPAN::Distribution::base_id
137 my $id = $self->pretty_id();
138 my $base_id = File::Basename::basename($id);
139 $base_id =~ s{\.(?:tar\.(bz2|gz|Z)|t(?:gz|bz)|zip)$}{}i;
143 #-> sub CPAN::Distribution::tested_ok_but_not_installed
144 sub tested_ok_but_not_installed {
148 && $self->{build_dir}
149 && (UNIVERSAL::can($self->{make_test},"failed") ?
150 ! $self->{make_test}->failed :
151 $self->{make_test} =~ /^YES/
156 $self->{install}->failed
162 # mark as dirty/clean for the sake of recursion detection. $color=1
163 # means "in use", $color=0 means "not in use anymore". $color=2 means
164 # we have determined prereqs now and thus insist on passing this
165 # through (at least) once again.
167 #-> sub CPAN::Distribution::color_cmd_tmps ;
170 my($depth) = shift || 0;
171 my($color) = shift || 0;
172 my($ancestors) = shift || [];
173 # a distribution needs to recurse into its prereq_pms
175 return if exists $self->{incommandcolor}
177 && $self->{incommandcolor}==$color;
178 if ($depth>=$CPAN::MAX_RECURSION) {
179 die(CPAN::Exception::RecursiveDependency->new($ancestors));
181 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
182 my $prereq_pm = $self->prereq_pm;
183 if (defined $prereq_pm) {
184 PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
185 keys %{$prereq_pm->{build_requires}||{}}) {
186 next PREREQ if $pre eq "perl";
188 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
189 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
190 $CPAN::Frontend->mysleep(2);
193 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
197 delete $self->{sponsored_mods};
199 # as we are at the end of a command, we'll give up this
200 # reminder of a broken test. Other commands may test this guy
201 # again. Maybe 'badtestcnt' should be renamed to
202 # 'make_test_failed_within_command'?
203 delete $self->{badtestcnt};
205 $self->{incommandcolor} = $color;
208 #-> sub CPAN::Distribution::as_string ;
213 $self->SUPER::as_string(@_);
216 #-> sub CPAN::Distribution::containsmods ;
219 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
220 my $dist_id = $self->{ID};
221 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
222 my $mod_file = $mod->cpan_file or next;
223 my $mod_id = $mod->{ID} or next;
224 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
227 delete $self->{CONTAINSMODS};
230 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
232 keys %{$self->{CONTAINSMODS}||={}};
235 #-> sub CPAN::Distribution::upload_date ;
238 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
239 my(@local_wanted) = split(/\//,$self->id);
240 my $filename = pop @local_wanted;
241 push @local_wanted, "CHECKSUMS";
242 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
243 return unless $author;
244 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
246 my($dirent) = grep { $_->[2] eq $filename } @dl;
247 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
248 return unless $dirent->[1];
249 return $self->{UPLOAD_DATE} = $dirent->[1];
252 #-> sub CPAN::Distribution::uptodate ;
256 foreach $c ($self->containsmods) {
257 my $obj = CPAN::Shell->expandany($c);
258 unless ($obj->uptodate) {
259 my $id = $self->pretty_id;
260 $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG;
267 #-> sub CPAN::Distribution::called_for ;
270 $self->{CALLED_FOR} = $id if defined $id;
271 return $self->{CALLED_FOR};
274 #-> sub CPAN::Distribution::get ;
277 $self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
278 if (my $goto = $self->prefs->{goto}) {
279 $CPAN::Frontend->mywarn
281 "delegating to '%s' as specified in prefs file '%s' doc %d\n",
284 $self->{prefs_file_doc},
286 return $self->goto($goto);
288 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
290 : ($ENV{PERLLIB} || "");
291 local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
292 $CPAN::META->set_perl5lib;
293 local $ENV{MAKEFLAGS}; # protect us from outer make calls
298 $self->debug("checking disabled id[$self->{ID}]") if $CPAN::DEBUG;
299 if ($self->prefs->{disabled} && ! $self->{force_update}) {
301 "Disabled via prefs file '%s' doc %d",
303 $self->{prefs_file_doc},
306 $self->{unwrapped} = CPAN::Distrostatus->new("NO $why");
307 $goodbye_message = "[disabled] -- NA $why";
308 # note: not intended to be persistent but at least visible
309 # during this session
311 if (exists $self->{build_dir} && -d $self->{build_dir}
312 && ($self->{modulebuild}||$self->{writemakefile})
314 # this deserves print, not warn:
315 $CPAN::Frontend->myprint(" Has already been unwrapped into directory ".
316 "$self->{build_dir}\n"
321 # although we talk about 'force' we shall not test on
322 # force directly. New model of force tries to refrain from
323 # direct checking of force.
324 exists $self->{unwrapped} and (
325 UNIVERSAL::can($self->{unwrapped},"failed") ?
326 $self->{unwrapped}->failed :
327 $self->{unwrapped} =~ /^NO/
329 and push @e, "Unwrapping had some problem, won't try again without force";
332 $CPAN::Frontend->mywarn(join "", map {"$_\n"} @e);
333 if ($goodbye_message) {
334 $self->goodbye($goodbye_message);
339 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
342 unless ($self->{build_dir} && -d $self->{build_dir}) {
343 $self->get_file_onto_local_disk;
344 return if $CPAN::Signal;
345 $self->check_integrity;
346 return if $CPAN::Signal;
347 (my $packagedir,$local_file) = $self->run_preps_on_packagedir;
348 if (exists $self->{writemakefile} && ref $self->{writemakefile}
349 && $self->{writemakefile}->can("failed") &&
350 $self->{writemakefile}->failed) {
353 $packagedir ||= $self->{build_dir};
354 $self->{build_dir} = $packagedir;
358 $self->safe_chdir($sub_wd);
361 return $self->choose_MM_or_MB($local_file);
364 #-> CPAN::Distribution::get_file_onto_local_disk
365 sub get_file_onto_local_disk {
368 return if $self->is_dot_dist;
372 $CPAN::Config->{keep_source_where},
375 split(/\//,$self->id)
378 $self->debug("Doing localize") if $CPAN::DEBUG;
379 unless ($local_file =
380 CPAN::FTP->localize("authors/id/$self->{ID}",
383 if ($CPAN::Index::DATE_OF_02) {
384 $note = "Note: Current database in memory was generated ".
385 "on $CPAN::Index::DATE_OF_02\n";
387 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
390 $self->debug("local_wanted[$local_wanted]local_file[$local_file]") if $CPAN::DEBUG;
391 $self->{localfile} = $local_file;
395 #-> CPAN::Distribution::check_integrity
396 sub check_integrity {
399 return if $self->is_dot_dist;
400 if ($CPAN::META->has_inst("Digest::SHA")) {
401 $self->debug("Digest::SHA is installed, verifying");
402 $self->verifyCHECKSUM;
404 $self->debug("Digest::SHA is NOT installed");
408 #-> CPAN::Distribution::run_preps_on_packagedir
409 sub run_preps_on_packagedir {
411 return if $self->is_dot_dist;
413 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
414 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
415 $self->safe_chdir($builddir);
416 $self->debug("Removing tmp-$$") if $CPAN::DEBUG;
417 File::Path::rmtree("tmp-$$");
418 unless (mkdir "tmp-$$", 0755) {
419 $CPAN::Frontend->unrecoverable_error(<<EOF);
420 Couldn't mkdir '$builddir/tmp-$$': $!
422 Cannot continue: Please find the reason why I cannot make the
425 and fix the problem, then retry.
432 $self->safe_chdir("tmp-$$");
437 my $local_file = $self->{localfile};
438 my $ct = eval{CPAN::Tarzip->new($local_file)};
440 $self->{unwrapped} = CPAN::Distrostatus->new("NO");
441 delete $self->{build_dir};
444 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i) {
445 $self->{was_uncompressed}++ unless eval{$ct->gtest()};
446 $self->untar_me($ct);
447 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
448 $self->unzip_me($ct);
450 $self->{was_uncompressed}++ unless $ct->gtest();
451 $local_file = $self->handle_singlefile($local_file);
454 # we are still in the tmp directory!
455 # Let's check if the package has its own directory.
456 my $dh = DirHandle->new(File::Spec->curdir)
457 or Carp::croak("Couldn't opendir .: $!");
458 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
459 if (grep { $_ eq "pax_global_header" } @readdir) {
460 $CPAN::Frontend->mywarn("Your (un)tar seems to have extracted a file named 'pax_global_header'
461 from the tarball '$local_file'.
462 This is almost certainly an error. Please upgrade your tar.
463 I'll ignore this file for now.
464 See also http://rt.cpan.org/Ticket/Display.html?id=38932\n");
465 $CPAN::Frontend->mysleep(5);
466 @readdir = grep { $_ ne "pax_global_header" } @readdir;
470 # XXX here we want in each branch File::Temp to protect all build_dir directories
471 if (CPAN->has_usable("File::Temp")) {
475 if (@readdir == 1 && -d $readdir[0]) {
476 $tdir_base = $readdir[0];
477 $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]);
479 unless ($dh2 = DirHandle->new($from_dir)) {
480 my($mode) = (stat $from_dir)[2];
483 "Couldn't opendir '%s', mode '%o': %s",
488 $CPAN::Frontend->mywarn("$why\n");
489 $self->{writemakefile} = CPAN::Distrostatus->new("NO -- $why");
492 @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC??
494 my $userid = $self->cpan_userid;
495 CPAN->debug("userid[$userid]");
496 if (!$userid or $userid eq "N/A") {
499 $tdir_base = $userid;
500 $from_dir = File::Spec->curdir;
503 $packagedir = File::Temp::tempdir(
508 chmod 0777 &~ umask, $packagedir; # may fail
510 for $f (@dirents) { # is already without "." and ".."
511 my $from = File::Spec->catdir($from_dir,$f);
512 my $to = File::Spec->catdir($packagedir,$f);
513 unless (File::Copy::move($from,$to)) {
515 $from = File::Spec->rel2abs($from);
516 Carp::confess("Couldn't move $from to $to: $err");
519 } else { # older code below, still better than nothing when there is no File::Temp
521 if (@readdir == 1 && -d $readdir[0]) {
522 $distdir = $readdir[0];
523 $packagedir = File::Spec->catdir($builddir,$distdir);
524 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
526 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
528 File::Path::rmtree($packagedir);
529 unless (File::Copy::move($distdir,$packagedir)) {
530 $CPAN::Frontend->unrecoverable_error(<<EOF);
531 Couldn't move '$distdir' to '$packagedir': $!
533 Cannot continue: Please find the reason why I cannot move
534 $builddir/tmp-$$/$distdir
537 and fix the problem, then retry
541 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
548 my $userid = $self->cpan_userid;
549 CPAN->debug("userid[$userid]") if $CPAN::DEBUG;
550 if (!$userid or $userid eq "N/A") {
553 my $pragmatic_dir = $userid . '000';
554 $pragmatic_dir =~ s/\W_//g;
555 $pragmatic_dir++ while -d "../$pragmatic_dir";
556 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
557 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
558 File::Path::mkpath($packagedir);
560 for $f (@readdir) { # is already without "." and ".."
561 my $to = File::Spec->catdir($packagedir,$f);
562 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
566 $self->{build_dir} = $packagedir;
567 $self->safe_chdir($builddir);
568 File::Path::rmtree("tmp-$$");
570 $self->safe_chdir($packagedir);
571 $self->_signature_business();
572 $self->safe_chdir($builddir);
574 return($packagedir,$local_file);
577 #-> sub CPAN::Distribution::parse_meta_yml ;
580 my $build_dir = $self->{build_dir} or die "PANIC: cannot parse yaml without a build_dir";
581 my $yaml = File::Spec->catfile($build_dir,"META.yml");
582 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
583 return unless -f $yaml;
586 require Parse::CPAN::Meta;
587 $early_yaml = Parse::CPAN::Meta::LoadFile($yaml)->[0];
589 unless ($early_yaml) {
590 eval { $early_yaml = CPAN->_yaml_loadfile($yaml)->[0]; };
592 unless ($early_yaml) {
598 #-> sub CPAN::Distribution::satisfy_requires ;
599 sub satisfy_requires {
601 if (my @prereq = $self->unsat_prereq("later")) {
602 if ($prereq[0][0] eq "perl") {
603 my $need = "requires perl '$prereq[0][1]'";
604 my $id = $self->pretty_id;
605 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
606 $self->{make} = CPAN::Distrostatus->new("NO $need");
607 $self->store_persistent_state;
608 die "[prereq] -- NOT OK\n";
610 my $follow = eval { $self->follow_prereqs("later",@prereq); };
613 # signal success to the queuerunner
615 } elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) {
616 $CPAN::Frontend->mywarn($@);
617 die "[depend] -- NOT OK\n";
623 #-> sub CPAN::Distribution::satisfy_configure_requires ;
624 sub satisfy_configure_requires {
626 my $enable_configure_requires = 1;
627 if (!$enable_configure_requires) {
629 # if we return 1 here, everything is as before we introduced
630 # configure_requires that means, things with
631 # configure_requires simply fail, all others succeed
633 my @prereq = $self->unsat_prereq("configure_requires_later") or return 1;
634 if ($self->{configure_requires_later}) {
635 for my $k (keys %{$self->{configure_requires_later_for}||{}}) {
636 if ($self->{configure_requires_later_for}{$k}>1) {
637 # we must not come here a second time
638 $CPAN::Frontend->mywarn("Panic: Some prerequisites is not available, please investigate...");
640 $CPAN::Frontend->mydie
643 ({self=>$self, prereq=>\@prereq})
648 if ($prereq[0][0] eq "perl") {
649 my $need = "requires perl '$prereq[0][1]'";
650 my $id = $self->pretty_id;
651 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
652 $self->{make} = CPAN::Distrostatus->new("NO $need");
653 $self->store_persistent_state;
654 return $self->goodbye("[prereq] -- NOT OK");
657 $self->follow_prereqs("configure_requires_later", @prereq);
662 } elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) {
663 $CPAN::Frontend->mywarn($@);
664 return $self->goodbye("[depend] -- NOT OK");
670 #-> sub CPAN::Distribution::choose_MM_or_MB ;
671 sub choose_MM_or_MB {
672 my($self,$local_file) = @_;
673 $self->satisfy_configure_requires() or return;
674 my($mpl) = File::Spec->catfile($self->{build_dir},"Makefile.PL");
675 my($mpl_exists) = -f $mpl;
676 unless ($mpl_exists) {
677 # NFS has been reported to have racing problems after the
678 # renaming of a directory in some environments.
680 $CPAN::Frontend->mysleep(1);
681 my $mpldh = DirHandle->new($self->{build_dir})
682 or Carp::croak("Couldn't opendir $self->{build_dir}: $!");
683 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
686 my $prefer_installer = "eumm"; # eumm|mb
687 if (-f File::Spec->catfile($self->{build_dir},"Build.PL")) {
688 if ($mpl_exists) { # they *can* choose
689 if ($CPAN::META->has_inst("Module::Build")) {
690 $prefer_installer = CPAN::HandleConfig->prefs_lookup($self,
691 q{prefer_installer});
694 $prefer_installer = "mb";
697 return unless $self->patch;
698 if (lc($prefer_installer) eq "rand") {
699 $prefer_installer = rand()<.5 ? "eumm" : "mb";
701 if (lc($prefer_installer) eq "mb") {
702 $self->{modulebuild} = 1;
703 } elsif ($self->{archived} eq "patch") {
704 # not an edge case, nothing to install for sure
705 my $why = "A patch file cannot be installed";
706 $CPAN::Frontend->mywarn("Refusing to handle this file: $why\n");
707 $self->{writemakefile} = CPAN::Distrostatus->new("NO $why");
708 } elsif (! $mpl_exists) {
709 $self->_edge_cases($mpl,$local_file);
711 if ($self->{build_dir}
713 $CPAN::Config->{build_dir_reuse}
715 $self->store_persistent_state;
720 #-> CPAN::Distribution::store_persistent_state
721 sub store_persistent_state {
723 my $dir = $self->{build_dir};
724 unless (File::Spec->canonpath(File::Basename::dirname($dir))
725 eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
726 $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
727 "will not store persistent state\n");
730 my $file = sprintf "%s.yml", $dir;
731 my $yaml_module = CPAN::_yaml_module();
732 if ($CPAN::META->has_inst($yaml_module)) {
733 CPAN->_yaml_dumpfile(
737 perl => CPAN::_perl_fingerprint(),
738 distribution => $self,
742 $CPAN::Frontend->myprint("Warning (usually harmless): '$yaml_module' not installed, ".
743 "will not store persistent state\n");
747 #-> CPAN::Distribution::try_download
749 my($self,$patch) = @_;
750 my $norm = $self->normalize($patch);
753 $CPAN::Config->{keep_source_where},
758 $self->debug("Doing localize") if $CPAN::DEBUG;
759 return CPAN::FTP->localize("authors/id/$norm",
764 my $stdpatchargs = "";
765 #-> CPAN::Distribution::patch
768 $self->debug("checking patches id[$self->{ID}]") if $CPAN::DEBUG;
769 my $patches = $self->prefs->{patches};
771 $self->debug("patches[$patches]") if $CPAN::DEBUG;
773 return unless @$patches;
774 $self->safe_chdir($self->{build_dir});
775 CPAN->debug("patches[$patches]") if $CPAN::DEBUG;
776 my $patchbin = $CPAN::Config->{patch};
777 unless ($patchbin && length $patchbin) {
778 $CPAN::Frontend->mydie("No external patch command configured\n\n".
779 "Please run 'o conf init /patch/'\n\n");
781 unless (MM->maybe_command($patchbin)) {
782 $CPAN::Frontend->mydie("No external patch command available\n\n".
783 "Please run 'o conf init /patch/'\n\n");
785 $patchbin = CPAN::HandleConfig->safe_quote($patchbin);
786 local $ENV{PATCH_GET} = 0; # formerly known as -g0
787 unless ($stdpatchargs) {
788 my $system = "$patchbin --version |";
790 open FH, $system or die "Could not fork '$system': $!";
793 PARSEVERSION: while (<FH>) {
794 if (/^patch\s+([\d\.]+)/) {
800 $stdpatchargs = "-N --fuzz=3";
802 $stdpatchargs = "-N";
805 my $countedpatches = @$patches == 1 ? "1 patch" : (scalar @$patches . " patches");
806 $CPAN::Frontend->myprint("Going to apply $countedpatches:\n");
807 my $patches_dir = $CPAN::Config->{patches_dir};
808 for my $patch (@$patches) {
809 if ($patches_dir && !File::Spec->file_name_is_absolute($patch)) {
810 my $f = File::Spec->catfile($patches_dir, $patch);
811 $patch = $f if -f $f;
814 if (my $trydl = $self->try_download($patch)) {
817 my $fail = "Could not find patch '$patch'";
818 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
819 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
820 delete $self->{build_dir};
824 $CPAN::Frontend->myprint(" $patch\n");
825 my $readfh = CPAN::Tarzip->TIEHANDLE($patch);
828 my $ppp = $self->_patch_p_parameter($readfh);
829 if ($ppp eq "applypatch") {
830 $pcommand = "$CPAN::Config->{applypatch} -verbose";
832 my $thispatchargs = join " ", $stdpatchargs, $ppp;
833 $pcommand = "$patchbin $thispatchargs";
836 $readfh = CPAN::Tarzip->TIEHANDLE($patch); # open again
837 my $writefh = FileHandle->new;
838 $CPAN::Frontend->myprint(" $pcommand\n");
839 unless (open $writefh, "|$pcommand") {
840 my $fail = "Could not fork '$pcommand'";
841 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
842 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
843 delete $self->{build_dir};
847 while (my $x = $readfh->READLINE) {
850 unless (close $writefh) {
851 my $fail = "Could not apply patch '$patch'";
852 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
853 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
854 delete $self->{build_dir};
864 sub _patch_p_parameter {
869 while ($_ = $fh->READLINE) {
871 $CPAN::Config->{applypatch}
873 /\#\#\#\# ApplyPatch data follows \#\#\#\#/
877 next unless /^[\*\+]{3}\s(\S+)/;
880 $cnt_p0files++ if -f $file;
881 CPAN->debug("file[$file]cnt_files[$cnt_files]cnt_p0files[$cnt_p0files]")
884 return "-p1" unless $cnt_files;
885 return $cnt_files==$cnt_p0files ? "-p0" : "-p1";
888 #-> sub CPAN::Distribution::_edge_cases
889 # with "configure" or "Makefile" or single file scripts
891 my($self,$mpl,$local_file) = @_;
892 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
896 my $build_dir = $self->{build_dir};
897 my($configure) = File::Spec->catfile($build_dir,"Configure");
899 # do we have anything to do?
900 $self->{configure} = $configure;
901 } elsif (-f File::Spec->catfile($build_dir,"Makefile")) {
902 $CPAN::Frontend->mywarn(qq{
903 Package comes with a Makefile and without a Makefile.PL.
904 We\'ll try to build it with that Makefile then.
906 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
907 $CPAN::Frontend->mysleep(2);
909 my $cf = $self->called_for || "unknown";
914 $cf =~ s|[/\\:]||g; # risk of filesystem damage
915 $cf = "unknown" unless length($cf);
916 if (my $crud = $self->_contains_crud($build_dir)) {
917 my $why = qq{Package contains $crud; not recognized as a perl package, giving up};
918 $CPAN::Frontend->mywarn("$why\n");
919 $self->{writemakefile} = CPAN::Distrostatus->new(qq{NO -- $why});
922 $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
923 (The test -f "$mpl" returned false.)
924 Writing one on our own (setting NAME to $cf)\a\n});
925 $self->{had_no_makefile_pl}++;
926 $CPAN::Frontend->mysleep(3);
928 # Writing our own Makefile.PL
930 my $exefile_stanza = "";
931 if ($self->{archived} eq "maybe_pl") {
932 $exefile_stanza = $self->_exefile_stanza($build_dir,$local_file);
935 my $fh = FileHandle->new;
937 or Carp::croak("Could not open >$mpl: $!");
939 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
940 # because there was no Makefile.PL supplied.
941 # Autogenerated on: }.scalar localtime().qq{
943 use ExtUtils::MakeMaker;
945 NAME => q[$cf],$exefile_stanza
952 #-> CPAN;:Distribution::_contains_crud
955 my(@dirs, $dh, @files);
956 opendir $dh, $dir or return;
958 for $dirent (readdir $dh) {
959 next if $dirent =~ /^\.\.?$/;
960 my $path = File::Spec->catdir($dir,$dirent);
964 push @files, $dirent;
967 if (@dirs && @files) {
968 return "both files[@files] and directories[@dirs]";
969 } elsif (@files > 2) {
970 return "several files[@files] but no Makefile.PL or Build.PL";
975 #-> CPAN;:Distribution::_exefile_stanza
976 sub _exefile_stanza {
977 my($self,$build_dir,$local_file) = @_;
979 my $fh = FileHandle->new;
980 my $script_file = File::Spec->catfile($build_dir,$local_file);
981 $fh->open($script_file)
982 or Carp::croak("Could not open script '$script_file': $!");
984 # name parsen und prereq
985 my($state) = "poddir";
986 my($name, $prereq) = ("", "");
988 if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
991 } elsif ($1 eq 'PREREQUISITES') {
994 } elsif ($state =~ m{^(name|prereq)$}) {
999 } elsif ($state eq "name") {
1004 } elsif ($state eq "prereq") {
1007 } elsif (/^=cut\b/) {
1014 s{.*<}{}; # strip X<...>
1018 $prereq = join " ", split /\s+/, $prereq;
1019 my($PREREQ_PM) = join("\n", map {
1020 s{.*<}{}; # strip X<...>
1022 if (/[\s\'\"]/) { # prose?
1024 s/[^\w:]$//; # period?
1025 " "x28 . "'$_' => 0,";
1027 } split /\s*,\s*/, $prereq);
1030 my $to_file = File::Spec->catfile($build_dir, $name);
1031 rename $script_file, $to_file
1032 or die "Can't rename $script_file to $to_file: $!";
1036 EXE_FILES => ['$name'],
1043 #-> CPAN::Distribution::_signature_business
1044 sub _signature_business {
1046 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
1049 if ($CPAN::META->has_inst("Module::Signature")) {
1050 if (-f "SIGNATURE") {
1051 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
1052 my $rv = Module::Signature::verify();
1053 if ($rv != Module::Signature::SIGNATURE_OK() and
1054 $rv != Module::Signature::SIGNATURE_MISSING()) {
1055 $CPAN::Frontend->mywarn(
1056 qq{\nSignature invalid for }.
1057 qq{distribution file. }.
1058 qq{Please investigate.\n\n}
1062 sprintf(qq{I'd recommend removing %s. Some error occurred }.
1063 qq{while checking its signature, so it could }.
1064 qq{be invalid. Maybe you have configured }.
1065 qq{your 'urllist' with a bad URL. Please check this }.
1066 qq{array with 'o conf urllist' and retry. Or }.
1067 qq{examine the distribution in a subshell. Try
1075 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
1076 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
1077 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
1079 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
1080 $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
1083 $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n});
1086 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
1091 #-> CPAN::Distribution::untar_me ;
1094 $self->{archived} = "tar";
1095 my $result = eval { $ct->untar() };
1097 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
1099 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- untar failed");
1103 # CPAN::Distribution::unzip_me ;
1106 $self->{archived} = "zip";
1108 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
1110 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- unzip failed");
1115 sub handle_singlefile {
1116 my($self,$local_file) = @_;
1118 if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ) {
1119 $self->{archived} = "pm";
1120 } elsif ( $local_file =~ /\.patch(\.(gz|bz2))?(?!\n)\Z/ ) {
1121 $self->{archived} = "patch";
1123 $self->{archived} = "maybe_pl";
1126 my $to = File::Basename::basename($local_file);
1127 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
1128 if (eval{CPAN::Tarzip->new($local_file)->gunzip($to)}) {
1129 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
1131 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- uncompressing failed");
1134 if (File::Copy::cp($local_file,".")) {
1135 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
1137 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- copying failed");
1143 #-> sub CPAN::Distribution::new ;
1145 my($class,%att) = @_;
1147 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
1149 my $this = { %att };
1150 return bless $this, $class;
1153 #-> sub CPAN::Distribution::look ;
1157 if ($^O eq 'MacOS') {
1158 $self->Mac::BuildTools::look;
1162 if ( $CPAN::Config->{'shell'} ) {
1163 $CPAN::Frontend->myprint(qq{
1164 Trying to open a subshell in the build directory...
1167 $CPAN::Frontend->myprint(qq{
1168 Your configuration does not define a value for subshells.
1169 Please define it with "o conf shell <your shell>"
1173 my $dist = $self->id;
1175 unless ($dir = $self->dir) {
1178 unless ($dir ||= $self->dir) {
1179 $CPAN::Frontend->mywarn(qq{
1180 Could not determine which directory to use for looking at $dist.
1184 my $pwd = CPAN::anycwd();
1185 $self->safe_chdir($dir);
1186 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
1188 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
1189 $ENV{CPAN_SHELL_LEVEL} += 1;
1190 my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
1192 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
1194 : ($ENV{PERLLIB} || "");
1196 local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
1197 $CPAN::META->set_perl5lib;
1198 local $ENV{MAKEFLAGS}; # protect us from outer make calls
1200 unless (system($shell) == 0) {
1202 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
1205 $self->safe_chdir($pwd);
1208 # CPAN::Distribution::cvs_import ;
1212 my $dir = $self->dir;
1214 my $package = $self->called_for;
1215 my $module = $CPAN::META->instance('CPAN::Module', $package);
1216 my $version = $module->cpan_version;
1218 my $userid = $self->cpan_userid;
1220 my $cvs_dir = (split /\//, $dir)[-1];
1221 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
1223 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
1225 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
1226 if ($cvs_site_perl) {
1227 $cvs_dir = "$cvs_site_perl/$cvs_dir";
1229 my $cvs_log = qq{"imported $package $version sources"};
1230 $version =~ s/\./_/g;
1231 # XXX cvs: undocumented and unclear how it was meant to work
1232 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
1233 "$cvs_dir", $userid, "v$version");
1235 my $pwd = CPAN::anycwd();
1236 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
1238 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
1240 $CPAN::Frontend->myprint(qq{@cmd\n});
1241 system(@cmd) == 0 or
1243 $CPAN::Frontend->mydie("cvs import failed");
1244 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
1247 #-> sub CPAN::Distribution::readme ;
1250 my($dist) = $self->id;
1251 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
1252 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
1255 File::Spec->catfile(
1256 $CPAN::Config->{keep_source_where},
1259 split(/\//,"$sans.readme"),
1261 $self->debug("Doing localize") if $CPAN::DEBUG;
1262 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
1264 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
1266 if ($^O eq 'MacOS') {
1267 Mac::BuildTools::launch_file($local_file);
1271 my $fh_pager = FileHandle->new;
1272 local($SIG{PIPE}) = "IGNORE";
1273 my $pager = $CPAN::Config->{'pager'} || "cat";
1274 $fh_pager->open("|$pager")
1275 or die "Could not open pager $pager\: $!";
1276 my $fh_readme = FileHandle->new;
1277 $fh_readme->open($local_file)
1278 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
1279 $CPAN::Frontend->myprint(qq{
1284 $fh_pager->print(<$fh_readme>);
1288 #-> sub CPAN::Distribution::verifyCHECKSUM ;
1289 sub verifyCHECKSUM {
1293 $self->{CHECKSUM_STATUS} ||= "";
1294 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
1295 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
1297 my($lc_want,$lc_file,@local,$basename);
1298 @local = split(/\//,$self->id);
1300 push @local, "CHECKSUMS";
1302 File::Spec->catfile($CPAN::Config->{keep_source_where},
1303 "authors", "id", @local);
1305 if (my $size = -s $lc_want) {
1306 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
1307 if ($self->CHECKSUM_check_file($lc_want,1)) {
1308 return $self->{CHECKSUM_STATUS} = "OK";
1311 $lc_file = CPAN::FTP->localize("authors/id/@local",
1314 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
1315 $local[-1] .= ".gz";
1316 $lc_file = CPAN::FTP->localize("authors/id/@local",
1319 $lc_file =~ s/\.gz(?!\n)\Z//;
1320 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
1325 if ($self->CHECKSUM_check_file($lc_file)) {
1326 return $self->{CHECKSUM_STATUS} = "OK";
1330 #-> sub CPAN::Distribution::SIG_check_file ;
1331 sub SIG_check_file {
1332 my($self,$chk_file) = @_;
1333 my $rv = eval { Module::Signature::_verify($chk_file) };
1335 if ($rv == Module::Signature::SIGNATURE_OK()) {
1336 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
1337 return $self->{SIG_STATUS} = "OK";
1339 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
1340 qq{distribution file. }.
1341 qq{Please investigate.\n\n}.
1343 $CPAN::META->instance(
1348 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
1349 is invalid. Maybe you have configured your 'urllist' with
1350 a bad URL. Please check this array with 'o conf urllist', and
1353 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
1357 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
1359 # sloppy is 1 when we have an old checksums file that maybe is good
1362 sub CHECKSUM_check_file {
1363 my($self,$chk_file,$sloppy) = @_;
1364 my($cksum,$file,$basename);
1367 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
1368 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
1371 if ($CPAN::META->has_inst("Module::Signature")) {
1372 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
1373 $self->SIG_check_file($chk_file);
1375 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
1379 $file = $self->{localfile};
1380 $basename = File::Basename::basename($file);
1381 my $fh = FileHandle->new;
1382 if (open $fh, $chk_file) {
1385 $eval =~ s/\015?\012/\n/g;
1387 my($compmt) = Safe->new();
1388 $cksum = $compmt->reval($eval);
1390 rename $chk_file, "$chk_file.bad";
1391 Carp::confess($@) if $@;
1394 Carp::carp "Could not open $chk_file for reading";
1397 if (! ref $cksum or ref $cksum ne "HASH") {
1398 $CPAN::Frontend->mywarn(qq{
1399 Warning: checksum file '$chk_file' broken.
1401 When trying to read that file I expected to get a hash reference
1402 for further processing, but got garbage instead.
1404 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
1405 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
1406 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
1408 } elsif (exists $cksum->{$basename}{sha256}) {
1409 $self->debug("Found checksum for $basename:" .
1410 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
1414 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
1416 $fh = CPAN::Tarzip->TIEHANDLE($file);
1419 my $dg = Digest::SHA->new(256);
1422 while ($fh->READ($ref, 4096) > 0) {
1425 my $hexdigest = $dg->hexdigest;
1426 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
1430 $CPAN::Frontend->myprint("Checksum for $file ok\n");
1431 return $self->{CHECKSUM_STATUS} = "OK";
1433 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
1434 qq{distribution file. }.
1435 qq{Please investigate.\n\n}.
1437 $CPAN::META->instance(
1442 my $wrap = qq{I\'d recommend removing $file. Its
1443 checksum is incorrect. Maybe you have configured your 'urllist' with
1444 a bad URL. Please check this array with 'o conf urllist', and
1447 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
1449 # former versions just returned here but this seems a
1450 # serious threat that deserves a die
1452 # $CPAN::Frontend->myprint("\n\n");
1456 # close $fh if fileno($fh);
1459 unless ($self->{CHECKSUM_STATUS}) {
1460 $CPAN::Frontend->mywarn(qq{
1461 Warning: No checksum for $basename in $chk_file.
1463 The cause for this may be that the file is very new and the checksum
1464 has not yet been calculated, but it may also be that something is
1465 going awry right now.
1467 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes");
1468 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
1470 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
1475 #-> sub CPAN::Distribution::eq_CHECKSUM ;
1477 my($self,$fh,$expect) = @_;
1478 if ($CPAN::META->has_inst("Digest::SHA")) {
1479 my $dg = Digest::SHA->new(256);
1481 while (read($fh, $data, 4096)) {
1484 my $hexdigest = $dg->hexdigest;
1485 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
1486 return $hexdigest eq $expect;
1491 #-> sub CPAN::Distribution::force ;
1493 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
1494 # effect by autoinspection, not by inspecting a global variable. One
1495 # of the reason why this was chosen to work that way was the treatment
1496 # of dependencies. They should not automatically inherit the force
1497 # status. But this has the downside that ^C and die() will return to
1498 # the prompt but will not be able to reset the force_update
1499 # attributes. We try to correct for it currently in the read_metadata
1500 # routine, and immediately before we check for a Signal. I hope this
1501 # works out in one of v1.57_53ff
1503 # "Force get forgets previous error conditions"
1505 #-> sub CPAN::Distribution::fforce ;
1507 my($self, $method) = @_;
1508 $self->force($method,1);
1511 #-> sub CPAN::Distribution::force ;
1513 my($self, $method,$fforce) = @_;
1531 "prereq_pm_detected",
1545 my $methodmatch = 0;
1547 PHASE: for my $phase (qw(unknown get make test install)) { # order matters
1548 $methodmatch = 1 if $fforce || $phase eq $method;
1549 next unless $methodmatch;
1550 ATTRIBUTE: for my $att (@{$phase_map{$phase}}) {
1551 if ($phase eq "get") {
1552 if (substr($self->id,-1,1) eq "."
1553 && $att =~ /(unwrapped|build_dir|archived)/ ) {
1554 # cannot be undone for local distros
1557 if ($att eq "build_dir"
1558 && $self->{build_dir}
1559 && $CPAN::META->{is_tested}
1561 delete $CPAN::META->{is_tested}{$self->{build_dir}};
1563 } elsif ($phase eq "test") {
1564 if ($att eq "make_test"
1565 && $self->{make_test}
1566 && $self->{make_test}{COMMANDID}
1567 && $self->{make_test}{COMMANDID} == $CPAN::CurrentCommandId
1569 # endless loop too likely
1573 delete $self->{$att};
1574 if ($ldebug || $CPAN::DEBUG) {
1575 # local $CPAN::DEBUG = 16; # Distribution
1576 CPAN->debug(sprintf "id[%s]phase[%s]att[%s]", $self->id, $phase, $att);
1580 if ($method && $method =~ /make|test|install/) {
1581 $self->{force_update} = 1; # name should probably have been force_install
1585 #-> sub CPAN::Distribution::notest ;
1587 my($self, $method) = @_;
1588 # $CPAN::Frontend->mywarn("XDEBUG: set notest for $self $method");
1589 $self->{"notest"}++; # name should probably have been force_install
1592 #-> sub CPAN::Distribution::unnotest ;
1595 # warn "XDEBUG: deleting notest";
1596 delete $self->{notest};
1599 #-> sub CPAN::Distribution::unforce ;
1602 delete $self->{force_update};
1605 #-> sub CPAN::Distribution::isa_perl ;
1608 my $file = File::Basename::basename($self->id);
1609 if ($file =~ m{ ^ perl
1618 \.tar[._-](?:gz|bz2)
1622 } elsif ($self->cpan_comment
1624 $self->cpan_comment =~ /isa_perl\(.+?\)/) {
1630 #-> sub CPAN::Distribution::perl ;
1635 carp __PACKAGE__ . "::perl was called without parameters.";
1637 return CPAN::HandleConfig->safe_quote($CPAN::Perl);
1641 #-> sub CPAN::Distribution::make ;
1644 if (my $goto = $self->prefs->{goto}) {
1645 return $self->goto($goto);
1647 my $make = $self->{modulebuild} ? "Build" : "make";
1648 # Emergency brake if they said install Pippi and get newest perl
1649 if ($self->isa_perl) {
1651 $self->called_for ne $self->id &&
1652 ! $self->{force_update}
1654 # if we die here, we break bundles
1657 qq{The most recent version "%s" of the module "%s"
1658 is part of the perl-%s distribution. To install that, you need to run
1659 force install %s --or--
1662 $CPAN::META->instance(
1671 $self->{make} = CPAN::Distrostatus->new("NO isa perl");
1672 $CPAN::Frontend->mysleep(1);
1676 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
1678 return if $self->prefs->{disabled} && ! $self->{force_update};
1679 if ($self->{configure_requires_later}) {
1682 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
1684 : ($ENV{PERLLIB} || "");
1685 local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
1686 $CPAN::META->set_perl5lib;
1687 local $ENV{MAKEFLAGS}; # protect us from outer make calls
1689 if ($CPAN::Signal) {
1690 delete $self->{force_update};
1697 if (!$self->{archived} || $self->{archived} eq "NO") {
1698 push @e, "Is neither a tar nor a zip archive.";
1701 if (!$self->{unwrapped}
1703 UNIVERSAL::can($self->{unwrapped},"failed") ?
1704 $self->{unwrapped}->failed :
1705 $self->{unwrapped} =~ /^NO/
1707 push @e, "Had problems unarchiving. Please build manually";
1710 unless ($self->{force_update}) {
1711 exists $self->{signature_verify} and
1713 UNIVERSAL::can($self->{signature_verify},"failed") ?
1714 $self->{signature_verify}->failed :
1715 $self->{signature_verify} =~ /^NO/
1717 and push @e, "Did not pass the signature test.";
1720 if (exists $self->{writemakefile} &&
1722 UNIVERSAL::can($self->{writemakefile},"failed") ?
1723 $self->{writemakefile}->failed :
1724 $self->{writemakefile} =~ /^NO/
1726 # XXX maybe a retry would be in order?
1727 my $err = UNIVERSAL::can($self->{writemakefile},"text") ?
1728 $self->{writemakefile}->text :
1729 $self->{writemakefile};
1730 $err =~ s/^NO\s*(--\s+)?//;
1731 $err ||= "Had some problem writing Makefile";
1732 $err .= ", won't make";
1736 if (defined $self->{make}) {
1737 if (UNIVERSAL::can($self->{make},"failed") ?
1738 $self->{make}->failed :
1739 $self->{make} =~ /^NO/) {
1740 if ($self->{force_update}) {
1741 # Trying an already failed 'make' (unless somebody else blocks)
1743 # introduced for turning recursion detection into a distrostatus
1744 my $error = length $self->{make}>3
1745 ? substr($self->{make},3) : "Unknown error";
1746 $CPAN::Frontend->mywarn("Could not make: $error\n");
1747 $self->store_persistent_state;
1751 push @e, "Has already been made";
1752 my $wait_for_prereqs = eval { $self->satisfy_requires };
1753 return 1 if $wait_for_prereqs; # tells queuerunner to continue
1754 return $self->goodbye($@) if $@; # tells queuerunner to stop
1758 my $later = $self->{later} || $self->{configure_requires_later};
1759 if ($later) { # see also undelay
1765 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
1766 $builddir = $self->dir or
1767 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
1768 unless (chdir $builddir) {
1769 push @e, "Couldn't chdir to '$builddir': $!";
1771 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
1773 if ($CPAN::Signal) {
1774 delete $self->{force_update};
1777 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
1778 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
1780 if ($^O eq 'MacOS') {
1781 Mac::BuildTools::make($self);
1786 while (my($k,$v) = each %ENV) {
1787 next unless defined $v;
1793 if ($self->prefs->{pl}) {
1794 $pl_commandline = $self->prefs->{pl}{commandline};
1796 if ($pl_commandline) {
1797 $system = $pl_commandline;
1799 } elsif ($self->{'configure'}) {
1800 $system = $self->{'configure'};
1801 } elsif ($self->{modulebuild}) {
1802 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
1803 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
1805 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
1807 # This needs a handler that can be turned on or off:
1808 # $switch = "-MExtUtils::MakeMaker ".
1809 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
1811 my $makepl_arg = $self->_make_phase_arg("pl");
1812 $ENV{PERL5_CPAN_IS_EXECUTING} = File::Spec->catfile($self->{build_dir},
1814 $system = sprintf("%s%s Makefile.PL%s",
1816 $switch ? " $switch" : "",
1817 $makepl_arg ? " $makepl_arg" : "",
1821 if ($self->prefs->{pl}) {
1822 $pl_env = $self->prefs->{pl}{env};
1825 for my $e (keys %$pl_env) {
1826 $ENV{$e} = $pl_env->{$e};
1829 if (exists $self->{writemakefile}) {
1831 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
1832 my($ret,$pid,$output);
1835 if ($CPAN::Config->{inactivity_timeout}) {
1837 if ($Config::Config{d_alarm}
1839 $Config::Config{d_alarm} eq "define"
1843 $CPAN::Frontend->mywarn("Warning: you have configured the config ".
1844 "variable 'inactivity_timeout' to ".
1845 "'$CPAN::Config->{inactivity_timeout}'. But ".
1846 "on this machine the system call 'alarm' ".
1847 "isn't available. This means that we cannot ".
1848 "provide the feature of intercepting long ".
1849 "waiting code and will turn this feature off.\n"
1851 $CPAN::Config->{inactivity_timeout} = 0;
1854 if ($go_via_alarm) {
1855 if ( $self->_should_report('pl') ) {
1856 ($output, $ret) = CPAN::Reporter::record_command(
1858 $CPAN::Config->{inactivity_timeout},
1860 CPAN::Reporter::grade_PL( $self, $system, $output, $ret );
1864 alarm $CPAN::Config->{inactivity_timeout};
1865 local $SIG{CHLD}; # = sub { wait };
1866 if (defined($pid = fork)) {
1871 # note, this exec isn't necessary if
1872 # inactivity_timeout is 0. On the Mac I'd
1873 # suggest, we set it always to 0.
1877 $CPAN::Frontend->myprint("Cannot fork: $!");
1886 $CPAN::Frontend->myprint($err);
1887 $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
1889 $self->store_persistent_state;
1890 return $self->goodbye("$system -- TIMED OUT");
1894 if (my $expect_model = $self->_prefs_with_expect("pl")) {
1895 # XXX probably want to check _should_report here and warn
1896 # about not being able to use CPAN::Reporter with expect
1897 $ret = $self->_run_via_expect($system,'writemakefile',$expect_model);
1899 && $self->{writemakefile}
1900 && $self->{writemakefile}->failed) {
1905 elsif ( $self->_should_report('pl') ) {
1906 ($output, $ret) = CPAN::Reporter::record_command($system);
1907 CPAN::Reporter::grade_PL( $self, $system, $output, $ret );
1910 $ret = system($system);
1913 $self->{writemakefile} = CPAN::Distrostatus
1914 ->new("NO '$system' returned status $ret");
1915 $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
1916 $self->store_persistent_state;
1917 return $self->goodbye("$system -- NOT OK");
1920 if (-f "Makefile" || -f "Build") {
1921 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
1922 delete $self->{make_clean}; # if cleaned before, enable next
1924 my $makefile = $self->{modulebuild} ? "Build" : "Makefile";
1925 my $why = "No '$makefile' created";
1926 $CPAN::Frontend->mywarn($why);
1927 $self->{writemakefile} = CPAN::Distrostatus
1928 ->new(qq{NO -- $why\n});
1929 $self->store_persistent_state;
1930 return $self->goodbye("$system -- NOT OK");
1933 if ($CPAN::Signal) {
1934 delete $self->{force_update};
1937 my $wait_for_prereqs = eval { $self->satisfy_requires };
1938 return 1 if $wait_for_prereqs; # tells queuerunner to continue
1939 return $self->goodbye($@) if $@; # tells queuerunner to stop
1940 if ($CPAN::Signal) {
1941 delete $self->{force_update};
1944 my $make_commandline;
1945 if ($self->prefs->{make}) {
1946 $make_commandline = $self->prefs->{make}{commandline};
1948 if ($make_commandline) {
1949 $system = $make_commandline;
1950 $ENV{PERL} = CPAN::find_perl();
1952 if ($self->{modulebuild}) {
1953 unless (-f "Build") {
1954 my $cwd = CPAN::anycwd();
1955 $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'".
1956 " in cwd[$cwd]. Danger, Will Robinson!\n");
1957 $CPAN::Frontend->mysleep(5);
1959 $system = join " ", $self->_build_command(), $CPAN::Config->{mbuild_arg};
1961 $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
1963 $system =~ s/\s+$//;
1964 my $make_arg = $self->_make_phase_arg("make");
1965 $system = sprintf("%s%s",
1967 $make_arg ? " $make_arg" : "",
1971 if ($self->prefs->{make}) {
1972 $make_env = $self->prefs->{make}{env};
1974 if ($make_env) { # overriding the local ENV of PL, not the outer
1975 # ENV, but unlikely to be a risk
1976 for my $e (keys %$make_env) {
1977 $ENV{$e} = $make_env->{$e};
1980 my $expect_model = $self->_prefs_with_expect("make");
1981 my $want_expect = 0;
1982 if ( $expect_model && @{$expect_model->{talk}} ) {
1983 my $can_expect = $CPAN::META->has_inst("Expect");
1987 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
1993 # XXX probably want to check _should_report here and
1994 # warn about not being able to use CPAN::Reporter with expect
1995 $system_ok = $self->_run_via_expect($system,'make',$expect_model) == 0;
1997 elsif ( $self->_should_report('make') ) {
1998 my ($output, $ret) = CPAN::Reporter::record_command($system);
1999 CPAN::Reporter::grade_make( $self, $system, $output, $ret );
2000 $system_ok = ! $ret;
2003 $system_ok = system($system) == 0;
2005 $self->introduce_myself;
2007 $CPAN::Frontend->myprint(" $system -- OK\n");
2008 $self->{make} = CPAN::Distrostatus->new("YES");
2010 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
2011 $self->{make} = CPAN::Distrostatus->new("NO");
2012 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
2014 $self->store_persistent_state;
2017 # CPAN::Distribution::goodbye ;
2019 my($self,$goodbye) = @_;
2020 my $id = $self->pretty_id;
2021 $CPAN::Frontend->mywarn(" $id\n $goodbye\n");
2025 # CPAN::Distribution::_run_via_expect ;
2026 sub _run_via_expect {
2027 my($self,$system,$phase,$expect_model) = @_;
2028 CPAN->debug("system[$system]expect_model[$expect_model]") if $CPAN::DEBUG;
2029 if ($CPAN::META->has_inst("Expect")) {
2030 my $expo = Expect->new; # expo Expect object;
2031 $expo->spawn($system);
2032 $expect_model->{mode} ||= "deterministic";
2033 if ($expect_model->{mode} eq "deterministic") {
2034 return $self->_run_via_expect_deterministic($expo,$phase,$expect_model);
2035 } elsif ($expect_model->{mode} eq "anyorder") {
2036 return $self->_run_via_expect_anyorder($expo,$phase,$expect_model);
2038 die "Panic: Illegal expect mode: $expect_model->{mode}";
2041 $CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n");
2042 return system($system);
2046 sub _run_via_expect_anyorder {
2047 my($self,$expo,$phase,$expect_model) = @_;
2048 my $timeout = $expect_model->{timeout} || 5;
2049 my $reuse = $expect_model->{reuse};
2050 my @expectacopy = @{$expect_model->{talk}}; # we trash it!
2052 my $timeout_start = time;
2054 my($eof,$ran_into_timeout);
2055 # XXX not up to the full power of expect. one could certainly
2056 # wrap all of the talk pairs into a single expect call and on
2057 # success tweak it and step ahead to the next question. The
2058 # current implementation unnecessarily limits itself to a
2060 my @match = $expo->expect(1,
2065 $ran_into_timeout++;
2072 $but .= $expo->clear_accum;
2075 return $expo->exitstatus();
2076 } elsif ($ran_into_timeout) {
2077 # warn "DEBUG: they are asking a question, but[$but]";
2078 for (my $i = 0; $i <= $#expectacopy; $i+=2) {
2079 my($next,$send) = @expectacopy[$i,$i+1];
2080 my $regex = eval "qr{$next}";
2081 # warn "DEBUG: will compare with regex[$regex].";
2082 if ($but =~ /$regex/) {
2083 # warn "DEBUG: will send send[$send]";
2085 # never allow reusing an QA pair unless they told us
2086 splice @expectacopy, $i, 2 unless $reuse;
2090 my $have_waited = time - $timeout_start;
2091 if ($have_waited < $timeout) {
2092 # warn "DEBUG: have_waited[$have_waited]timeout[$timeout]";
2095 my $why = "could not answer a question during the dialog";
2096 $CPAN::Frontend->mywarn("Failing: $why\n");
2098 CPAN::Distrostatus->new("NO $why");
2104 sub _run_via_expect_deterministic {
2105 my($self,$expo,$phase,$expect_model) = @_;
2106 my $ran_into_timeout;
2108 my $timeout = $expect_model->{timeout} || 15; # currently unsettable
2109 my $expecta = $expect_model->{talk};
2110 EXPECT: for (my $i = 0; $i <= $#$expecta; $i+=2) {
2111 my($re,$send) = @$expecta[$i,$i+1];
2112 CPAN->debug("timeout[$timeout]re[$re]") if $CPAN::DEBUG;
2113 my $regex = eval "qr{$re}";
2114 $expo->expect($timeout,
2116 my $but = $expo->clear_accum;
2117 $CPAN::Frontend->mywarn("EOF (maybe harmless)
2118 expected[$regex]\nbut[$but]\n\n");
2122 my $but = $expo->clear_accum;
2123 $CPAN::Frontend->mywarn("TIMEOUT
2124 expected[$regex]\nbut[$but]\n\n");
2125 $ran_into_timeout++;
2128 if ($ran_into_timeout) {
2129 # note that the caller expects 0 for success
2131 CPAN::Distrostatus->new("NO timeout during expect dialog");
2133 } elsif ($ran_into_eof) {
2139 return $expo->exitstatus();
2142 #-> CPAN::Distribution::_validate_distropref
2143 sub _validate_distropref {
2144 my($self,@args) = @_;
2146 $CPAN::META->has_inst("CPAN::Kwalify")
2148 $CPAN::META->has_inst("Kwalify")
2150 eval {CPAN::Kwalify::_validate("distroprefs",@args);};
2152 $CPAN::Frontend->mywarn($@);
2155 CPAN->debug("not validating '@args'") if $CPAN::DEBUG;
2159 #-> CPAN::Distribution::_find_prefs
2162 my $distroid = $self->pretty_id;
2163 #CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
2164 my $prefs_dir = $CPAN::Config->{prefs_dir};
2165 return if $prefs_dir =~ /^\s*$/;
2166 eval { File::Path::mkpath($prefs_dir); };
2168 $CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
2170 my $yaml_module = CPAN::_yaml_module();
2173 if ($CPAN::META->has_inst($yaml_module)) {
2174 $ext_map->{yml} = 'CPAN';
2177 if ($CPAN::META->has_inst("Data::Dumper")) {
2178 push @fallbacks, $ext_map->{dd} = 'Data::Dumper';
2180 if ($CPAN::META->has_inst("Storable")) {
2181 push @fallbacks, $ext_map->{st} = 'Storable';
2185 unless ($self->{have_complained_about_missing_yaml}++) {
2186 $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back ".
2187 "to @fallbacks to read prefs '$prefs_dir'\n");
2190 unless ($self->{have_complained_about_missing_yaml}++) {
2191 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot ".
2192 "read prefs '$prefs_dir'\n");
2196 my $finder = CPAN::Distroprefs->find($prefs_dir, $ext_map);
2197 DIRENT: while (my $result = $finder->next) {
2198 if ($result->is_warning) {
2199 $CPAN::Frontend->mywarn($result->as_string);
2200 $CPAN::Frontend->mysleep(1);
2202 } elsif ($result->is_fatal) {
2203 $CPAN::Frontend->mydie($result->as_string);
2206 my @prefs = @{ $result->prefs };
2208 ELEMENT: for my $y (0..$#prefs) {
2209 my $pref = $prefs[$y];
2210 $self->_validate_distropref($pref->data, $result->abs, $y);
2212 # I don't know why we silently skip when there's no match, but
2213 # complain if there's an empty match hashref, and there's no
2214 # comment explaining why -- hdp, 2008-03-18
2215 unless ($pref->has_any_match) {
2219 unless ($pref->has_valid_subkeys) {
2220 $CPAN::Frontend->mydie(sprintf
2221 "Nonconforming .%s file '%s': " .
2222 "missing match/* subattribute. " .
2223 "Please remove, cannot continue.",
2224 $result->ext, $result->abs,
2230 distribution => $distroid,
2231 perl => \&CPAN::find_perl,
2232 perlconfig => \%Config::Config,
2233 module => sub { [ $self->containsmods ] },
2236 if ($pref->matches($arg)) {
2238 prefs => $pref->data,
2239 prefs_file => $result->abs,
2240 prefs_file_doc => $y,
2249 # CPAN::Distribution::prefs
2252 if (exists $self->{negative_prefs_cache}
2254 $self->{negative_prefs_cache} != $CPAN::CurrentCommandId
2256 delete $self->{negative_prefs_cache};
2257 delete $self->{prefs};
2259 if (exists $self->{prefs}) {
2260 return $self->{prefs}; # XXX comment out during debugging
2262 if ($CPAN::Config->{prefs_dir}) {
2263 CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG;
2264 my $prefs = $self->_find_prefs();
2265 $prefs ||= ""; # avoid warning next line
2266 CPAN->debug("prefs[$prefs]") if $CPAN::DEBUG;
2268 for my $x (qw(prefs prefs_file prefs_file_doc)) {
2269 $self->{$x} = $prefs->{$x};
2273 File::Basename::basename($self->{prefs_file}),
2274 $self->{prefs_file_doc},
2276 my $filler1 = "_" x 22;
2277 my $filler2 = int(66 - length($bs))/2;
2278 $filler2 = 0 if $filler2 < 0;
2279 $filler2 = " " x $filler2;
2280 $CPAN::Frontend->myprint("
2281 $filler1 D i s t r o P r e f s $filler1
2282 $filler2 $bs $filler2
2284 $CPAN::Frontend->mysleep(1);
2285 return $self->{prefs};
2288 $self->{negative_prefs_cache} = $CPAN::CurrentCommandId;
2289 return $self->{prefs} = +{};
2292 # CPAN::Distribution::_make_phase_arg
2293 sub _make_phase_arg {
2294 my($self, $phase) = @_;
2295 my $_make_phase_arg;
2296 my $prefs = $self->prefs;
2299 && exists $prefs->{$phase}
2300 && exists $prefs->{$phase}{args}
2301 && $prefs->{$phase}{args}
2303 $_make_phase_arg = join(" ",
2304 map {CPAN::HandleConfig
2305 ->safe_quote($_)} @{$prefs->{$phase}{args}},
2309 # cpan[2]> o conf make[TAB]
2310 # make make_install_make_command
2311 # make_arg makepl_arg
2313 # cpan[2]> o conf mbuild[TAB]
2314 # mbuild_arg mbuild_install_build_command
2315 # mbuild_install_arg mbuildpl_arg
2317 my $mantra; # must switch make/mbuild here
2318 if ($self->{modulebuild}) {
2326 test => "_test_arg", # does not really exist but maybe
2327 # will some day and now protects
2328 # us from unini warnings
2329 install => "_install_arg",
2331 my $phase_underscore_meshup = $map{$phase};
2332 my $what = sprintf "%s%s", $mantra, $phase_underscore_meshup;
2334 $_make_phase_arg ||= $CPAN::Config->{$what};
2335 return $_make_phase_arg;
2338 # CPAN::Distribution::_make_command
2345 CPAN::HandleConfig->prefs_lookup($self,
2347 || $Config::Config{make}
2351 # Old style call, without object. Deprecated
2352 Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
2355 CPAN::HandleConfig->prefs_lookup($self,q{make})
2356 || $CPAN::Config->{make}
2357 || $Config::Config{make}
2362 #-> sub CPAN::Distribution::follow_prereqs ;
2363 sub follow_prereqs {
2366 my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_;
2367 return unless @prereq_tuples;
2368 my(@good_prereq_tuples);
2369 for my $p (@prereq_tuples) {
2370 # XXX watch out for foul ones
2371 push @good_prereq_tuples, $p;
2373 my $pretty_id = $self->pretty_id;
2375 b => "build_requires",
2379 my($filler1,$filler2,$filler3,$filler4);
2380 my $unsat = "Unsatisfied dependencies detected during";
2381 my $w = length($unsat) > length($pretty_id) ? length($unsat) : length($pretty_id);
2383 my $r = int(($w - length($unsat))/2);
2384 my $l = $w - length($unsat) - $r;
2385 $filler1 = "-"x4 . " "x$l;
2386 $filler2 = " "x$r . "-"x4 . "\n";
2389 my $r = int(($w - length($pretty_id))/2);
2390 my $l = $w - length($pretty_id) - $r;
2391 $filler3 = "-"x4 . " "x$l;
2392 $filler4 = " "x$r . "-"x4 . "\n";
2395 myprint("$filler1 $unsat $filler2".
2396 "$filler3 $pretty_id $filler4".
2397 join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @good_prereq_tuples),
2400 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
2402 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
2403 my $answer = CPAN::Shell::colorable_makemaker_prompt(
2404 "Shall I follow them and prepend them to the queue
2405 of modules we are processing right now?", "yes");
2406 $follow = $answer =~ /^\s*y/i;
2408 my @prereq = map { $_=>[0] } @good_prereq_tuples;
2411 myprint(" Ignoring dependencies on modules @prereq\n");
2415 # color them as dirty
2416 for my $gp (@good_prereq_tuples) {
2417 # warn "calling color_cmd_tmps(0,1)";
2419 my $any = CPAN::Shell->expandany($p);
2420 $self->{$slot . "_for"}{$any->id}++;
2422 $any->color_cmd_tmps(0,2);
2424 $CPAN::Frontend->mywarn("Warning (maybe a bug): Cannot expand prereq '$p'\n");
2425 $CPAN::Frontend->mysleep(2);
2428 # queue them and re-queue yourself
2429 CPAN::Queue->jumpqueue({qmod => $id, reqtype => $self->{reqtype}},
2430 map {+{qmod=>$_->[0],reqtype=>$_->[1]}} reverse @good_prereq_tuples);
2431 $self->{$slot} = "Delayed until after prerequisites";
2432 return 1; # signal success to the queuerunner
2437 sub _feature_depends {
2439 my $meta_yml = $self->parse_meta_yml();
2440 my $optf = $meta_yml->{optional_features} or return;
2441 if (!ref $optf or ref $optf ne "HASH"){
2442 $CPAN::Frontend->mywarn("The content of optional_features is not a HASH reference. Cannot use it.\n");
2445 my $wantf = $self->prefs->{features} or return;
2446 if (!ref $wantf or ref $wantf ne "ARRAY"){
2447 $CPAN::Frontend->mywarn("The content of 'features' is not an ARRAY reference. Cannot use it.\n");
2451 for my $wf (@$wantf) {
2452 if (my $f = $optf->{$wf}) {
2453 $CPAN::Frontend->myprint("Found the demanded feature '$wf' that ".
2454 "is accompanied by this description:\n".
2458 # configure_requires currently not in the spec, unlikely to be useful anyway
2459 for my $reqtype (qw(configure_requires build_requires requires)) {
2460 my $reqhash = $f->{$reqtype} or next;
2461 while (my($k,$v) = each %$reqhash) {
2462 $dep->{$reqtype}{$k} = $v;
2466 $CPAN::Frontend->mywarn("The demanded feature '$wf' was not ".
2467 "found in the META.yml file".
2475 #-> sub CPAN::Distribution::unsat_prereq ;
2476 # return ([Foo,"r"],[Bar,"b"]) for normal modules
2477 # return ([perl=>5.008]) if we need a newer perl than we are running under
2478 # (sorry for the inconsistency, it was an accident)
2480 my($self,$slot) = @_;
2481 my(%merged,$prereq_pm);
2482 my $prefs_depends = $self->prefs->{depends}||{};
2483 my $feature_depends = $self->_feature_depends();
2484 if ($slot eq "configure_requires_later") {
2485 my $meta_yml = $self->parse_meta_yml();
2486 if (defined $meta_yml && (! ref $meta_yml || ref $meta_yml ne "HASH")) {
2487 $CPAN::Frontend->mywarn("The content of META.yml is defined but not a HASH reference. Cannot use it.\n");
2491 %{$meta_yml->{configure_requires}||{}},
2492 %{$prefs_depends->{configure_requires}||{}},
2493 %{$feature_depends->{configure_requires}||{}},
2495 $prereq_pm = {}; # configure_requires defined as "b"
2496 } elsif ($slot eq "later") {
2497 my $prereq_pm_0 = $self->prereq_pm || {};
2498 for my $reqtype (qw(requires build_requires)) {
2499 $prereq_pm->{$reqtype} = {%{$prereq_pm_0->{$reqtype}||{}}}; # copy to not pollute it
2500 for my $dep ($prefs_depends,$feature_depends) {
2501 for my $k (keys %{$dep->{$reqtype}||{}}) {
2502 $prereq_pm->{$reqtype}{$k} = $dep->{$reqtype}{$k};
2506 %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
2508 die "Panic: illegal slot '$slot'";
2511 my @merged = %merged;
2512 CPAN->debug("all merged_prereqs[@merged]") if $CPAN::DEBUG;
2513 NEED: while (my($need_module, $need_version) = each %merged) {
2514 my($available_version,$available_file,$nmo);
2515 if ($need_module eq "perl") {
2516 $available_version = $];
2517 $available_file = CPAN::find_perl();
2519 if (CPAN::_sqlite_running()) {
2520 CPAN::Index->reload;
2521 $CPAN::SQLite->search("CPAN::Module",$need_module);
2523 $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
2524 next if $nmo->uptodate;
2525 $available_file = $nmo->available_file;
2527 # if they have not specified a version, we accept any installed one
2528 if (defined $available_file
2529 and ( # a few quick shortcurcuits
2530 not defined $need_version
2531 or $need_version eq '0' # "==" would trigger warning when not numeric
2532 or $need_version eq "undef"
2537 $available_version = $nmo->available_version;
2540 # We only want to install prereqs if either they're not installed
2541 # or if the installed version is too old. We cannot omit this
2542 # check, because if 'force' is in effect, nobody else will check.
2543 if (defined $available_file) {
2544 my $fulfills_all_version_rqs = $self->_fulfills_all_version_rqs
2545 ($need_module,$available_file,$available_version,$need_version);
2546 next NEED if $fulfills_all_version_rqs;
2549 if ($need_module eq "perl") {
2550 return ["perl", $need_version];
2552 $self->{sponsored_mods}{$need_module} ||= 0;
2553 CPAN->debug("need_module[$need_module]s/s/n[$self->{sponsored_mods}{$need_module}]") if $CPAN::DEBUG;
2554 if (my $sponsoring = $self->{sponsored_mods}{$need_module}++) {
2555 # We have already sponsored it and for some reason it's still
2556 # not available. So we do ... what??
2558 # if we push it again, we have a potential infinite loop
2560 # The following "next" was a very problematic construct.
2561 # It helped a lot but broke some day and had to be
2564 # We must be able to deal with modules that come again and
2565 # again as a prereq and have themselves prereqs and the
2566 # queue becomes long but finally we would find the correct
2567 # order. The RecursiveDependency check should trigger a
2568 # die when it's becoming too weird. Unfortunately removing
2569 # this next breaks many other things.
2571 # The bug that brought this up is described in Todo under
2572 # "5.8.9 cannot install Compress::Zlib"
2574 # next; # this is the next that had to go away
2576 # The following "next NEED" are fine and the error message
2577 # explains well what is going on. For example when the DBI
2578 # fails and consequently DBD::SQLite fails and now we are
2579 # processing CPAN::SQLite. Then we must have a "next" for
2580 # DBD::SQLite. How can we get it and how can we identify
2581 # all other cases we must identify?
2583 my $do = $nmo->distribution;
2584 next NEED unless $do; # not on CPAN
2585 if (CPAN::Version->vcmp($need_version, $nmo->ro->{CPAN_VERSION}) > 0){
2586 $CPAN::Frontend->mywarn("Warning: Prerequisite ".
2587 "'$need_module => $need_version' ".
2588 "for '$self->{ID}' seems ".
2589 "not available according to the indices\n"
2593 NOSAYER: for my $nosayer (
2602 if ($do->{$nosayer}) {
2603 my $selfid = $self->pretty_id;
2604 my $did = $do->pretty_id;
2605 if (UNIVERSAL::can($do->{$nosayer},"failed") ?
2606 $do->{$nosayer}->failed :
2607 $do->{$nosayer} =~ /^NO/) {
2608 if ($nosayer eq "make_test"
2610 $do->{make_test}{COMMANDID} != $CPAN::CurrentCommandId
2614 $CPAN::Frontend->mywarn("Warning: Prerequisite ".
2615 "'$need_module => $need_version' ".
2616 "for '$selfid' failed when ".
2617 "processing '$did' with ".
2618 "'$nosayer => $do->{$nosayer}'. Continuing, ".
2619 "but chances to succeed are limited.\n"
2621 $CPAN::Frontend->mysleep($sponsoring/10);
2623 } else { # the other guy succeeded
2624 if ($nosayer =~ /^(install|make_test)$/) {
2626 # DMAKI/DateTime-Calendar-Chinese-0.05.tar.gz
2627 # in 2007-03 for 'make install'
2628 # and 2008-04: #30464 (for 'make test')
2629 $CPAN::Frontend->mywarn("Warning: Prerequisite ".
2630 "'$need_module => $need_version' ".
2631 "for '$selfid' already built ".
2632 "but the result looks suspicious. ".
2633 "Skipping another build attempt, ".
2634 "to prevent looping endlessly.\n"
2642 my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
2643 push @need, [$need_module,$needed_as];
2645 my @unfolded = map { "[".join(",",@$_)."]" } @need;
2646 CPAN->debug("returning from unsat_prereq[@unfolded]") if $CPAN::DEBUG;
2650 sub _fulfills_all_version_rqs {
2651 my($self,$need_module,$available_file,$available_version,$need_version) = @_;
2652 my(@all_requirements) = split /\s*,\s*/, $need_version;
2655 RQ: for my $rq (@all_requirements) {
2656 if ($rq =~ s|>=\s*||) {
2657 } elsif ($rq =~ s|>\s*||) {
2659 if (CPAN::Version->vgt($available_version,$rq)) {
2663 } elsif ($rq =~ s|!=\s*||) {
2665 if (CPAN::Version->vcmp($available_version,$rq)) {
2671 } elsif ($rq =~ m|<=?\s*|) {
2673 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])\n");
2677 if (! CPAN::Version->vgt($rq, $available_version)) {
2680 CPAN->debug(sprintf("need_module[%s]available_file[%s]".
2681 "available_version[%s]rq[%s]ok[%d]",
2685 CPAN::Version->readable($rq),
2689 return $ok == @all_requirements;
2692 #-> sub CPAN::Distribution::read_yaml ;
2695 return $self->{yaml_content} if exists $self->{yaml_content};
2697 unless ($build_dir = $self->{build_dir}) {
2698 # maybe permission on build_dir was missing
2699 $CPAN::Frontend->mywarn("Warning: cannot determine META.yml without a build_dir.\n");
2702 # if MYMETA.yml exists, that takes precedence over META.yml
2703 my $meta = File::Spec->catfile($build_dir,"META.yml");
2704 my $mymeta = File::Spec->catfile($build_dir,"MYMETA.yml");
2705 my $yaml = -f $mymeta ? $mymeta : $meta;
2706 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
2707 return unless -f $yaml;
2708 eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml)->[0]; };
2710 $CPAN::Frontend->mywarn("Could not read ".
2711 "'$yaml'. Falling back to other ".
2712 "methods to determine prerequisites\n");
2713 return $self->{yaml_content} = undef; # if we die, then we
2714 # cannot read YAML's own
2717 # not "authoritative"
2718 for ($self->{yaml_content}) {
2719 if (defined $_ && (! ref $_ || ref $_ ne "HASH")) {
2720 $CPAN::Frontend->mywarn("META.yml does not seem to be conforming, cannot use it.\n");
2721 $self->{yaml_content} = +{};
2724 # MYMETA.yml is not dynamic by definition
2725 if ( $yaml ne $mymeta &&
2726 ( not exists $self->{yaml_content}{dynamic_config}
2727 or $self->{yaml_content}{dynamic_config}
2730 $self->{yaml_content} = undef;
2732 $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
2734 return $self->{yaml_content};
2737 #-> sub CPAN::Distribution::prereq_pm ;
2740 $self->{prereq_pm_detected} ||= 0;
2741 CPAN->debug("ID[$self->{ID}]prereq_pm_detected[$self->{prereq_pm_detected}]") if $CPAN::DEBUG;
2742 return $self->{prereq_pm} if $self->{prereq_pm_detected};
2743 return unless $self->{writemakefile} # no need to have succeeded
2744 # but we must have run it
2745 || $self->{modulebuild};
2746 unless ($self->{build_dir}) {
2749 CPAN->debug(sprintf "writemakefile[%s]modulebuild[%s]",
2750 $self->{writemakefile}||"",
2751 $self->{modulebuild}||"",
2754 if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
2755 $req = $yaml->{requires} || {};
2756 $breq = $yaml->{build_requires} || {};
2757 undef $req unless ref $req eq "HASH" && %$req;
2759 if ($yaml->{generated_by} &&
2760 $yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
2761 my $eummv = do { local $^W = 0; $1+0; };
2762 if ($eummv < 6.2501) {
2763 # thanks to Slaven for digging that out: MM before
2764 # that could be wrong because it could reflect a
2771 while (my($k,$v) = each %{$req||{}}) {
2774 } elsif ($k =~ /[A-Za-z]/ &&
2776 $CPAN::META->exists("CPAN::Module",$v)
2778 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
2779 "requires hash: $k => $v; I'll take both ".
2780 "key and value as a module name\n");
2781 $CPAN::Frontend->mysleep(1);
2787 $req = $areq if $do_replace;
2790 unless ($req || $breq) {
2792 unless ( $build_dir = $self->{build_dir} ) {
2795 my $makefile = File::Spec->catfile($build_dir,"Makefile");
2799 $fh = FileHandle->new("<$makefile\0")) {
2800 CPAN->debug("Getting prereq from Makefile") if $CPAN::DEBUG;
2803 last if /MakeMaker post_initialize section/;
2805 \s+PREREQ_PM\s+=>\s+(.+)
2808 # warn "Found prereq expr[$p]";
2810 # Regexp modified by A.Speer to remember actual version of file
2811 # PREREQ_PM hash key wants, then add to
2812 while ( $p =~ m/(?:\s)([\w\:]+)=>(q\[.*?\]|undef),?/g ) {
2813 # In case a prereq is mentioned twice, complain.
2814 if ( defined $req->{$1} ) {
2815 warn "Warning: PREREQ_PM mentions $1 more than once, ".
2816 "last mention wins";
2818 my($m,$n) = ($1,$2);
2819 if ($n =~ /^q\[(.*?)\]$/) {
2828 unless ($req || $breq) {
2829 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
2830 my $buildfile = File::Spec->catfile($build_dir,"Build");
2831 if (-f $buildfile) {
2832 CPAN->debug("Found '$buildfile'") if $CPAN::DEBUG;
2833 my $build_prereqs = File::Spec->catfile($build_dir,"_build","prereqs");
2834 if (-f $build_prereqs) {
2835 CPAN->debug("Getting prerequisites from '$build_prereqs'") if $CPAN::DEBUG;
2836 my $content = do { local *FH;
2837 open FH, $build_prereqs
2838 or $CPAN::Frontend->mydie("Could not open ".
2839 "'$build_prereqs': $!");
2843 my $bphash = eval $content;
2846 $req = $bphash->{requires} || +{};
2847 $breq = $bphash->{build_requires} || +{};
2853 && ! -f "Makefile.PL"
2854 && ! exists $req->{"Module::Build"}
2855 && ! $CPAN::META->has_inst("Module::Build")) {
2856 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
2857 "undeclared prerequisite.\n".
2858 " Adding it now as such.\n"
2860 $CPAN::Frontend->mysleep(5);
2861 $req->{"Module::Build"} = 0;
2862 delete $self->{writemakefile};
2864 if ($req || $breq) {
2865 $self->{prereq_pm_detected}++;
2866 return $self->{prereq_pm} = { requires => $req, build_requires => $breq };
2870 #-> sub CPAN::Distribution::test ;
2873 if (my $goto = $self->prefs->{goto}) {
2874 return $self->goto($goto);
2877 return if $self->prefs->{disabled} && ! $self->{force_update};
2878 if ($CPAN::Signal) {
2879 delete $self->{force_update};
2882 # warn "XDEBUG: checking for notest: $self->{notest} $self";
2883 if ($self->{notest}) {
2884 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
2888 my $make = $self->{modulebuild} ? "Build" : "make";
2890 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
2892 : ($ENV{PERLLIB} || "");
2894 local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
2895 $CPAN::META->set_perl5lib;
2896 local $ENV{MAKEFLAGS}; # protect us from outer make calls
2898 $CPAN::Frontend->myprint("Running $make test\n");
2902 if ($self->{make} or $self->{later}) {
2906 "Make had some problems, won't test";
2909 exists $self->{make} and
2911 UNIVERSAL::can($self->{make},"failed") ?
2912 $self->{make}->failed :
2913 $self->{make} =~ /^NO/
2914 ) and push @e, "Can't test without successful make";
2915 $self->{badtestcnt} ||= 0;
2916 if ($self->{badtestcnt} > 0) {
2917 require Data::Dumper;
2918 CPAN->debug(sprintf "NOREPEAT[%s]", Data::Dumper::Dumper($self)) if $CPAN::DEBUG;
2919 push @e, "Won't repeat unsuccessful test during this command";
2922 push @e, $self->{later} if $self->{later};
2923 push @e, $self->{configure_requires_later} if $self->{configure_requires_later};
2925 if (exists $self->{build_dir}) {
2926 if (exists $self->{make_test}) {
2928 UNIVERSAL::can($self->{make_test},"failed") ?
2929 $self->{make_test}->failed :
2930 $self->{make_test} =~ /^NO/
2933 UNIVERSAL::can($self->{make_test},"commandid")
2935 $self->{make_test}->commandid == $CPAN::CurrentCommandId
2937 push @e, "Has already been tested within this command";
2940 push @e, "Has already been tested successfully";
2941 # if global "is_tested" has been cleared, we need to mark this to
2942 # be added to PERL5LIB if not already installed
2943 if ($self->tested_ok_but_not_installed) {
2944 $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
2949 push @e, "Has no own directory";
2951 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
2952 unless (chdir $self->{build_dir}) {
2953 push @e, "Couldn't chdir to '$self->{build_dir}': $!";
2955 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
2957 $self->debug("Changed directory to $self->{build_dir}")
2960 if ($^O eq 'MacOS') {
2961 Mac::BuildTools::make_test($self);
2965 if ($self->{modulebuild}) {
2966 my $thm = CPAN::Shell->expand("Module","Test::Harness");
2967 my $v = $thm->inst_version;
2968 if (CPAN::Version->vlt($v,2.62)) {
2969 # XXX Eric Wilhelm reported this as a bug: klapperl:
2970 # Test::Harness 3.0 self-tests, so that should be 'unless
2971 # installing Test::Harness'
2972 unless ($self->id eq $thm->distribution->id) {
2973 $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only
2974 '$v', you need at least '2.62'. Please upgrade your Test::Harness.\n});
2975 $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old");
2981 if ( ! $self->{force_update} ) {
2982 # bypass actual tests if "trust_test_report_history" and have a report
2983 my $have_tested_fcn;
2984 if ( $CPAN::Config->{trust_test_report_history}
2985 && $CPAN::META->has_inst("CPAN::Reporter::History")
2986 && ( $have_tested_fcn = CPAN::Reporter::History->can("have_tested" ))) {
2987 if ( my @reports = $have_tested_fcn->( dist => $self->base_id ) ) {
2988 # Do nothing if grade was DISCARD
2989 if ( $reports[-1]->{grade} =~ /^(?:PASS|UNKNOWN)$/ ) {
2990 $self->{make_test} = CPAN::Distrostatus->new("YES");
2991 # if global "is_tested" has been cleared, we need to mark this to
2992 # be added to PERL5LIB if not already installed
2993 if ($self->tested_ok_but_not_installed) {
2994 $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
2996 $CPAN::Frontend->myprint("Found prior test report -- OK\n");
2999 elsif ( $reports[-1]->{grade} =~ /^(?:FAIL|NA)$/ ) {
3000 $self->{make_test} = CPAN::Distrostatus->new("NO");
3001 $self->{badtestcnt}++;
3002 $CPAN::Frontend->mywarn("Found prior test report -- NOT OK\n");
3010 my $prefs_test = $self->prefs->{test};
3012 = exists $prefs_test->{commandline} ? $prefs_test->{commandline} : "") {
3013 $system = $commandline;
3014 $ENV{PERL} = CPAN::find_perl();
3015 } elsif ($self->{modulebuild}) {
3016 $system = sprintf "%s test", $self->_build_command();
3017 unless (-e "Build") {
3018 my $id = $self->pretty_id;
3019 $CPAN::Frontend->mywarn("Alert: no 'Build' file found while trying to test '$id'");
3022 $system = join " ", $self->_make_command(), "test";
3024 my $make_test_arg = $self->_make_phase_arg("test");
3025 $system = sprintf("%s%s",
3027 $make_test_arg ? " $make_test_arg" : "",
3031 while (my($k,$v) = each %ENV) {
3032 next unless defined $v;
3037 if ($self->prefs->{test}) {
3038 $test_env = $self->prefs->{test}{env};
3041 for my $e (keys %$test_env) {
3042 $ENV{$e} = $test_env->{$e};
3045 my $expect_model = $self->_prefs_with_expect("test");
3046 my $want_expect = 0;
3047 if ( $expect_model && @{$expect_model->{talk}} ) {
3048 my $can_expect = $CPAN::META->has_inst("Expect");
3052 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
3053 "testing without\n");
3057 if ($self->_should_report('test')) {
3058 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is currently ".
3059 "not supported when distroprefs specify ".
3060 "an interactive test\n");
3062 $tests_ok = $self->_run_via_expect($system,'test',$expect_model) == 0;
3063 } elsif ( $self->_should_report('test') ) {
3064 $tests_ok = CPAN::Reporter::test($self, $system);
3066 $tests_ok = system($system) == 0;
3068 $self->introduce_myself;
3073 # local $CPAN::DEBUG = 16; # Distribution
3074 for my $m (keys %{$self->{sponsored_mods}}) {
3075 next unless $self->{sponsored_mods}{$m} > 0;
3076 my $m_obj = CPAN::Shell->expand("Module",$m) or next;
3077 # XXX we need available_version which reflects
3078 # $ENV{PERL5LIB} so that already tested but not yet
3079 # installed modules are counted.
3080 my $available_version = $m_obj->available_version;
3081 my $available_file = $m_obj->available_file;
3082 if ($available_version &&
3083 !CPAN::Version->vlt($available_version,$self->{prereq_pm}{$m})
3085 CPAN->debug("m[$m] good enough available_version[$available_version]")
3087 } elsif ($available_file
3089 !$self->{prereq_pm}{$m}
3091 $self->{prereq_pm}{$m} == 0
3094 # lex Class::Accessor::Chained::Fast which has no $VERSION
3095 CPAN->debug("m[$m] have available_file[$available_file]")
3103 my $which = join ",", @prereq;
3104 my $but = $cnt == 1 ? "one dependency not OK ($which)" :
3105 "$cnt dependencies missing ($which)";
3106 $CPAN::Frontend->mywarn("Tests succeeded but $but\n");
3107 $self->{make_test} = CPAN::Distrostatus->new("NO $but");
3108 $self->store_persistent_state;
3109 return $self->goodbye("[dependencies] -- NA");
3113 $CPAN::Frontend->myprint(" $system -- OK\n");
3114 $self->{make_test} = CPAN::Distrostatus->new("YES");
3115 $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
3116 # probably impossible to need the next line because badtestcnt
3117 # has a lifespan of one command
3118 delete $self->{badtestcnt};
3120 $self->{make_test} = CPAN::Distrostatus->new("NO");
3121 $self->{badtestcnt}++;
3122 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
3123 CPAN::Shell->optprint
3126 ("//hint// to see the cpan-testers results for installing this module, try:
3130 $self->store_persistent_state;
3133 sub _prefs_with_expect {
3134 my($self,$where) = @_;
3135 return unless my $prefs = $self->prefs;
3136 return unless my $where_prefs = $prefs->{$where};
3137 if ($where_prefs->{expect}) {
3139 mode => "deterministic",
3141 talk => $where_prefs->{expect},
3143 } elsif ($where_prefs->{"eexpect"}) {
3144 return $where_prefs->{"eexpect"};
3149 #-> sub CPAN::Distribution::clean ;
3152 my $make = $self->{modulebuild} ? "Build" : "make";
3153 $CPAN::Frontend->myprint("Running $make clean\n");
3154 unless (exists $self->{archived}) {
3155 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
3156 "/untarred, nothing done\n");
3159 unless (exists $self->{build_dir}) {
3160 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
3163 if (exists $self->{writemakefile}
3164 and $self->{writemakefile}->failed
3166 $CPAN::Frontend->mywarn("No Makefile, don't know how to 'make clean'\n");
3171 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
3172 push @e, "make clean already called once";
3173 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3175 chdir $self->{build_dir} or
3176 Carp::confess("Couldn't chdir to $self->{build_dir}: $!");
3177 $self->debug("Changed directory to $self->{build_dir}") if $CPAN::DEBUG;
3179 if ($^O eq 'MacOS') {
3180 Mac::BuildTools::make_clean($self);
3185 if ($self->{modulebuild}) {
3186 unless (-f "Build") {
3187 my $cwd = CPAN::anycwd();
3188 $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}".
3189 " in cwd[$cwd]. Danger, Will Robinson!");
3190 $CPAN::Frontend->mysleep(5);
3192 $system = sprintf "%s clean", $self->_build_command();
3194 $system = join " ", $self->_make_command(), "clean";
3196 my $system_ok = system($system) == 0;
3197 $self->introduce_myself;
3199 $CPAN::Frontend->myprint(" $system -- OK\n");
3203 # Jost Krieger pointed out that this "force" was wrong because
3204 # it has the effect that the next "install" on this distribution
3205 # will untar everything again. Instead we should bring the
3206 # object's state back to where it is after untarring.
3217 $self->{make_clean} = CPAN::Distrostatus->new("YES");
3220 # Hmmm, what to do if make clean failed?
3222 $self->{make_clean} = CPAN::Distrostatus->new("NO");
3223 $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n});
3225 # 2006-02-27: seems silly to me to force a make now
3226 # $self->force("make"); # so that this directory won't be used again
3229 $self->store_persistent_state;
3232 #-> sub CPAN::Distribution::goto ;
3234 my($self,$goto) = @_;
3235 $goto = $self->normalize($goto);
3237 "Goto '$goto' via prefs file '%s' doc %d",
3238 $self->{prefs_file},
3239 $self->{prefs_file_doc},
3241 $self->{unwrapped} = CPAN::Distrostatus->new("NO $why");
3242 # 2007-07-16 akoenig : Better than NA would be if we could inherit
3243 # the status of the $goto distro but given the exceptional nature
3244 # of 'goto' I feel reluctant to implement it
3245 my $goodbye_message = "[goto] -- NA $why";
3246 $self->goodbye($goodbye_message);
3248 # inject into the queue
3250 CPAN::Queue->delete($self->id);
3251 CPAN::Queue->jumpqueue({qmod => $goto, reqtype => $self->{reqtype}});
3253 # and run where we left off
3255 my($method) = (caller(1))[3];
3256 CPAN->instance("CPAN::Distribution",$goto)->$method();
3257 CPAN::Queue->delete_first($goto);
3260 #-> sub CPAN::Distribution::install ;
3263 if (my $goto = $self->prefs->{goto}) {
3264 return $self->goto($goto);
3266 unless ($self->{badtestcnt}) {
3269 if ($CPAN::Signal) {
3270 delete $self->{force_update};
3273 my $make = $self->{modulebuild} ? "Build" : "make";
3274 $CPAN::Frontend->myprint("Running $make install\n");
3277 if ($self->{make} or $self->{later}) {
3281 "Make had some problems, won't install";
3284 exists $self->{make} and
3286 UNIVERSAL::can($self->{make},"failed") ?
3287 $self->{make}->failed :
3288 $self->{make} =~ /^NO/
3290 push @e, "Make had returned bad status, install seems impossible";
3292 if (exists $self->{build_dir}) {
3294 push @e, "Has no own directory";
3297 if (exists $self->{make_test} and
3299 UNIVERSAL::can($self->{make_test},"failed") ?
3300 $self->{make_test}->failed :
3301 $self->{make_test} =~ /^NO/
3303 if ($self->{force_update}) {
3304 $self->{make_test}->text("FAILED but failure ignored because ".
3305 "'force' in effect");
3307 push @e, "make test had returned bad status, ".
3308 "won't install without force"
3311 if (exists $self->{install}) {
3312 if (UNIVERSAL::can($self->{install},"text") ?
3313 $self->{install}->text eq "YES" :
3314 $self->{install} =~ /^YES/
3316 $CPAN::Frontend->myprint(" Already done\n");
3317 $CPAN::META->is_installed($self->{build_dir});
3320 # comment in Todo on 2006-02-11; maybe retry?
3321 push @e, "Already tried without success";
3325 push @e, $self->{later} if $self->{later};
3326 push @e, $self->{configure_requires_later} if $self->{configure_requires_later};
3328 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3329 unless (chdir $self->{build_dir}) {
3330 push @e, "Couldn't chdir to '$self->{build_dir}': $!";
3332 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
3334 $self->debug("Changed directory to $self->{build_dir}")
3337 if ($^O eq 'MacOS') {
3338 Mac::BuildTools::make_install($self);
3343 if (my $commandline = $self->prefs->{install}{commandline}) {
3344 $system = $commandline;
3345 $ENV{PERL} = CPAN::find_perl();
3346 } elsif ($self->{modulebuild}) {
3347 my($mbuild_install_build_command) =
3348 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
3349 $CPAN::Config->{mbuild_install_build_command} ?
3350 $CPAN::Config->{mbuild_install_build_command} :
3351 $self->_build_command();
3352 $system = sprintf("%s install %s",
3353 $mbuild_install_build_command,
3354 $CPAN::Config->{mbuild_install_arg},
3357 my($make_install_make_command) =
3358 CPAN::HandleConfig->prefs_lookup($self,
3359 q{make_install_make_command})
3360 || $self->_make_command();
3361 $system = sprintf("%s install %s",
3362 $make_install_make_command,
3363 $CPAN::Config->{make_install_arg},
3367 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
3368 my $brip = CPAN::HandleConfig->prefs_lookup($self,
3369 q{build_requires_install_policy});
3372 my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command
3373 my $want_install = "yes";
3374 if ($reqtype eq "b") {
3375 if ($brip eq "no") {
3376 $want_install = "no";
3377 } elsif ($brip =~ m|^ask/(.+)|) {
3379 $default = "yes" unless $default =~ /^(y|n)/i;
3381 CPAN::Shell::colorable_makemaker_prompt
3382 ("$id is just needed temporarily during building or testing. ".
3383 "Do you want to install it permanently?",
3387 unless ($want_install =~ /^y/i) {
3388 my $is_only = "is only 'build_requires'";
3389 $CPAN::Frontend->mywarn("Not installing because $is_only\n");
3390 $self->{install} = CPAN::Distrostatus->new("NO -- $is_only");
3391 delete $self->{force_update};
3394 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
3396 : ($ENV{PERLLIB} || "");
3398 local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
3399 $CPAN::META->set_perl5lib;
3400 my($pipe) = FileHandle->new("$system $stderr |") || Carp::croak
3401 ("Can't execute $system: $!");
3404 print $_; # intentionally NOT use Frontend->myprint because it
3405 # looks irritating when we markup in color what we
3406 # just pass through from an external program
3410 my $close_ok = $? == 0;
3411 $self->introduce_myself;
3413 $CPAN::Frontend->myprint(" $system -- OK\n");
3414 $CPAN::META->is_installed($self->{build_dir});
3415 $self->{install} = CPAN::Distrostatus->new("YES");
3417 $self->{install} = CPAN::Distrostatus->new("NO");
3418 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
3420 CPAN::HandleConfig->prefs_lookup($self,
3421 q{make_install_make_command});
3423 $makeout =~ /permission/s
3427 || $mimc eq (CPAN::HandleConfig->prefs_lookup($self,
3431 $CPAN::Frontend->myprint(
3433 qq{ You may have to su }.
3434 qq{to root to install the package\n}.
3435 qq{ (Or you may want to run something like\n}.
3436 qq{ o conf make_install_make_command 'sudo make'\n}.
3437 qq{ to raise your permissions.}
3441 delete $self->{force_update};
3442 $self->store_persistent_state;
3445 sub introduce_myself {
3447 $CPAN::Frontend->myprint(sprintf(" %s\n",$self->pretty_id));
3450 #-> sub CPAN::Distribution::dir ;
3455 #-> sub CPAN::Distribution::perldoc ;
3459 my($dist) = $self->id;
3460 my $package = $self->called_for;
3462 if ($CPAN::META->has_inst("Pod::Perldocs")) {
3463 my($perl) = $self->perl
3464 or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
3465 my @args = ($perl, q{-MPod::Perldocs}, q{-e},
3466 q{Pod::Perldocs->run()}, $package);
3468 unless ( ($wstatus = system(@args)) == 0 ) {
3469 my $estatus = $wstatus >> 8;
3470 $CPAN::Frontend->myprint(qq{
3471 Function system("@args")
3472 returned status $estatus (wstat $wstatus)
3477 $self->_display_url( $CPAN::Defaultdocs . $package );
3481 #-> sub CPAN::Distribution::_check_binary ;
3483 my ($dist,$shell,$binary) = @_;
3486 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
3489 if ($CPAN::META->has_inst("File::Which")) {
3490 return File::Which::which($binary);
3493 $pid = open README, "which $binary|"
3494 or $CPAN::Frontend->mywarn(qq{Could not fork 'which $binary': $!\n});
3500 or $CPAN::Frontend->mywarn("Could not run 'which $binary': $!\n")
3504 $CPAN::Frontend->myprint(qq{ + $out \n})
3505 if $CPAN::DEBUG && $out;
3510 #-> sub CPAN::Distribution::_display_url ;
3512 my($self,$url) = @_;
3513 my($res,$saved_file,$pid,$out);
3515 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
3518 # should we define it in the config instead?
3519 my $html_converter = "html2text.pl";
3521 my $web_browser = $CPAN::Config->{'lynx'} || undef;
3522 my $web_browser_out = $web_browser
3523 ? CPAN::Distribution->_check_binary($self,$web_browser)
3526 if ($web_browser_out) {
3527 # web browser found, run the action
3528 my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
3529 $CPAN::Frontend->myprint(qq{system[$browser $url]})
3531 $CPAN::Frontend->myprint(qq{
3534 with browser $browser
3536 $CPAN::Frontend->mysleep(1);
3537 system("$browser $url");
3538 if ($saved_file) { 1 while unlink($saved_file) }
3540 # web browser not found, let's try text only
3541 my $html_converter_out =
3542 CPAN::Distribution->_check_binary($self,$html_converter);
3543 $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
3545 if ($html_converter_out ) {
3546 # html2text found, run it
3547 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
3548 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
3549 unless defined($saved_file);
3552 $pid = open README, "$html_converter $saved_file |"
3553 or $CPAN::Frontend->mydie(qq{
3554 Could not fork '$html_converter $saved_file': $!});
3556 if ($CPAN::META->has_usable("File::Temp")) {
3557 $fh = File::Temp->new(
3558 dir => File::Spec->tmpdir,
3559 template => 'cpan_htmlconvert_XXXX',
3563 $filename = $fh->filename;
3565 $filename = "cpan_htmlconvert_$$.txt";
3566 $fh = FileHandle->new();
3567 open $fh, ">$filename" or die;
3573 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
3574 my $tmpin = $fh->filename;
3575 $CPAN::Frontend->myprint(sprintf(qq{
3577 saved output to %s\n},
3585 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
3586 my $fh_pager = FileHandle->new;
3587 local($SIG{PIPE}) = "IGNORE";
3588 my $pager = $CPAN::Config->{'pager'} || "cat";
3589 $fh_pager->open("|$pager")
3590 or $CPAN::Frontend->mydie(qq{
3591 Could not open pager '$pager': $!});
3592 $CPAN::Frontend->myprint(qq{
3597 $CPAN::Frontend->mysleep(1);
3598 $fh_pager->print(<FH>);
3601 # coldn't find the web browser or html converter
3602 $CPAN::Frontend->myprint(qq{
3603 You need to install lynx or $html_converter to use this feature.});
3608 #-> sub CPAN::Distribution::_getsave_url ;
3610 my($dist, $shell, $url) = @_;
3612 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
3616 if ($CPAN::META->has_usable("File::Temp")) {
3617 $fh = File::Temp->new(
3618 dir => File::Spec->tmpdir,
3619 template => "cpan_getsave_url_XXXX",
3623 $filename = $fh->filename;
3625 $fh = FileHandle->new;
3626 $filename = "cpan_getsave_url_$$.html";
3628 my $tmpin = $filename;
3629 if ($CPAN::META->has_usable('LWP')) {
3630 $CPAN::Frontend->myprint("Fetching with LWP:
3634 CPAN::LWP::UserAgent->config;
3635 eval { $Ua = CPAN::LWP::UserAgent->new; };
3637 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
3641 $Ua->proxy('http', $var)
3642 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
3644 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
3647 my $req = HTTP::Request->new(GET => $url);
3648 $req->header('Accept' => 'text/html');
3649 my $res = $Ua->request($req);
3650 if ($res->is_success) {
3651 $CPAN::Frontend->myprint(" + request successful.\n")
3653 print $fh $res->content;
3655 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
3659 $CPAN::Frontend->myprint(sprintf(
3660 "LWP failed with code[%s], message[%s]\n",
3667 $CPAN::Frontend->mywarn(" LWP not available\n");
3672 #-> sub CPAN::Distribution::_build_command
3673 sub _build_command {
3675 if ($^O eq "MSWin32") { # special code needed at least up to
3676 # Module::Build 0.2611 and 0.2706; a fix
3677 # in M:B has been promised 2006-01-30
3678 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
3679 return "$perl ./Build";
3684 #-> sub CPAN::Distribution::_should_report
3685 sub _should_report {
3686 my($self, $phase) = @_;
3687 die "_should_report() requires a 'phase' argument"
3688 if ! defined $phase;
3691 my $test_report = CPAN::HandleConfig->prefs_lookup($self,
3693 return unless $test_report;
3695 # don't repeat if we cached a result
3696 return $self->{should_report}
3697 if exists $self->{should_report};
3699 # don't report if we generated a Makefile.PL
3700 if ( $self->{had_no_makefile_pl} ) {
3701 $CPAN::Frontend->mywarn(
3702 "Will not send CPAN Testers report with generated Makefile.PL.\n"
3704 return $self->{should_report} = 0;
3708 if ( ! $CPAN::META->has_inst("CPAN::Reporter")) {
3709 $CPAN::Frontend->mywarn(
3710 "CPAN::Reporter not installed. No reports will be sent.\n"
3712 return $self->{should_report} = 0;
3716 my $crv = CPAN::Reporter->VERSION;
3717 if ( CPAN::Version->vlt( $crv, 0.99 ) ) {
3718 # don't cache $self->{should_report} -- need to check each phase
3719 if ( $phase eq 'test' ) {
3723 $CPAN::Frontend->mywarn(
3724 "Reporting on the '$phase' phase requires CPAN::Reporter 0.99, but \n" .
3725 "you only have version $crv\. Only 'test' phase reports will be sent.\n"
3732 if ($self->is_dot_dist) {
3733 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
3734 "for local directories\n");
3735 return $self->{should_report} = 0;
3737 if ($self->prefs->{patches}
3739 @{$self->prefs->{patches}}
3743 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
3744 "when the source has been patched\n");
3745 return $self->{should_report} = 0;
3748 # proceed and cache success
3749 return $self->{should_report} = 1;
3752 #-> sub CPAN::Distribution::reports
3755 my $pathname = $self->id;
3756 $CPAN::Frontend->myprint("Distribution: $pathname\n");
3758 unless ($CPAN::META->has_inst("CPAN::DistnameInfo")) {
3759 $CPAN::Frontend->mydie("CPAN::DistnameInfo not installed; cannot continue");
3761 unless ($CPAN::META->has_usable("LWP")) {
3762 $CPAN::Frontend->mydie("LWP not installed; cannot continue");
3764 unless ($CPAN::META->has_usable("File::Temp")) {
3765 $CPAN::Frontend->mydie("File::Temp not installed; cannot continue");
3768 my $d = CPAN::DistnameInfo->new($pathname);
3770 my $dist = $d->dist; # "CPAN-DistnameInfo"
3771 my $version = $d->version; # "0.02"
3772 my $maturity = $d->maturity; # "released"
3773 my $filename = $d->filename; # "CPAN-DistnameInfo-0.02.tar.gz"
3774 my $cpanid = $d->cpanid; # "GBARR"
3775 my $distvname = $d->distvname; # "CPAN-DistnameInfo-0.02"
3777 my $url = sprintf "http://www.cpantesters.org/show/%s.yaml", $dist;
3779 CPAN::LWP::UserAgent->config;
3781 eval { $Ua = CPAN::LWP::UserAgent->new; };
3783 $CPAN::Frontend->mydie("CPAN::LWP::UserAgent->new dies with $@\n");
3785 $CPAN::Frontend->myprint("Fetching '$url'...");
3786 my $resp = $Ua->get($url);
3787 unless ($resp->is_success) {
3788 $CPAN::Frontend->mydie(sprintf "Could not download '%s': %s\n", $url, $resp->code);
3790 $CPAN::Frontend->myprint("DONE\n\n");
3791 my $yaml = $resp->content;
3792 # was fuer ein Umweg!
3793 my $fh = File::Temp->new(
3794 dir => File::Spec->tmpdir,
3795 template => 'cpan_reports_XXXX',
3799 my $tfilename = $fh->filename;
3801 close $fh or $CPAN::Frontend->mydie("Could not close '$tfilename': $!");
3802 my $unserialized = CPAN->_yaml_loadfile($tfilename)->[0];
3803 unlink $tfilename or $CPAN::Frontend->mydie("Could not unlink '$tfilename': $!");
3805 my $this_version_seen;
3806 for my $rep (@$unserialized) {
3807 my $rversion = $rep->{version};
3808 if ($rversion eq $version) {
3809 unless ($this_version_seen++) {
3810 $CPAN::Frontend->myprint ("$rep->{version}:\n");
3812 $CPAN::Frontend->myprint
3813 (sprintf("%1s%1s%-4s %s on %s %s (%s)\n",
3814 $rep->{archname} eq $Config::Config{archname}?"*":"",
3815 $rep->{action}eq"PASS"?"+":$rep->{action}eq"FAIL"?"-":"",
3818 ucfirst $rep->{osname},
3823 $other_versions{$rep->{version}}++;
3826 unless ($this_version_seen) {
3827 $CPAN::Frontend->myprint("No reports found for version '$version'
3828 Reports for other versions:\n");
3829 for my $v (sort keys %other_versions) {
3830 $CPAN::Frontend->myprint(" $v\: $other_versions{$v}\n");
3833 $url =~ s/\.yaml/.html/;
3834 $CPAN::Frontend->myprint("See $url for details\n");