TER1 (Statement): 100.00%
TER2 (Branch): 86.36%
TER3 (LCSAJ): 100.0% (3/3)
Approximate LCSAJ segments: 23
● Covered — this LCSAJ path was executed during testing.
● Not covered — this LCSAJ path was never executed. These are the paths to focus on.
Multiple dots on a line indicate that multiple control-flow paths begin at that line. Hovering over any dot shows:
start → end → jump
Uncovered paths show [NOT COVERED] in the tooltip.
1: package App::Project::Doctor::Check::License; 2: 3: use strict; 4: use warnings; 5: use autodie qw(:all); 6: 7: use parent -norequire, 'App::Project::Doctor::Check::Base'; 8: 9: use Carp qw(croak carp); 10: use Readonly; 11: 12: our $VERSION = '0.02'; 13: 14: Readonly::Hash my %LICENSE_KEYWORD => ( 15: perl_5 => qr/same terms as perl/i, 16: gpl_2 => qr/GNU GENERAL PUBLIC LICENSE\s+Version 2/si, 17: gpl_3 => qr/GNU GENERAL PUBLIC LICENSE\s+Version 3/si, 18: lgpl_2 => qr/GNU LESSER GENERAL PUBLIC LICENSE\s+Version 2/si, 19: mit => qr/Permission is hereby granted, free of charge/i, 20: bsd => qr/Redistribution and use in source and binary forms/i, 21: artistic => qr/The Artistic License/i, 22: ); 23: 24: sub name { 'Licensing' } 25: sub description { 'A LICENSE file is present and agrees with the META declaration.' } 26: sub can_fix { 0 } 27: sub order { 45 } 28: 29: sub check { ●30 → 40 → 49 30: my ($self, $ctx) = @_; 31: croak 'check requires an App::Project::Doctor::Context' unless ref $ctx; 32: 33: my @findings; 34: 35: # 1. LICENSE file must exist (accept both spellings). 36: my $lic_file = $ctx->has_file('LICENSE') ? 'LICENSE' 37: : $ctx->has_file('LICENCE') ? 'LICENCE' 38: : undef; 39: 40: unless ($lic_file) {Mutants (Total: 1, Killed: 1, Survived: 0)
41: push @findings, _f( 42: severity => 'error', 43: message => 'No LICENSE (or LICENCE) file found.', 44: detail => 'CPAN requires a license file for all distributions.', 45: ); 46: } 47: 48: # 2. Cross-check META license field when both exist. ●49 → 50 → 66 49: my ($meta_file) = grep { $ctx->has_file($_) } qw(META.json META.yml MYMETA.json MYMETA.yml); 50: if ($lic_file && $meta_file) {
Mutants (Total: 1, Killed: 1, Survived: 0)
51: my $meta_id = _meta_license_id($ctx->abs_path($meta_file)); 52: if ($meta_id && $meta_id ne 'unknown') {
Mutants (Total: 1, Killed: 1, Survived: 0)
53: my $pattern = $LICENSE_KEYWORD{$meta_id}; 54: if ($pattern) {
Mutants (Total: 1, Killed: 1, Survived: 0)
55: my $content = $ctx->slurp($lic_file); 56: unless ($content =~ $pattern) {
Mutants (Total: 1, Killed: 1, Survived: 0)
57: push @findings, _f( 58: severity => 'warning', 59: message => "LICENSE content does not match declared license '$meta_id' in $meta_file.", 60: ); 61: } 62: } 63: } 64: } 65: ●66 → 66 → 74 66: unless (@findings) {
Mutants (Total: 1, Killed: 1, Survived: 0)
67: push @findings, _f( 68: severity => 'pass', 69: message => "LICENSE file present" 70: . ($meta_file ? ' and consistent with META.' : '.'), 71: ); 72: } 73: 74: return @findings;
Mutants (Total: 2, Killed: 2, Survived: 0)
75: } 76: 77: sub _f { 78: require App::Project::Doctor::Finding; 79: return App::Project::Doctor::Finding->new(check_name => 'Licensing', @_);
Mutants (Total: 2, Killed: 2, Survived: 0)
80: } 81: 82: sub _meta_license_id { 83: my $path = shift; 84: require CPAN::Meta; 85: my $meta = eval { CPAN::Meta->load_file($path) }; 86: return undef if $@ || !$meta;
Mutants (Total: 2, Killed: 2, Survived: 0)
87: return $meta->license;
Mutants (Total: 2, Killed: 2, Survived: 0)
88: } 89: 90: 1; 91: 92: __END__ 93: 94: =head1 NAME 95: 96: App::Project::Doctor::Check::License - Check LICENSE file presence and META agreement 97: 98: =head1 DESCRIPTION 99: 100: Verifies a C<LICENSE>/C<LICENCE> file exists. When a META file is available, 101: cross-checks the file content against the declared license identifier. 102: 103: =head3 MESSAGES 104: 105: Code | Trigger | Resolution 106: -----|-------------------------------|------------------------------------------ 107: L001 | LICENSE file absent | Add a LICENSE file matching your META value 108: L002 | LICENSE content != META value | Align file with declared license 109: 110: =head3 FORMAL SPECIFICATION 111: 112: check : Context -> [Finding] 113: check ctx == 114: let has_lic = exists LICENSE in ctx 115: mismatch = has_lic /\ (meta_lic /= undef) /\ not (content matches meta_lic) 116: in (if not has_lic then [error] else []) 117: ++ (if mismatch then [warning] else []) 118: ++ (if has_lic /\ not mismatch then [pass] else []) 119: 120: =head1 AUTHOR 121: 122: Nigel Horne C<< <njh@nigelhorne.com> >> 123: 124: =head1 LICENSE 125: 126: Copyright (C) 2026 Nigel Horne. 127: This library is free software; you can redistribute it and/or modify 128: it under the same terms as Perl itself. 129: 130: =cut