This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
document Git_Data
[perl5.git] / lib / CPAN / Exception / RecursiveDependency.pm
CommitLineData
f9916dde
A
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.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
16sub new {
17 my($class) = shift;
2f2071b1 18 my($deps_arg) = shift;
f9916dde 19 my (@deps,%seen,$loop_starts_with);
2f2071b1 20 DCHAIN: for my $dep (@$deps_arg) {
f9916dde
A
21 push @deps, {name => $dep, display_as => $dep};
22 if ($seen{$dep}++) {
23 $loop_starts_with = $dep;
24 last DCHAIN;
25 }
26 }
27 my $in_loop = 0;
28 for my $i (0..$#deps) {
29 my $x = $deps[$i]{name};
2f2071b1 30 $in_loop ||= $loop_starts_with && $x eq $loop_starts_with;
f9916dde
A
31 my $xo = CPAN::Shell->expandany($x) or next;
32 if ($xo->isa("CPAN::Module")) {
33 my $have = $xo->inst_version || "N/A";
34 my($want,$d,$want_type);
35 if ($i>0 and $d = $deps[$i-1]{name}) {
36 my $do = CPAN::Shell->expandany($d);
37 $want = $do->{prereq_pm}{requires}{$x};
38 if (defined $want) {
39 $want_type = "requires: ";
40 } else {
41 $want = $do->{prereq_pm}{build_requires}{$x};
42 if (defined $want) {
43 $want_type = "build_requires: ";
44 } else {
45 $want_type = "unknown status";
46 $want = "???";
47 }
48 }
49 } else {
50 $want = $xo->cpan_version;
51 $want_type = "want: ";
52 }
53 $deps[$i]{have} = $have;
54 $deps[$i]{want_type} = $want_type;
55 $deps[$i]{want} = $want;
56 $deps[$i]{display_as} = "$x (have: $have; $want_type$want)";
57 } elsif ($xo->isa("CPAN::Distribution")) {
58 $deps[$i]{display_as} = $xo->pretty_id;
59 if ($in_loop) {
60 $xo->{make} = CPAN::Distrostatus->new("NO cannot resolve circular dependency");
61 } else {
62 $xo->{make} = CPAN::Distrostatus->new("NO one dependency ($loop_starts_with) is a circular dependency");
63 }
64 $xo->store_persistent_state; # otherwise I will not reach
65 # all involved parties for
66 # the next session
67 }
68 }
2f2071b1 69 bless { deps => \@deps, loop_starts_with => $loop_starts_with }, $class;
f9916dde
A
70}
71
72sub as_string {
73 my($self) = shift;
2f2071b1
A
74 my $deps = $self->{deps};
75 my $loop_starts_with = $self->{loop_starts_with};
76 unless ($loop_starts_with) {
77 return "--not a recursive/circular dependency--";
78 }
f9916dde 79 my $ret = "\nRecursive dependency detected:\n ";
2f2071b1 80 $ret .= join("\n => ", map {$_->{display_as}} @$deps);
f9916dde
A
81 $ret .= ".\nCannot resolve.\n";
82 $ret;
83}
84
851;