File Coverage

blib/lib/CPAN/Exception/RecursiveDependency.pm
Criterion Covered Total %
statement 33 57 57.8
branch 5 18 27.7
condition 5 11 45.4
subroutine 5 5 100.0
pod 0 2 0.0
total 48 93 51.6


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   49 use strict;
  12         16  
  12         511  
5 12     12   60 use overload '""' => "as_string";
  12         12  
  12         88  
6              
7 12         5857 use vars qw(
8             $VERSION
9 12     12   779 );
  12         224  
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 862 my($class) = shift;
18 2         4 my($deps_arg) = shift;
19 2         4 my (@deps,%seen,$loop_starts_with);
20 2         6 DCHAIN: for my $dep (@$deps_arg) {
21 7         17 push @deps, {name => $dep, display_as => $dep};
22 7 100       20 if ($seen{$dep}++) {
23 1         2 $loop_starts_with = $dep;
24 1         2 last DCHAIN;
25             }
26             }
27 2         3 my $in_loop = 0;
28 2         6 for my $i (0..$#deps) {
29 7         12 my $x = $deps[$i]{name};
30 7   66     26 $in_loop ||= $loop_starts_with && $x eq $loop_starts_with;
      100        
31 7 50       24 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         16 bless { deps => \@deps, loop_starts_with => $loop_starts_with }, $class;
70             }
71              
72             sub as_string {
73 2     2 0 243 my($self) = shift;
74 2         4 my $deps = $self->{deps};
75 2         3 my $loop_starts_with = $self->{loop_starts_with};
76 2 100       6 unless ($loop_starts_with) {
77 1         6 return "--not a recursive/circular dependency--";
78             }
79 1         1 my $ret = "\nRecursive dependency detected:\n ";
80 1         2 $ret .= join("\n => ", map {$_->{display_as}} @$deps);
  4         8  
81 1         2 $ret .= ".\nCannot resolve.\n";
82 1         9 $ret;
83             }
84              
85             1;