File Coverage

blib/lib/App/UpdateCPANfile.pm
Criterion Covered Total %
statement 115 115 100.0
branch 25 28 89.2
condition 31 39 79.4
subroutine 26 26 100.0
pod 0 11 0.0
total 197 219 89.9


line stmt bran cond sub pod time code
1             package App::UpdateCPANfile;
2 1     1   190392 use 5.010001;
  1         4  
3 1     1   5 use strict;
  1         2  
  1         16  
4 1     1   4 use warnings;
  1         2  
  1         19  
5 1     1   406 use Module::CPANfile;
  1         13546  
  1         27  
6 1     1   384 use Module::CPANfile::Writer;
  1         105070  
  1         36  
7 1     1   502 use App::UpdateCPANfile::CPANfileSnapshotParser;
  1         4  
  1         38  
8 1     1   416 use App::UpdateCPANfile::PackageDetails;
  1         4  
  1         35  
9 1     1   395 use App::UpdateCPANfile::Change;
  1         3  
  1         24  
10 1     1   6 use Module::CoreList;
  1         2  
  1         10  
11 1     1   26 use List::Util qw(shuffle);
  1         2  
  1         1152  
12              
13             our $VERSION = "1.1.0";
14              
15             sub new {
16 26     26 0 81323 my ($class, $path, $snapshot_path, $options) = @_;
17 26         155 bless {
18             path => $path,
19             snapshot_path => $snapshot_path,
20             options => $options,
21             }, $class;
22             }
23              
24             sub path {
25 36   100 36 0 1321 $_[0]->{path} // 'cpanfile';
26             }
27              
28             sub snapshot_path {
29 18   100 18 0 187 $_[0]->{snapshot_path} // 'cpanfile.snapshot';
30             }
31              
32             sub options {
33 106   100 106 0 458 $_[0]->{options} // {};
34             }
35              
36             sub parser {
37 53     53 0 130 my ($self) = @_;
38              
39 53   66     293 $self->{parser} //= Module::CPANfile->load($self->path);
40             }
41              
42             sub writer {
43 9     9 0 478 my ($self) = @_;
44              
45 9   66     52 $self->{writer} //= Module::CPANfile::Writer->new($self->path);
46             }
47              
48             sub package_details {
49 27     27 0 85 my ($self) = @_;
50              
51 27   66     299 $self->{package_details} //= App::UpdateCPANfile::PackageDetails->new;
52             }
53              
54             sub pin_dependencies {
55 2     2 0 14 my ($self) = @_;
56 2         9 my $changeset = $self->create_pin_dependencies_changeset;
57 2         284 $self->_save_changes_to_file($changeset);
58 2         510475 return $changeset;
59             }
60              
61             sub update_dependencies {
62 3     3 0 366 my ($self) = @_;
63 3         11 my $changeset = $self->create_update_dependencies_changeset;
64 3         16 my $writer = $self->writer;
65 3         570 $self->_save_changes_to_file($changeset);
66 3         897678 return $changeset;
67             }
68              
69             sub create_pin_dependencies_changeset {
70 15     15 0 317 my ($self) = @_;
71              
72 15         50 my $distributions = App::UpdateCPANfile::CPANfileSnapshotParser->scan_deps($self->snapshot_path);
73              
74 15         683 my $prereqs = $self->parser->prereqs;
75 15         17063 my $added_dependencies = [];
76              
77 15         30 my $all_phases = {};
78 15         62 for my $phase ($prereqs->phases) {
79 25         407 for my $type ($prereqs->types_in($phase)) {
80 29         765 $all_phases->{$type}++;
81             }
82             }
83              
84             # If arguments are omitted, it defaults to "runtime", "build" and "test" for phases and "requires" and "recommends" for types.
85 15         54 my $requirements = $prereqs->merged_requirements([$self->parser->prereqs->phases], [keys %$all_phases]);
86              
87 15         4267 for my $module (sort $requirements->required_modules) {
88 42 100       217 next if $self->_is_perl($module);
89 33         87 my $required_version = $requirements->requirements_for_module($module);
90 33         1379 my $installed_module = $self->_find_installed_module($distributions, $module);
91 33   66     611 my $installed_version = defined $installed_module && $installed_module->version_for($module);
92 33 50       591 next if $self->_is_core_module($module, $installed_version);
93 33 100 66     253 if (defined $installed_module && defined $installed_version && (! defined $required_version || $required_version ne "== $installed_version") && ($installed_version ne 'undef')) {
      66        
      100        
      100        
94 25         418 push @$added_dependencies, App::UpdateCPANfile::Change->new(package_name => $module, version => $installed_version, path => $installed_module->pathname);
95             }
96              
97             }
98              
99 15         49 return $self->_apply_filter($added_dependencies);
100             }
101              
102             sub create_update_dependencies_changeset {
103 11     11 0 2880 my ($self) = @_;
104              
105 11         45 my $prereqs = $self->parser->prereqs;
106              
107 11         7953 my $all_phases = {};
108 11         64 for my $phase ($prereqs->phases) {
109 18         372 for my $type ($prereqs->types_in($phase)) {
110 20         558 $all_phases->{$type}++;
111             }
112             }
113              
114             # If arguments are omitted, it defaults to "runtime", "build" and "test" for phases and "requires" and "recommends" for types.
115 11         41 my $requirements = $prereqs->merged_requirements([$self->parser->prereqs->phases], [keys %$all_phases]);
116              
117 11         3779 my $added_dependencies = [];
118              
119 11         43 for my $module (sort $requirements->required_modules) {
120 33         312 my $required_version = $requirements->requirements_for_module($module);
121 33 100       1945 next if $self->_is_perl($module, $required_version);
122              
123 26         120 my $package_object = $self->package_details->package_object($module);
124 26 50       430 next unless $package_object;
125 26         281 my $latest_version = $package_object->version;
126 26 100       400 next if $self->_is_core_module($module, $latest_version);
127 23 100 66     467 if (defined $latest_version && (! defined $required_version || $required_version ne "== $latest_version") && ($latest_version ne 'undef')) {
      66        
      100        
128 17         121 push @$added_dependencies, App::UpdateCPANfile::Change->new(package_name => $module, version => $latest_version, path => $package_object->path);
129             }
130             }
131 11         53 return $self->_apply_filter($added_dependencies);
132             }
133              
134             sub _find_installed_module {
135 33     33   69 my ($self, $distributions, $module) = @_;;
136 33         63 for my $dist (@$distributions) {
137 160 100       2723 return $dist if $dist->provides_module($module);
138             }
139 4         170 return undef;
140             }
141              
142             sub _is_perl {
143 75     75   192 my ($self, $module, $installed_version) = @_;
144 75         261 return $module eq 'perl';
145             }
146              
147             sub _is_core_module {
148 59     59   249 my ($self, $module, $target_version) = @_;
149 59 50       175 return unless defined $target_version;
150              
151 59         275 my $core_version = Module::CoreList::find_version($])->{$module};
152 59 100       1858 return unless defined $core_version;
153 6         35 return $core_version eq $target_version;
154             }
155              
156             sub _apply_filter {
157 26     26   67 my ($self, $changeset) = @_;
158 26 100       92 if (my $filter = $self->options->{filter}) {
159 1         3 $changeset = [ grep { $_->package_name =~ $filter } @$changeset ];
  2         7  
160             }
161 26 100       84 if (my $ignore_filter = $self->options->{'ignore-filter'}) {
162 1         3 $changeset = [ grep { $_->package_name !~ $ignore_filter } @$changeset ];
  2         5  
163             }
164              
165 26 100       72 if ($self->options->{shuffle}) {
166 2         16 $changeset = [ shuffle(@$changeset) ];
167             }
168              
169 26 100       55 if (my $limit = $self->options->{limit}) {
170 3         8 $changeset = [ splice(@$changeset, 0, $limit) ];
171             }
172 26         274 return $changeset;
173             }
174              
175             sub _save_changes_to_file {
176 5     5   17 my ($self, $changeset) = @_;
177 5         18 my $writer = $self->writer;
178              
179 5         225 for my $change (@$changeset) {
180 11         72 for my $prereq (@{$change->prereqs}) {
  11         40  
181 33         294 $writer->add_prereq(@$prereq);
182             }
183             }
184 5         58 $writer->save($self->path);
185             }
186              
187             1;
188             __END__
189              
190             =encoding utf-8
191              
192             =head1 NAME
193              
194             App::UpdateCPANfile - cpanfile updater
195              
196             =head1 SYNOPSIS
197              
198             use App::UpdateCPANfile;
199              
200             =head1 DESCRIPTION
201              
202             App::UpdateCPANfile reads cpanfile, pin dependencies, update dependencies and write back to cpanfile.
203              
204             =head1 SEE ALSO
205              
206             L<update-cpanfile> for command-line usage.
207              
208             =head1 LICENSE
209              
210             Copyright (C) hitode909.
211              
212             This library is free software; you can redistribute it and/or modify
213             it under the same terms as Perl itself.
214              
215             =head1 AUTHOR
216              
217             hitode909 E<lt>hitode909@gmail.comE<gt>
218              
219             =cut
220