File Coverage

blib/lib/Dist/Iller/Role/HasPrereqs.pm
Criterion Covered Total %
statement 49 49 100.0
branch 7 8 87.5
condition n/a
subroutine 12 12 100.0
pod 0 3 0.0
total 68 72 94.4


line stmt bran cond sub pod time code
1 2     2   1263 use 5.14.0;
  2         8  
2 2     2   13 use strict;
  2         4  
  2         50  
3 2     2   10 use warnings;
  2         4  
  2         129  
4              
5             package Dist::Iller::Role::HasPrereqs;
6              
7             our $AUTHORITY = 'cpan:CSSON'; # AUTHORITY
8             # ABSTRACT: A role for DocTypes that contains prereqs (like dist/cpanfile)
9             our $VERSION = '0.1410';
10              
11 2     2   13 use Moose::Role;
  2         4  
  2         15  
12 2     2   11062 use namespace::autoclean;
  2         5  
  2         14  
13 2     2   123 use version;
  2         6  
  2         14  
14 2     2   176 use Types::Standard qw/ArrayRef HashRef InstanceOf/;
  2         5  
  2         13  
15 2     2   2305 use Dist::Iller::Prereq;
  2         5  
  2         1267  
16              
17             has prereqs => (
18             is => 'ro',
19             isa => ArrayRef[InstanceOf['Dist::Iller::Prereq']],
20             traits => ['Array'],
21             default => sub { [] },
22             handles => {
23             add_prereq => 'push',
24             filter_prereqs => 'grep',
25             find_prereq => 'first',
26             get_prereq => 'get',
27             all_prereqs => 'elements',
28             has_prereqs => 'count',
29             },
30             );
31             has default_prereq_versions => (
32             is => 'ro',
33             isa => HashRef,
34             traits => ['Hash'],
35             default => sub { +{ } },
36             handles => {
37             set_default_prereq_version => 'set',
38             get_default_prereq_version => 'get',
39             all_default_prereq_versions => 'kv',
40             },
41             );
42              
43              
44              
45             # Ensure that we require the highest wanted version
46             around add_prereq => sub {
47             my $next = shift;
48             my $self = shift;
49             my $prereq = shift;
50              
51              
52             my $default_version = $self->get_default_prereq_version($prereq->module);
53             if($default_version && !$prereq->version) {
54             my $parsed_default_version = version->parse($default_version);
55              
56             if($parsed_default_version > version->parse($prereq->version)) {
57             $prereq->version($default_version);
58             }
59             }
60              
61             my $already_existing = $self->find_prereq(sub {$_->module eq $prereq->module && $_->phase eq $prereq->phase });
62             if($already_existing) {
63             my $old_version = version->parse($already_existing->version);
64             my $new_version = version->parse($prereq->version);
65              
66             if($new_version > $old_version) {
67             $already_existing->version($prereq->version);
68             }
69             }
70             else {
71             $self->$next($prereq);
72             }
73             };
74              
75             sub merge_prereqs {
76 1     1 0 4 my $self = shift;
77 1         5 my @prereqs = @_;
78              
79 1         5 for my $prereq (@prereqs) {
80 39 100   3222   1580 my $already_existing = $self->find_prereq(sub {$_->module eq $prereq->module && $_->phase eq $prereq->phase });
  3222         75592  
81              
82 39 100       159 if($already_existing) {
83 25         639 my $old_version = version->parse($already_existing->version);
84 25         653 my $new_version = version->parse($prereq->version);
85              
86 25 100       175 if($new_version > $old_version) {
87 4         106 $already_existing->version($prereq->version);
88             }
89             }
90             else {
91 14         62 $self->add_prereq($prereq);
92             }
93             }
94             }
95              
96             sub prereqs_to_array {
97 32     32 0 51 my $self = shift;
98              
99 32         52 my $array = [];
100 32         1150 for my $prereq ($self->all_prereqs) {
101 2         52 my $phase_relation = sprintf '%s_%s', $prereq->phase, $prereq->relation;
102 2         41 push @{ $array } => { $phase_relation => sprintf '%s %s', $prereq->module, $prereq->version };
  2         71  
103             }
104              
105 32         821 return $array;
106             }
107              
108             sub prereqs_to_hash {
109 1     1 0 3 my $self = shift;
110              
111 1         3 my $hash = {};
112 1         41 for my $prereq ($self->all_prereqs) {
113 1 50       29 if(!exists $hash->{ $prereq->phase }{ $prereq->relation }) {
114 1         26 $hash->{ $prereq->phase }{ $prereq->relation } = [];
115             }
116 1         3 push @{ $hash->{ $prereq->phase }{ $prereq->relation } } => { $prereq->module => $prereq->version };
  1         26  
117             }
118 1         44 return $hash;
119             }
120              
121             1;
122              
123             __END__
124              
125             =pod
126              
127             =encoding UTF-8
128              
129             =head1 NAME
130              
131             Dist::Iller::Role::HasPrereqs - A role for DocTypes that contains prereqs (like dist/cpanfile)
132              
133             =head1 VERSION
134              
135             Version 0.1410, released 2020-12-31.
136              
137             =head1 SOURCE
138              
139             L<https://github.com/Csson/p5-Dist-Iller>
140              
141             =head1 HOMEPAGE
142              
143             L<https://metacpan.org/release/Dist-Iller>
144              
145             =head1 AUTHOR
146              
147             Erik Carlsson <info@code301.com>
148              
149             =head1 COPYRIGHT AND LICENSE
150              
151             This software is copyright (c) 2020 by Erik Carlsson.
152              
153             This is free software; you can redistribute it and/or modify it under
154             the same terms as the Perl 5 programming language system itself.
155              
156             =cut