1# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- 2# vim: ts=4 sts=4 sw=4: 3package CPAN::Exception::RecursiveDependency; 4use strict; 5use overload '""' => "as_string"; 6 7use vars qw( 8 $VERSION 9); 10$VERSION = "5.5001"; 11 12{ 13 package CPAN::Exception::RecursiveDependency::na; 14 use overload '""' => "as_string"; 15 sub new { bless {}, shift }; 16 sub as_string { "N/A" }; 17} 18 19my $NA = CPAN::Exception::RecursiveDependency::na->new; 20 21# a module sees its distribution (no version) 22# a distribution sees its prereqs (which are module names) (usually with versions) 23# a bundle sees its module names and/or its distributions (no version) 24 25sub new { 26 my($class) = shift; 27 my($deps_arg) = shift; 28 my (@deps,%seen,$loop_starts_with); 29 DCHAIN: for my $dep (@$deps_arg) { 30 push @deps, {name => $dep, display_as => $dep}; 31 if ($seen{$dep}++) { 32 $loop_starts_with = $dep; 33 last DCHAIN; 34 } 35 } 36 my $in_loop = 0; 37 my %mark; 38 DWALK: for my $i (0..$#deps) { 39 my $x = $deps[$i]{name}; 40 $in_loop ||= $loop_starts_with && $x eq $loop_starts_with; 41 my $xo = CPAN::Shell->expandany($x) or next; 42 if ($xo->isa("CPAN::Module")) { 43 my $have = $xo->inst_version || $NA; 44 my($want,$d,$want_type); 45 if ($i>0 and $d = $deps[$i-1]{name}) { 46 my $do = CPAN::Shell->expandany($d); 47 $want = $do->{prereq_pm}{requires}{$x}; 48 if (defined $want) { 49 $want_type = "requires: "; 50 } else { 51 $want = $do->{prereq_pm}{build_requires}{$x}; 52 if (defined $want) { 53 $want_type = "build_requires: "; 54 } else { 55 $want_type = "unknown status"; 56 $want = "???"; 57 } 58 } 59 } else { 60 $want = $xo->cpan_version; 61 $want_type = "want: "; 62 } 63 $deps[$i]{have} = $have; 64 $deps[$i]{want_type} = $want_type; 65 $deps[$i]{want} = $want; 66 $deps[$i]{display_as} = "$x (have: $have; $want_type$want)"; 67 if ((! ref $have || !$have->isa('CPAN::Exception::RecursiveDependency::na')) 68 && CPAN::Version->vge($have, $want)) { 69 # https://rt.cpan.org/Ticket/Display.html?id=115340 70 undef $loop_starts_with; 71 last DWALK; 72 } 73 } elsif ($xo->isa("CPAN::Distribution")) { 74 my $pretty = $deps[$i]{display_as} = $xo->pretty_id; 75 my $mark_as; 76 if ($in_loop) { 77 $mark_as = CPAN::Distrostatus->new("NO cannot resolve circular dependency"); 78 } else { 79 $mark_as = CPAN::Distrostatus->new("NO one dependency ($loop_starts_with) is a circular dependency"); 80 } 81 $mark{$pretty} = { xo => $xo, mark_as => $mark_as }; 82 } 83 } 84 if ($loop_starts_with) { 85 while (my($k,$v) = each %mark) { 86 my $xo = $v->{xo}; 87 $xo->{make} = $v->{mark_as}; 88 $xo->store_persistent_state; # otherwise I will not reach 89 # all involved parties for 90 # the next session 91 } 92 } 93 bless { deps => \@deps, loop_starts_with => $loop_starts_with }, $class; 94} 95 96sub is_resolvable { 97 ! defined shift->{loop_starts_with}; 98} 99 100sub as_string { 101 my($self) = shift; 102 my $deps = $self->{deps}; 103 my $loop_starts_with = $self->{loop_starts_with}; 104 unless ($loop_starts_with) { 105 return "--not a recursive/circular dependency--"; 106 } 107 my $ret = "\nRecursive dependency detected:\n "; 108 $ret .= join("\n => ", map {$_->{display_as}} @$deps); 109 $ret .= ".\nCannot resolve.\n"; 110 $ret; 111} 112 1131; 114