1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
package Dist::CheckConflicts;
use strict;
use warnings;
use Carp;
use List::MoreUtils 'first_index';
use Sub::Exporter;
my $import = Sub::Exporter::build_exporter({
exports => [ qw(conflicts check_conflicts calculate_conflicts dist) ],
groups => {
default => [ qw(conflicts check_conflicts calculate_conflicts dist) ],
},
});
my %CONFLICTS;
my %DISTS;
sub import {
my $for = caller;
my ($conflicts, $alsos, $dist);
($conflicts, @_) = _strip_opt('-conflicts' => @_);
($alsos, @_) = _strip_opt('-also' => @_);
($dist, @_) = _strip_opt('-dist' => @_);
my %conflicts = %{ $conflicts || {} };
for my $also (@{ $alsos || [] }) {
eval "require $also; 1;" or die "Couldn't find package $also: $@";
my %also_confs = $also->conflicts;
for my $also_conf (keys %also_confs) {
$conflicts{$also_conf} = $also_confs{$also_conf}
if !exists $conflicts{$also_conf}
|| $conflicts{$also_conf} lt $also_confs{$also_conf};
}
}
$CONFLICTS{$for} = \%conflicts;
$DISTS{$for} = $dist || $for;
goto $import;
}
sub _strip_opt {
my $opt = shift;
my $idx = first_index { ( $_ || '' ) eq $opt } @_;
return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
my $val = $_[ $idx + 1 ];
splice @_, $idx, 2;
return ( $val, @_ );
}
sub conflicts {
my $package = shift;
return %{ $CONFLICTS{ $package } };
}
sub dist {
my $package = shift;
return $DISTS{ $package };
}
sub check_conflicts {
my $package = shift;
my $dist = $package->dist;
my @conflicts = $package->calculate_conflicts;
return unless @conflicts;
my $err = "Conflicts detected for $dist:\n";
for my $conflict (@conflicts) {
$err .= " $conflict->{package} is version "
. "$conflict->{installed}, but must be greater than version "
. "$conflict->{required}\n";
}
die $err;
}
sub calculate_conflicts {
my $package = shift;
my %conflicts = $package->conflicts;
my @ret;
CONFLICT:
for my $conflict (keys %conflicts) {
{
local $SIG{__WARN__} = sub { };
eval "require $conflict; 1" or next CONFLICT;
}
my $installed = $conflict->VERSION;
push @ret, {
package => $conflict,
installed => $installed,
required => $conflicts{$conflict},
} if $installed le $conflicts{$conflict};
}
return sort { $a->{package} cmp $b->{package} } @ret;
}
1;
|
