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