| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- | 
| 2 |  |  |  |  |  |  | # vim: ts=4 sts=4 sw=4: | 
| 3 |  |  |  |  |  |  | package CPAN::Exception::RecursiveDependency; | 
| 4 | 12 |  |  | 12 |  | 37 | use strict; | 
|  | 12 |  |  |  |  | 14 |  | 
|  | 12 |  |  |  |  | 349 |  | 
| 5 | 12 |  |  | 12 |  | 40 | use overload '""' => "as_string"; | 
|  | 12 |  |  |  |  | 13 |  | 
|  | 12 |  |  |  |  | 64 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 | 12 |  |  |  |  | 4716 | use vars qw( | 
| 8 |  |  |  |  |  |  | $VERSION | 
| 9 | 12 |  |  | 12 |  | 732 | ); | 
|  | 12 |  |  |  |  | 17 |  | 
| 10 |  |  |  |  |  |  | $VERSION = "5.5"; | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | # a module sees its distribution (no version) | 
| 13 |  |  |  |  |  |  | # a distribution sees its prereqs (which are module names) (usually with versions) | 
| 14 |  |  |  |  |  |  | # a bundle sees its module names and/or its distributions (no version) | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | sub new { | 
| 17 | 2 |  |  | 2 | 0 | 1393 | my($class) = shift; | 
| 18 | 2 |  |  |  |  | 2 | my($deps_arg) = shift; | 
| 19 | 2 |  |  |  |  | 4 | my (@deps,%seen,$loop_starts_with); | 
| 20 | 2 |  |  |  |  | 6 | DCHAIN: for my $dep (@$deps_arg) { | 
| 21 | 7 |  |  |  |  | 14 | push @deps, {name => $dep, display_as => $dep}; | 
| 22 | 7 | 100 |  |  |  | 22 | if ($seen{$dep}++) { | 
| 23 | 1 |  |  |  |  | 2 | $loop_starts_with = $dep; | 
| 24 | 1 |  |  |  |  | 2 | last DCHAIN; | 
| 25 |  |  |  |  |  |  | } | 
| 26 |  |  |  |  |  |  | } | 
| 27 | 2 |  |  |  |  | 4 | my $in_loop = 0; | 
| 28 | 2 |  |  |  |  | 6 | for my $i (0..$#deps) { | 
| 29 | 7 |  |  |  |  | 12 | my $x = $deps[$i]{name}; | 
| 30 | 7 |  | 66 |  |  | 25 | $in_loop ||= $loop_starts_with && $x eq $loop_starts_with; | 
|  |  |  | 100 |  |  |  |  | 
| 31 | 7 | 50 |  |  |  | 25 | my $xo = CPAN::Shell->expandany($x) or next; | 
| 32 | 0 | 0 |  |  |  | 0 | if ($xo->isa("CPAN::Module")) { | 
|  |  | 0 |  |  |  |  |  | 
| 33 | 0 |  | 0 |  |  | 0 | my $have = $xo->inst_version || "N/A"; | 
| 34 | 0 |  |  |  |  | 0 | my($want,$d,$want_type); | 
| 35 | 0 | 0 | 0 |  |  | 0 | if ($i>0 and $d = $deps[$i-1]{name}) { | 
| 36 | 0 |  |  |  |  | 0 | my $do = CPAN::Shell->expandany($d); | 
| 37 | 0 |  |  |  |  | 0 | $want = $do->{prereq_pm}{requires}{$x}; | 
| 38 | 0 | 0 |  |  |  | 0 | if (defined $want) { | 
| 39 | 0 |  |  |  |  | 0 | $want_type = "requires: "; | 
| 40 |  |  |  |  |  |  | } else { | 
| 41 | 0 |  |  |  |  | 0 | $want = $do->{prereq_pm}{build_requires}{$x}; | 
| 42 | 0 | 0 |  |  |  | 0 | if (defined $want) { | 
| 43 | 0 |  |  |  |  | 0 | $want_type = "build_requires: "; | 
| 44 |  |  |  |  |  |  | } else { | 
| 45 | 0 |  |  |  |  | 0 | $want_type = "unknown status"; | 
| 46 | 0 |  |  |  |  | 0 | $want = "???"; | 
| 47 |  |  |  |  |  |  | } | 
| 48 |  |  |  |  |  |  | } | 
| 49 |  |  |  |  |  |  | } else { | 
| 50 | 0 |  |  |  |  | 0 | $want = $xo->cpan_version; | 
| 51 | 0 |  |  |  |  | 0 | $want_type = "want: "; | 
| 52 |  |  |  |  |  |  | } | 
| 53 | 0 |  |  |  |  | 0 | $deps[$i]{have} = $have; | 
| 54 | 0 |  |  |  |  | 0 | $deps[$i]{want_type} = $want_type; | 
| 55 | 0 |  |  |  |  | 0 | $deps[$i]{want} = $want; | 
| 56 | 0 |  |  |  |  | 0 | $deps[$i]{display_as} = "$x (have: $have; $want_type$want)"; | 
| 57 |  |  |  |  |  |  | } elsif ($xo->isa("CPAN::Distribution")) { | 
| 58 | 0 |  |  |  |  | 0 | $deps[$i]{display_as} = $xo->pretty_id; | 
| 59 | 0 | 0 |  |  |  | 0 | if ($in_loop) { | 
| 60 | 0 |  |  |  |  | 0 | $xo->{make} = CPAN::Distrostatus->new("NO cannot resolve circular dependency"); | 
| 61 |  |  |  |  |  |  | } else { | 
| 62 | 0 |  |  |  |  | 0 | $xo->{make} = CPAN::Distrostatus->new("NO one dependency ($loop_starts_with) is a circular dependency"); | 
| 63 |  |  |  |  |  |  | } | 
| 64 | 0 |  |  |  |  | 0 | $xo->store_persistent_state; # otherwise I will not reach | 
| 65 |  |  |  |  |  |  | # all involved parties for | 
| 66 |  |  |  |  |  |  | # the next session | 
| 67 |  |  |  |  |  |  | } | 
| 68 |  |  |  |  |  |  | } | 
| 69 | 2 |  |  |  |  | 19 | bless { deps => \@deps, loop_starts_with => $loop_starts_with }, $class; | 
| 70 |  |  |  |  |  |  | } | 
| 71 |  |  |  |  |  |  |  | 
| 72 |  |  |  |  |  |  | sub as_string { | 
| 73 | 2 |  |  | 2 | 0 | 223 | my($self) = shift; | 
| 74 | 2 |  |  |  |  | 3 | my $deps = $self->{deps}; | 
| 75 | 2 |  |  |  |  | 2 | my $loop_starts_with = $self->{loop_starts_with}; | 
| 76 | 2 | 100 |  |  |  | 5 | unless ($loop_starts_with) { | 
| 77 | 1 |  |  |  |  | 8 | return "--not a recursive/circular dependency--"; | 
| 78 |  |  |  |  |  |  | } | 
| 79 | 1 |  |  |  |  | 2 | my $ret = "\nRecursive dependency detected:\n    "; | 
| 80 | 1 |  |  |  |  | 3 | $ret .= join("\n => ", map {$_->{display_as}} @$deps); | 
|  | 4 |  |  |  |  | 7 |  | 
| 81 | 1 |  |  |  |  | 1 | $ret .= ".\nCannot resolve.\n"; | 
| 82 | 1 |  |  |  |  | 10 | $ret; | 
| 83 |  |  |  |  |  |  | } | 
| 84 |  |  |  |  |  |  |  | 
| 85 |  |  |  |  |  |  | 1; |