File Coverage

blib/lib/CPAN/Meta/Prereqs/Filter.pm
Criterion Covered Total %
statement 49 65 75.3
branch 22 38 57.8
condition 1 8 12.5
subroutine 7 7 100.0
pod 1 1 100.0
total 80 119 67.2


line stmt bran cond sub pod time code
1             package CPAN::Meta::Prereqs::Filter;
2             $CPAN::Meta::Prereqs::Filter::VERSION = '0.005';
3 1     1   79762 use strict;
  1         3  
  1         31  
4 1     1   6 use warnings;
  1         2  
  1         31  
5              
6 1     1   6 use Exporter 5.57 'import';
  1         18  
  1         46  
7             our @EXPORT_OK = qw/filter_prereqs/;
8              
9 1     1   6 use Carp 'croak';
  1         2  
  1         59  
10 1     1   7 use Scalar::Util 'isvstring';
  1         3  
  1         722  
11              
12             my @phases = qw/configure build test runtime develop/;
13             my @relationships = qw/requires recommends suggests/;
14              
15             my %dependents_for = (
16             configure => [ qw/build test develop/ ],
17             runtime => [ qw/build test develop/ ],
18             build => [ qw/test develop/ ],
19             test => [ qw/develop/ ],
20             );
21              
22             sub _normalize_version {
23 1     1   3 my $raw = shift;
24 1 50       6 if (isvstring($raw)) {
25 0         0 $raw = sprintf 'v%vd', $raw;
26             }
27 1 50       11 if ($raw =~ / \A v5 (?> \. \d+)* \z /x) {
    50          
28 0         0 require version;
29 0         0 return sprintf '%7.6f', version->new($raw)->numify;
30             }
31             elsif ($raw eq 'latest') {
32 0         0 require Module::CoreList;
33 0         0 return (reverse sort keys %Module::CoreList::version)[0];
34             }
35 1         9 return sprintf '%7.6f', $raw;
36             }
37              
38             sub filter_prereqs {
39 3     3 1 4901 my ($prereqs, %args) = @_;
40 3 50       11 return $prereqs if not grep { $_ } values %args;
  3         14  
41 3         14 $prereqs = $prereqs->clone;
42 3 100       1304 my $core_version = defined $args{omit_core} ? _normalize_version($args{omit_core}) : undef;
43 3 100       10 if ($core_version) {
44 1         3007 require Module::CoreList;
45 1 50       103952 croak "$core_version is not a known perl version" if not exists $Module::CoreList::version{$core_version};
46 1         5 for my $phase (@phases) {
47 5         30 for my $relation (@relationships) {
48 15         80 my $req = $prereqs->requirements_for($phase, $relation);
49              
50 15 50       733 $req->clear_requirement('perl') if $req->accepts_module('perl', $core_version);
51 15         780 for my $module ($req->required_modules) {
52 2 100       38 next if not exists $Module::CoreList::version{$core_version}{$module};
53 1 50       5 next if not $req->accepts_module($module, $Module::CoreList::version{$core_version}{$module});
54 1 50       69 next if Module::CoreList->is_deprecated($module, $core_version);
55 1         33 $req->clear_requirement($module);
56             }
57             }
58             }
59             }
60 3 50       16 if ($args{sanitize}) {
61 0         0 for my $parent (qw/runtime configure build/) {
62 0         0 for my $child ( @{ $dependents_for{$parent} } ) {
  0         0  
63 0         0 for my $relationship (@relationships) {
64 0         0 my $source = $prereqs->requirements_for($parent, $relationship);
65 0         0 my $sink = $prereqs->requirements_for($child, $relationship);
66 0         0 for my $module ($source->required_modules) {
67 0 0       0 next if not defined(my $right = $sink->requirements_for_module($module));
68 0         0 my $left = $source->requirements_for_module($module);
69 0 0 0     0 $sink->clear_requirement($module) if $left eq $right || $right eq '0';
70             }
71             }
72             }
73             }
74             }
75 3 100       10 if ($args{only_missing}) {
76 1         793 require Module::Metadata;
77 1         6170 for my $phase (@phases) {
78 5         29 for my $relation (@relationships) {
79 15         84 my $req = $prereqs->requirements_for($phase, $relation);
80 15 50       690 $req->clear_requirement('perl') if $req->accepts_module('perl', $]);
81 15         742 for my $module ($req->required_modules) {
82 3 100       532 if ($req->requirements_for_module($module)) {
83 1         47 my $metadata = Module::Metadata->new_from_module($module);
84 1 50 0     380 if ($metadata && $req->accepts_module($module, $metadata->version($module) || 0)) {
      33        
85 0         0 $req->clear_requirement($module);
86             }
87             }
88             else {
89 2 50       104 $req->clear_requirement($module) if Module::Metadata->find_module_by_name($module);
90             }
91             }
92             }
93             }
94             }
95 3         630 return $prereqs;
96             }
97              
98             1;
99              
100             # ABSTRACT: Filtering various things out of CPAN::Meta::Prereqs
101              
102             __END__