File Coverage

File:blib/lib/App/Project/Doctor/Check/CpanReadiness.pm
Coverage:96.8%

linestmtbrancondsubtimecode
1package App::Project::Doctor::Check::CpanReadiness;
2
3
3
3
3
3
8
3
42
use strict;
4
3
3
3
3
6
2
77
use warnings;
5
3
3
3
3
7
3
10
use autodie qw(:all);
6
7
3
3
3
3
6548
2
17
use parent -norequire, 'App::Project::Doctor::Check::Base';
8
9
3
3
3
3
100
5
86
use Carp qw(croak carp);
10
3
3
3
3
7
3
1385
use Readonly;
11
12our $VERSION = '0.02';
13
14Readonly::Scalar my $VERSION_RE    => qr/^\d+\.\d+(?:\.\d+)?(?:_\d+)?$/;
15# Changes and MANIFEST must use these exact names; README accepts variants below.
16Readonly::Array  my @REQUIRED_FILES  => qw(Changes MANIFEST);
17# CPAN and GitHub both accept any of these forms as the distribution README.
18Readonly::Array  my @README_VARIANTS => qw(README README.md README.pod README.rst README.txt);
19
20
4
4
206
sub name        { 'CPAN Readiness' }
21
1
1
2
sub description { 'Version format, Changes, MANIFEST, and a README variant are present.' }
22
2
2
5
sub can_fix     { 0 }
23
2
2
4
sub order       { 90 }
24
25sub check {
26
32
32
34
        my ($self, $ctx) = @_;
27
32
50
37
        croak 'check requires an App::Project::Doctor::Context' unless ref $ctx;
28
29
32
25
        my @findings;
30
31        # Version format check.
32
32
35
        my $version = _read_version($ctx);
33
32
100
43
        if (defined $version) {
34
25
100
92
                if ($version !~ $VERSION_RE) {
35
5
11
                        push @findings, _f(
36                                severity => 'error',
37                                message  => "Version '$version' does not match CPAN format (X.YY or X.YY.ZZ).",
38                        );
39                }
40        } else {
41
7
12
                push @findings, _f(
42                        severity => 'warning',
43                        message  => 'Could not determine distribution version from any module.',
44                );
45        }
46
47        # Required release files (exact names required by CPAN toolchain).
48
32
57
        for my $file (@REQUIRED_FILES) {
49
64
100
183
                unless ($ctx->has_file($file)) {
50
22
52
                        push @findings, _f(
51                                severity => 'error',
52                                message  => "'$file' is missing from the distribution root.",
53                        );
54                }
55        }
56
57        # README is required but any common variant is acceptable.  README.md is the
58        # norm on GitHub; CPAN itself accepts all of these without complaint.
59
32
160
100
85
193
        unless (grep { $ctx->has_file($_) } @README_VARIANTS) {
60
12
13
                push @findings, _f(
61                        severity => 'error',
62                        message  => 'README is missing -- none of ' . join(', ', @README_VARIANTS) . ' found.',
63                );
64        }
65
66        # Changes file must have at least one version entry.
67
32
100
61
        if ($ctx->has_file('Changes')) {
68
21
26
                my $content = $ctx->slurp('Changes');
69
21
100
67
66
                unless ($content =~ /^\d+\.\d+/m || $content =~ /^v\d+/m) {
70
1
2
                        push @findings, _f(
71                                severity => 'warning',
72                                message  => 'Changes file has no version entries.',
73                                file     => 'Changes',
74                        );
75                }
76        }
77
78        # MANIFEST stale-check requires 'make manifest' -- too invasive; just advise.
79
32
100
39
        if ($ctx->has_file('MANIFEST')) {
80
21
58
                push @findings, _f(
81                        severity => 'info',
82                        message  => "MANIFEST present -- run 'make manifest' to verify it is not stale.",
83                );
84        }
85
86        # Emit a pass only when there are no errors or warnings.
87
32
68
33
63
        my $has_problem = grep { $_->severity =~ /^(?:error|warning)$/ } @findings;
88
32
100
35
        unless ($has_problem) {
89
15
17
                push @findings, _f(
90                        severity => 'pass',
91                        message  => 'Distribution meets basic CPAN readiness requirements.',
92                );
93        }
94
95
32
60
        return @findings;
96}
97
98# ---------------------------------------------------------------------------
99# Private helpers
100# ---------------------------------------------------------------------------
101
102sub _f {
103
83
83
263
        require App::Project::Doctor::Finding;
104
83
157
        return App::Project::Doctor::Finding->new(check_name => 'CPAN Readiness', @_);
105}
106
107sub _read_version {
108
33
33
26
        my $ctx = shift;
109
33
33
28
53
        for my $mod (@{ $ctx->lib_modules }) {
110
27
27
50
23
37
                my $content = eval { $ctx->slurp($mod) } // next;
111
27
100
99
                if (my ($v) = $content =~ /^\s*our\s+\$VERSION\s*=\s*['"]?([^'";\s]+)['"]?/m) {
112
26
43
                        return $v;
113                }
114        }
115
7
9
        return undef;
116}
117
1181;
119