File Coverage

blib/lib/CPAN/Exception/RecursiveDependency.pm
Criterion Covered Total %
statement 40 73 54.7
branch 7 22 31.8
condition 5 18 27.7
subroutine 7 9 77.7
pod 0 3 0.0
total 59 125 47.2


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