our
$VERSION
=
'0.04'
;
with
qw(
)
;
has
cpan_audit
=> (
is
=>
'ro'
,
isa
=>
'Bool'
,
default
=> 0,
);
has
filename
=> (
is
=>
'ro'
,
isa
=>
'Str'
,
default
=>
'cpanfile'
,
);
has
comment
=> (
is
=>
'ro'
,
isa
=>
'ArrayRef[Str]'
,
default
=>
sub
{
[
(
sprintf
'This file is generated by %s v%s'
, __PACKAGE__, __PACKAGE__->VERSION //
'<internal>'
),
'Do not edit this file directly. To change prereqs, edit the `dist.ini` file.'
,
]
}
);
sub
mvp_multivalue_args {
qw( comment )
}
sub
after_build {
my
(
$self
) =
@_
;
my
$content
=
$self
->_get_cpanfile();
path(
$self
->filename )->spew_raw(
$content
);
}
sub
_get_cpanfile {
my
(
$self
) =
@_
;
my
$audit
= CPAN::Audit->new;
my
$zilla
=
$self
->zilla;
my
$prereqs
=
$zilla
->prereqs;
my
@types
=
qw(requires recommends suggests conflicts)
;
my
@phases
=
qw(runtime build test configure develop)
;
my
$str
=
join
"\n"
, (
map
{
"# $_"
} @{
$self
->comment } ),
''
,
''
;
for
my
$phase
(
@phases
) {
my
$prefix
=
$phase
eq
'runtime'
?
''
: (
sprintf
"\non '%s' => sub {\n"
,
$phase
);
my
$postfix
=
$phase
eq
'runtime'
?
''
:
"};\n"
;
my
$indent
=
$phase
eq
'runtime'
?
''
:
' '
;
for
my
$type
(
@types
) {
my
$req
=
$prereqs
->requirements_for(
$phase
,
$type
);
next
unless
$req
->required_modules;
$str
.=
$prefix
;
for
my
$module
(
sort
$req
->required_modules ) {
my
$version
=
$req
->requirements_for_module(
$module
) || 0;
my
(
$min_version
,
$advisories
);
if
(
$self
->cpan_audit ) {
(
$min_version
,
$advisories
) = _audit(
$audit
,
$module
,
$version
);
}
if
(
$advisories
&&
$version
=~ m{(>|<|>=|<=|!=|==)} ) {
if
(
defined
$min_version
&& !
$req
->accepts_module(
$module
,
$min_version
) ) {
$self
->
log
(
"Range '$version' for $module does not include latest fixed version ($min_version)!"
);
}
elsif
(
defined
$min_version
) {
$self
->
log
(
"Current version range includes vulnerable versions. Consider updating the minimum to $min_version"
)
}
}
elsif
(
$advisories
) {
my
$vuln_version_requested
=
$min_version
&& (
version->new(
$version
) < version->new(
$min_version
)
);
if
(
$version
== 0 &&
$vuln_version_requested
) {
$version
=
$min_version
;
}
elsif
(
$vuln_version_requested
) {
$self
->
log
(
"Prereq $module $version is vulnerable"
);
}
}
$str
.=
sprintf
qq~%s%s "%s" => "%s";\n~
,
$indent
,
$type
,
$module
,
$version
;
}
$str
.=
$postfix
;
}
}
return
$str
;
}
sub
_audit {
my
(
$audit
,
$module
,
$version
) =
@_
;
my
$result
=
$audit
->command(
'module'
,
$module
,
$version
);
my
(
$module_data
) =
values
%{
$result
->{dists} || {} };
my
@advisories
= @{
$module_data
->{advisories} || [] };
my
@versions
;
for
my
$advisory
(
@advisories
) {
my
(
$fixed_version
) = (
$advisory
->{fixed_versions} //
''
) =~ m{(v?[0-9]+(?:\.[0-9]+){0,2})};
next
if
!
$fixed_version
;
my
$version_object
= version->new(
$fixed_version
);
push
@versions
,
$version_object
;
}
my
(
$min_version
) =
sort
{
$b
<=>
$a
}
@versions
;
return
(
$min_version
,
scalar
@advisories
);
}
__PACKAGE__->meta->make_immutable;
1;