File Coverage

blib/lib/Dist/Zilla/Util/AuthorDeps.pm
Criterion Covered Total %
statement 72 87 82.7
branch 16 26 61.5
condition 3 11 27.2
subroutine 7 8 87.5
pod 0 2 0.0
total 98 134 73.1


line stmt bran cond sub pod time code
1             package Dist::Zilla::Util::AuthorDeps 6.029;
2             # ABSTRACT: Utils for listing your distribution's author dependencies
3              
4 2     2   146385 use Dist::Zilla::Pragmas;
  2         6  
  2         16  
5              
6 2     2   466 use Dist::Zilla::Util;
  2         12  
  2         72  
7 2     2   2003 use Path::Tiny;
  2         13789  
  2         149  
8 2     2   19 use List::Util 1.45 ();
  2         46  
  2         60  
9              
10 2     2   15 use namespace::autoclean;
  2         6  
  2         15  
11              
12             sub format_author_deps {
13 0     0 0 0 my ($reqs, $versions) = @_;
14              
15 0         0 my $formatted = '';
16 0         0 foreach my $rec (@{ $reqs }) {
  0         0  
17 0         0 my ($mod, $ver) = each(%{ $rec });
  0         0  
18 0 0       0 $formatted .= $versions ? "$mod = $ver\n" : "$mod\n";
19             }
20 0         0 chomp($formatted);
21 0         0 return $formatted;
22             }
23              
24             sub extract_author_deps {
25 2     2 0 180 my ($root, $missing) = @_;
26              
27 2         13 my $ini = path($root, 'dist.ini');
28              
29 2 50       183 die "dzil authordeps only works on dist.ini files, and you don't have one\n"
30             unless -e $ini;
31              
32 2         140 my $fh = $ini->openr_utf8;
33              
34 2         3447 require Config::INI::Reader;
35 2         36048 my $config = Config::INI::Reader->read_handle($fh);
36              
37 2         6126 require CPAN::Meta::Requirements;
38 2         3830 my $reqs = CPAN::Meta::Requirements->new;
39              
40 2 50       69 if (defined (my $license = $config->{_}->{license})) {
41 2         9 $license = 'Software::License::'.$license;
42 2         12 $reqs->add_minimum($license => 0);
43             }
44              
45 2         161 for my $section ( sort keys %$config ) {
46 14 100       731 if (q[_] eq $section) {
47 2         8 my $version = $config->{_}{':version'};
48 2 50       9 $reqs->add_minimum('Dist::Zilla' => $version) if $version;
49 2         148 next;
50             }
51              
52 12         22 my $pack = $section;
53 12         52 $pack =~ s{\s*/.*$}{}; # trim optional space and slash-delimited suffix
54              
55 12         19 my $version = 0;
56 12 100       43 $version = $config->{$section}->{':version'} if exists $config->{$section}->{':version'};
57              
58 12         46 my $realname = Dist::Zilla::Util->expand_config_package_name($pack);
59 12         362 $reqs->add_minimum($realname => $version);
60             }
61              
62 2         23 seek $fh, 0, 0;
63              
64 2         9 my $in_filter = 0;
65 2         38 while (<$fh>) {
66 58 50 33     239 next unless $in_filter or /^\[\s*\@Filter/;
67 0 0 0     0 $in_filter = 0, next if /^\[/ and ! /^\[\s*\@Filter/;
68 0         0 $in_filter = 1;
69              
70 0 0       0 next unless /\A-bundle\s*=\s*([^;\s]+)/;
71 0         0 my $pname = $1;
72 0         0 chomp($pname);
73 0         0 $reqs->add_minimum(Dist::Zilla::Util->expand_config_package_name($1) => 0)
74             }
75              
76 2         19 seek $fh, 0, 0;
77              
78 2         8 my @packages;
79 2         26 while (<$fh>) {
80 58         823 chomp;
81 58 100       208 next unless /\A\s*;\s*authordep\s*(\S+)\s*(?:=\s*([^;]+))?\s*/;
82 6         17 my $module = $1;
83 6   50     23 my $ver = $2 // "0";
84 6         24 $ver =~ s/\s+$//;
85             # Any "; authordep " is inserted at the beginning of the list
86             # in the file order so the user can control the order of at least a part of
87             # the plugin list
88 6         12 push @packages, $module;
89             # And added to the requirements so we can use it later
90 6         23 $reqs->add_string_requirement($module => $ver);
91             }
92              
93 2         13 my $vermap = $reqs->as_string_hash;
94             # Add the other requirements
95 2         751 push(@packages, sort keys %{ $vermap });
  2         67  
96              
97             # Move inc:: first in list as they may impact the loading of other
98             # plugins (in particular local ones).
99             # Also order inc:: so that those that want to hack @INC with inc:: plugins
100             # can have a consistent playground.
101             # We don't sort the others packages to preserve the same (random) ordering
102             # for the common case (no inc::, no '; authordep') as in previous dzil
103             # releases.
104 2         32 @packages = ((sort grep /^inc::/, @packages), (grep !/^inc::/, @packages));
105 2         28 @packages = List::Util::uniq(@packages);
106              
107 2 100       13 if ($missing) {
108 1         9 require Module::Runtime;
109              
110             @packages =
111             grep {
112 1         4 $_ eq 'perl'
113             ? ! ($vermap->{perl} && eval "use $vermap->{perl}; 1")
114 1 100 33 1   44 : do {
  1         4  
  11         567  
115 10         29 my $m = $_;
116 10         16 ! eval {
117 10         72 local @INC = @INC; push @INC, "$root";
  10         40  
118             # This will die if module is missing
119 10         38 Module::Runtime::require_module($m);
120 9         3915 my $v = $vermap->{$m};
121             # This will die if VERSION is too low
122 9 100       126 !$v || $m->VERSION($v);
123             # Success!
124 9         70 1
125             }
126             }
127             } @packages;
128             }
129              
130             # Now that we have a sorted list of packages, use that to build an array of
131             # hashrefs for display.
132 2         8 [ map { { $_ => $vermap->{$_} } } @packages ]
  12         167  
133             }
134              
135             1;
136              
137             __END__
138              
139             =pod
140              
141             =encoding UTF-8
142              
143             =head1 NAME
144              
145             Dist::Zilla::Util::AuthorDeps - Utils for listing your distribution's author dependencies
146              
147             =head1 VERSION
148              
149             version 6.029
150              
151             =head1 PERL VERSION
152              
153             This module should work on any version of perl still receiving updates from
154             the Perl 5 Porters. This means it should work on any version of perl released
155             in the last two to three years. (That is, if the most recently released
156             version is v5.40, then this module should work on both v5.40 and v5.38.)
157              
158             Although it may work on older versions of perl, no guarantee is made that the
159             minimum required version will not be increased. The version may be increased
160             for any reason, and there is no promise that patches will be accepted to lower
161             the minimum required perl.
162              
163             =head1 AUTHOR
164              
165             Ricardo SIGNES 😏 <cpan@semiotic.systems>
166              
167             =head1 COPYRIGHT AND LICENSE
168              
169             This software is copyright (c) 2022 by Ricardo SIGNES.
170              
171             This is free software; you can redistribute it and/or modify it under
172             the same terms as the Perl 5 programming language system itself.
173              
174             =cut