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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
package CPAN::Meta::Check;
# vi:noet:sts=2:sw=2:ts=2
$CPAN::Meta::Check::VERSION = '0.017';
use strict;
use warnings;
use base 'Exporter';
our @EXPORT = qw//;
our @EXPORT_OK = qw/check_requirements requirements_for verify_dependencies/;
our %EXPORT_TAGS = (all => [ @EXPORT, @EXPORT_OK ] );
use CPAN::Meta::Prereqs '2.132830';
use CPAN::Meta::Requirements 2.121;
use Module::Metadata 1.000023;
sub _check_dep {
my ($reqs, $module, $dirs) = @_;
$module eq 'perl' and return ($reqs->accepts_module($module, $]) ? () : sprintf "Your Perl (%s) is not in the range '%s'", $], $reqs->requirements_for_module($module));
my $metadata = Module::Metadata->new_from_module($module, inc => $dirs);
return "Module '$module' is not installed" if not defined $metadata;
my $version = eval { $metadata->version };
return sprintf 'Installed version (%s) of %s is not in range \'%s\'',
(defined $version ? $version : 'undef'), $module, $reqs->requirements_for_module($module)
if not $reqs->accepts_module($module, $version || 0);
return;
}
sub _check_conflict {
my ($reqs, $module, $dirs) = @_;
my $metadata = Module::Metadata->new_from_module($module, inc => $dirs);
return if not defined $metadata;
my $version = eval { $metadata->version };
return sprintf 'Installed version (%s) of %s is in range \'%s\'',
(defined $version ? $version : 'undef'), $module, $reqs->requirements_for_module($module)
if $reqs->accepts_module($module, $version);
return;
}
sub requirements_for {
my ($meta, $phases, $type) = @_;
my $prereqs = ref($meta) eq 'CPAN::Meta' ? $meta->effective_prereqs : $meta;
return $prereqs->merged_requirements(ref($phases) ? $phases : [ $phases ], [ $type ]);
}
sub check_requirements {
my ($reqs, $type, $dirs) = @_;
return +{
map {
$_ => $type ne 'conflicts'
? scalar _check_dep($reqs, $_, $dirs)
: scalar _check_conflict($reqs, $_, $dirs)
} $reqs->required_modules
};
}
sub verify_dependencies {
my ($meta, $phases, $type, $dirs) = @_;
my $reqs = requirements_for($meta, $phases, $type);
my $issues = check_requirements($reqs, $type, $dirs);
return grep { defined } values %{ $issues };
}
1;
#ABSTRACT: Verify requirements in a CPAN::Meta object
__END__
=pod
=encoding UTF-8
=head1 NAME
CPAN::Meta::Check - Verify requirements in a CPAN::Meta object
=head1 VERSION
version 0.017
=head1 SYNOPSIS
warn "$_\n" for verify_dependencies($meta, [qw/runtime build test/], 'requires');
=head1 DESCRIPTION
This module verifies if requirements described in a CPAN::Meta object are present.
=head1 FUNCTIONS
=head2 check_requirements($reqs, $type, $incdirs)
This function checks if all dependencies in C<$reqs> (a L<CPAN::Meta::Requirements|CPAN::Meta::Requirements> object) are met, taking into account that 'conflicts' dependencies have to be checked in reverse. It returns a hash with the modules as keys and any problems as values; the value for a successfully found module will be undef. Modules are searched for in C<@$incdirs>, defaulting to C<@INC>.
=head2 verify_dependencies($meta, $phases, $types, $incdirs)
Check all requirements in C<$meta> for phases C<$phases> and type C<$type>. Modules are searched for in C<@$incdirs>, defaulting to C<@INC>. C<$meta> should be a L<CPAN::Meta::Prereqs> or L<CPAN::Meta> object.
=head2 requirements_for($meta, $phases, $types)
B<< This function is deprecated and may be removed at some point in the future, please use CPAN::Meta::Prereqs->merged_requirements instead. >>
This function returns a unified L<CPAN::Meta::Requirements|CPAN::Meta::Requirements> object for all C<$type> requirements for C<$phases>. C<$phases> may be either one (scalar) value or an arrayref of valid values as defined by the L<CPAN::Meta spec|CPAN::Meta::Spec>. C<$type> must be a relationship as defined by the same spec. C<$meta> should be a L<CPAN::Meta::Prereqs> or L<CPAN::Meta> object.
=head1 SEE ALSO
=over 4
=item * L<Test::CheckDeps|Test::CheckDeps>
=item * L<CPAN::Meta|CPAN::Meta>
=back
=head1 AUTHOR
Leon Timmermans <leont@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2012 by Leon Timmermans.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|
