File Coverage

lib/CPAN/Changes/Group/Dependencies/Details.pm
Criterion Covered Total %
statement 70 70 100.0
branch 8 8 100.0
condition 2 3 66.6
subroutine 26 26 100.0
pod 2 2 100.0
total 108 109 99.0


line stmt bran cond sub pod time code
1 4     4   144357 use 5.006;
  4         9  
  4         133  
2 4     4   16 use strict;
  4         6  
  4         121  
3 4     4   23 use warnings;
  4         4  
  4         268  
4              
5             package CPAN::Changes::Group::Dependencies::Details;
6              
7             our $VERSION = '0.001004';
8              
9             # ABSTRACT: Full details of dependency changes.
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13 4     4   1560 use Moo qw( has extends );
  4         36094  
  4         20  
14              
15 4     4   5499 use MooX::Lsub qw( lsub );
  4         22785  
  4         30  
16 4     4   1579 use Carp qw( croak );
  4         5  
  4         173  
17 4     4   1391 use CPAN::Changes 0.30;
  4         53530  
  4         135  
18 4     4   28 use CPAN::Changes::Group;
  4         5  
  4         64  
19 4     4   1555 use CPAN::Meta::Prereqs::Diff;
  4         139254  
  4         150  
20             ## no critic (ProhibitConstantPragma)
21 4     4   30 use constant STRICTMODE => 1;
  4         6  
  4         281  
22 4     4   2613 use charnames ':full';
  4         110546  
  4         32  
23              
24             my $formatters = {
25             'toggle' => sub {
26             return sub {
27             my $diff = shift;
28             my $output = $diff->module;
29             if ( $diff->requirement ne '0' ) {
30             $output .= q[ ] . $diff->requirement;
31             }
32             return $output;
33             };
34             },
35             'change' => sub {
36             my $self = shift;
37             my $arrow_join = $self->arrow_join;
38             return sub {
39             my $diff = shift;
40             return $diff->module . q[ ] . $diff->old_requirement . $arrow_join . $diff->new_requirement;
41             };
42             },
43             };
44              
45             my $valid_change_types = {
46             'Added' => {
47             method => 'is_addition',
48             notation => 'toggle',
49             },
50             'Changed' => {
51             method => 'is_change',
52             notation => 'change',
53             },
54             'Upgrade' => {
55             method => sub { $_[0]->is_change && $_[0]->is_upgrade },
56             notation => 'change',
57             },
58             'Downgrade' => {
59             method => sub { $_[0]->is_change && $_[0]->is_downgrade },
60             notation => 'change',
61             },
62             'Removed' => {
63             method => 'is_removal',
64             notation => 'toggle',
65             },
66             };
67              
68             my $isa_checks = { map { $_ => {} } qw( change_type phase type ) };
69              
70             if (STRICTMODE) {
71              
72             $isa_checks->{change_type} = {
73             isa => sub {
74             local $" = q[, ];
75             croak "change_type must be one of <@{ keys %{$valid_change_types } }>, not $_[0]"
76             unless exists $valid_change_types->{ $_[0] };
77             },
78             };
79              
80             my $valid_phases = { map { $_ => 1 } qw( configure build runtime test develop ) };
81              
82             $isa_checks->{phase} = {
83             isa => sub {
84             local $" = q[, ];
85             croak "phase must be one of <@{ keys %{$valid_phases } }>, not $_[0]" unless exists $valid_phases->{ $_[0] };
86             },
87             };
88              
89             my $valid_types = { map { $_ => 1 } qw( requires recommends suggests conflicts ) };
90              
91             $isa_checks->{type} = {
92             isa => sub {
93             local $" = q[, ];
94             croak "type must be one of <@{ keys %{$valid_types } }>, not $_[0]" unless exists $valid_types->{ $_[0] };
95             },
96             };
97             }
98              
99             extends 'CPAN::Changes::Group';
100              
101              
102              
103              
104              
105              
106              
107              
108              
109              
110              
111              
112              
113              
114             has change_type => ( is => 'ro', required => 1, %{ $isa_checks->{change_type} } );
115              
116              
117              
118              
119              
120              
121              
122              
123              
124              
125              
126              
127              
128              
129             has phase => ( is => 'ro', required => 1, %{ $isa_checks->{phase} } );
130              
131              
132              
133              
134              
135              
136              
137              
138              
139              
140              
141              
142              
143             has type => ( is => 'ro', required => 1, %{ $isa_checks->{type} } );
144              
145              
146              
147              
148              
149              
150              
151              
152 1     1   478 lsub new_prereqs => sub { croak q{required parameter <new_prereqs> missing} };
153              
154              
155              
156              
157              
158              
159              
160              
161 2     2   667 lsub old_prereqs => sub { croak q{required parameter <old_prereqs> missing} };
162              
163              
164              
165              
166              
167              
168              
169              
170              
171              
172              
173              
174 12     12   845 lsub arrow_join => sub { qq[\N{NO-BREAK SPACE}\N{RIGHTWARDS ARROW}\N{NO-BREAK SPACE}] };
175              
176              
177              
178              
179              
180              
181              
182              
183              
184              
185              
186 2     2   348 lsub name_split => sub { q[ / ] };
187              
188              
189              
190              
191              
192              
193              
194              
195              
196              
197              
198 2     2   336 lsub name_type_split => sub { q[ ] };
199              
200              
201              
202              
203              
204              
205              
206              
207              
208              
209              
210              
211              
212              
213              
214              
215             lsub name => sub {
216 2     2   533 my ($self) = @_;
217 2         20 return $self->change_type . $self->name_split . $self->phase . $self->name_type_split . $self->type;
218             };
219              
220             # Mostly internal plumbing attributes but should be ok for experts to work with
221 782     782   8499 lsub change_type_method => sub { $valid_change_types->{ $_[0]->change_type }->{method} };
222 164     164   2700 lsub change_type_notation => sub { $valid_change_types->{ $_[0]->change_type }->{notation} };
223              
224             lsub change_formatter => sub {
225 164     164   2199 my ($self) = @_;
226 164         2589 return $formatters->{ $self->change_type_notation }->($self);
227             };
228              
229             lsub prereqs_diff => sub {
230 7503     7503   35646 my ($self) = @_;
231 7503         106539 return CPAN::Meta::Prereqs::Diff->new( old_prereqs => $self->old_prereqs, new_prereqs => $self->new_prereqs, );
232             };
233              
234             lsub all_diffs => sub {
235 7503     7503   37470 my ($self) = @_;
236             ## Note: this filters here because the differ is faster that way
237             ## But end users may still pass unfiltered copies of all_diffs
238 7503         106767 return [ $self->prereqs_diff->diff( phases => [ $self->phase ], types => [ $self->type ], ) ];
239             };
240              
241             lsub relevant_diffs => sub {
242 782     782   5754 my ($self) = @_;
243 782         12237 my $method = $self->change_type_method;
244 782         1378 my $phase = $self->phase;
245 782         1131 my $type = $self->type;
246              
247             # This phase filters the values from all_diffs
248             # which should mostly filters by change type, but also filters on criteria
249             # in case of all_diffs being raw.
250 782 100 66     872 return [ grep { $_->$method() and $_->phase eq $phase and $_->type eq $type } @{ $self->all_diffs } ];
  786         6320  
  782         12000  
251             };
252              
253              
254              
255              
256              
257              
258              
259              
260             sub has_changes {
261 7507     7507 1 7287 my ($self) = @_;
262 7507 100       6371 return unless @{ $self->all_diffs };
  7507         111721  
263 784 100       208136 return unless @{ $self->relevant_diffs };
  784         14295  
264 166         2715 return 1;
265             }
266              
267              
268              
269              
270              
271              
272              
273              
274              
275              
276              
277              
278              
279              
280              
281              
282             sub changes {
283 7503     7503 1 69383 my ($self) = @_;
284 7503 100       11861 return [] unless $self->has_changes;
285 165         2814 my $formatter = $self->change_formatter;
286 165         292 return [ map { $formatter->($_) } @{ $self->relevant_diffs } ];
  165         1151  
  165         2682  
287             }
288              
289 4     4   44581 no Moo;
  4         8  
  4         31  
290              
291             1;
292              
293             __END__
294              
295             =pod
296              
297             =encoding UTF-8
298              
299             =head1 NAME
300              
301             CPAN::Changes::Group::Dependencies::Details - Full details of dependency changes.
302              
303             =head1 VERSION
304              
305             version 0.001004
306              
307             =head1 SYNOPSIS
308              
309             my $old_prereqs => CPAN::Meta->load_file('Dist-Foo-1.01/META.json')->effective_prereqs,
310             my $new_prereqs => CPAN::Meta->load_file('Dist-Foo-1.01/META.json')->effective_prereqs,
311              
312             my $group = CPAN::Changes::Group::Dependencies::Details->new(
313             old_prereqs => $old_prereqs,
314             new_prereqs => $new_prereqs,
315             change_type => 'Added',
316             phase => 'runtime',
317             type => 'requires',
318             );
319              
320             my $release = CPAN::Changes::Release->new(
321             version => '0.01',
322             date => '2014-07-26',
323             );
324              
325             $release->attach_group( $group ) if $group->has_changes;
326              
327             =head1 DESCRIPTION
328              
329             This is simple an element of refactoring in my C<dep_changes> script.
330              
331             It is admittedly not very useful in its current incarnation due to needing quite a few instances
332             to get anything done with them, but that's mostly due to design headaches about thinking of I<any> way to solve a few problems.
333              
334             =head1 METHODS
335              
336             =head2 C<has_changes>
337              
338             Returns true/false indicating whether or not C<relevant> changes were found between
339             the two given C<_prereqs> properties.
340              
341             =head2 C<changes>
342              
343             Returns a list of change entries:
344              
345             Added / Removed
346              
347             Module::Name # For unversioned module additions/removals
348             Module::Name 0.30 # For versioned
349              
350             Changed / Upgrade / Downgrade
351              
352             Module::Name <OLDREQ> → <NEWREQ>
353              
354             =head1 ATTRIBUTES
355              
356             =head2 C<change_type>
357              
358             B<REQUIRED:>
359             One of the following indicating the type of change this group represents.
360              
361             Added : Dependencies are new to this phase
362             Changed : The version component of this dependency changed in some way
363             Upgrade : A newer version of this dependency is required.
364             Downgrade : The requirement of this dependency is no longer so stringent.
365             Removed : A dependency previously in this phase was removed.
366              
367             =head2 C<phase>
368              
369             B<REQUIRED:>
370             One of the following phases indicating the phase this group will pertain to
371              
372             configure
373             build
374             runtime
375             test
376             develop
377              
378             =head2 C<type>
379              
380             B<REQUIRED:>
381             One of the following types indicating the severity of the dependency this group will pertain to
382              
383             requires
384             recommends
385             suggests
386             conflicts
387              
388             =head2 C<new_prereqs>
389              
390             B<LIKELY REQUIRED>:
391             C<HashRef>,C<CPAN::Meta> or C<CPAN::Meta::Prereqs> structure for I<'new'> dependencies.
392              
393             =head2 C<old_prereqs>
394              
395             B<LIKELY REQUIRED>:
396             C<HashRef>,C<CPAN::Meta> or C<CPAN::Meta::Prereqs> structure for I<'new'> dependencies.
397              
398             =head2 C<arrow_join>
399              
400             The delimiter to separate change family entries.
401              
402             Default:
403              
404             #\N{NO-BREAK SPACE}\N{RIGHTWARDS ARROW}\N{NO-BREAK SPACE}
405             q[ → ]
406              
407             =head2 C<name_split>
408              
409             Used to define C<name>.
410              
411             Default:
412              
413             q[ / ]
414              
415             =head2 C<name_type_split>
416              
417             Used to separate C<phase> and C<type> in C<name>
418              
419             Default:
420              
421             q[ ]
422              
423             =head2 C<name>
424              
425             The name of the group.
426              
427             If not specified, is generated from other attributes
428              
429             Added / runtime requires
430              
431             |___|------------------- change_type
432             |_|---------------- name_split
433             |_____|--------- phase
434             ||------- name_type_split
435             |______| type
436              
437             =head1 AUTHOR
438              
439             Kent Fredric <kentnl@cpan.org>
440              
441             =head1 COPYRIGHT AND LICENSE
442              
443             This software is copyright (c) 2015 by Kent Fredric <kentfredric@gmail.com>.
444              
445             This is free software; you can redistribute it and/or modify it under
446             the same terms as the Perl 5 programming language system itself.
447              
448             =cut