view release on metacpan or  search on metacpan

t/lib/INA_CPAN_Check.pm  view on Meta::CPAN

        $top_entry = $line;
        last;
    }
    ok($top_entry =~ /^\d+\.\d+\S*\s+\d{4}-\d{2}-\d{2}/
    || $top_entry =~ /^\d+\.\d+\S*\s+\d{4}-\d{2}/
    || $top_entry =~ /^\d+\.\d+\S*\s+\S+/,
       "H - latest Changes entry has VERSION + DATE format: '$top_entry'");

    my $has_body = 0;
    my $in_entry = 0;
    for my $line (@lines) {
        $line =~ s/\r?\n$//;
        if ($line =~ /^\d+\.\d+/) { $in_entry = 1; next }
        if ($in_entry && $line =~ /^\s+\S/) { $has_body = 1; last }
        last if $in_entry && $line =~ /^\d+\.\d+/;
    }
    ok($has_body, 'H - latest Changes entry has indented description body');
}

sub count_H { return 3 }

######################################################################
# Category I: Makefile.PL
######################################################################

sub check_I {
    my ($root) = @_;
    my $text = _slurp("$root/Makefile.PL");
    ok($text =~ /WriteMakefile\s*\(/, 'I - Makefile.PL calls WriteMakefile()');
    ok($text =~ /'NAME'/ && $text =~ /'VERSION'/,
       'I - Makefile.PL contains NAME and VERSION keys');
    ok($text =~ /ina\@cpan\.org/, 'I - Makefile.PL AUTHOR contains ina@cpan.org');
}

sub count_I { return 3 }

######################################################################
# Category J: Consistency
# Accepts optional overrides:
#   j2_stale => [ list of stale strings to check for ]
######################################################################

sub check_J {
    my ($root, %opt) = @_;
    my @manifest = _manifest_files($root);
    my @pm_files = sort grep { /^lib\/.*\.pm$/ && -f "$root/$_" } @manifest;
    my @t_files  = sort grep { /\.t$/  && -f "$root/$_" } @manifest;
    my $meta_yml = _slurp("$root/META.yml");

    # J1: no PREREQ_PM dep version equals module VERSION
    my $pm_ver = _pm_version("$root/$pm_files[0]") if @pm_files;
    my $j1 = 1;
    if ($meta_yml =~ /^requires:(.*?)(?=^\S)/ms) {
        my $block = $1;
        while ($block =~ /:\s*([\d._]+)/g) {
            if (defined $pm_ver && $1 eq $pm_ver) { $j1 = 0; last }
        }
    }
    ok($j1, 'J - PREREQ_PM: no core dep version equals module VERSION');

    # J2: BUGS AND LIMITATIONS has no stale entries
    my @stale = exists $opt{j2_stale} ? @{$opt{j2_stale}} : ();
    my $bugs_text = '';
    if (@pm_files) {
        my $pm_text = _slurp("$root/$pm_files[0]");
        if ($pm_text =~ /=head1 BUGS AND LIMITATIONS(.*?)^=head1/ms) {
            $bugs_text = $1;
        }
    }
    my $j2 = 1;
    for my $entry (@stale) {
        if (index($bugs_text, $entry) >= 0) { $j2 = 0; last }
    }
    ok($j2, 'J - BUGS AND LIMITATIONS: no stale removed-feature entries');

    # J3+J4: test file plan vs ok-comment count
    for my $tf (@t_files) {
        my @lines = _slurp_lines("$root/$tf");
        my @ok_comments;
        my $plan = undef;
        for my $line (@lines) {
            $line =~ s/\r?\n$//;
            push @ok_comments, $1 if $line =~ /^#\s+ok\s+(\d+)\b/;
            $plan = $1 if !defined $plan && $line =~ /^1\.\.(\d+)$/;
        }
        my %seen;
        my $unique = !grep { $seen{$_}++ } @ok_comments;
        ok($unique, "J - $tf: # ok N comments are unique");
        if (defined $plan) {
            ok(scalar(@ok_comments) <= $plan,
               "J - $tf: # ok comment count(" . scalar(@ok_comments) .
               ") does not exceed plan($plan)");
        }
        else {
            ok(1, "J - $tf: no plan line (skip/dynamic)");
        }
    }
}

sub count_J {
    my ($root) = @_;
    my @manifest = _manifest_files($root);
    my @t_files  = grep { /\.t$/ && -f "$root/$_" } @manifest;
    return 1 + 1 + 2 * scalar(@t_files);
}

######################################################################
# Category K: Coding Style
# Accepts optional overrides:
#   k3_exempt => 'regex-alternation-string'  (e.g. 'sch\b|outer_row\b')
######################################################################

sub check_K {
    my ($root, %opt) = @_;
    my @manifest = _manifest_files($root);
    my @pm_files = sort grep { /^lib\/.*\.pm$/ && -f "$root/$_" } @manifest;
    my $k3_exempt = exists $opt{k3_exempt}
        ? $opt{k3_exempt}
        : 'env\\b|opts\\b|args\\b';

    for my $pm (@pm_files) {
        my $text = _slurp("$root/$pm");
        $text =~ s/\n__END__\b.*\z//s;
        $text =~ s/^=[a-zA-Z].*?^=cut[ \t]*$//msg;
        my @lines = split /\n/, $text;
        my $n = 0;

                        # K1: comma followed by space
        my @k1_bad;
        {
            my $lineno = 0;
            for my $raw_line (split /\n/, $text) {
                $lineno++;
                my $s = $raw_line;