| File: | blib/lib/App/Test/Generator/Analyzer/Complexity.pm |
| Coverage: | 98.5% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package App::Test::Generator::Analyzer::Complexity; | |||||
| 2 | ||||||
| 3 | 31 31 31 | 68260 27 396 | use strict; | |||
| 4 | 31 31 31 | 49 23 506 | use warnings; | |||
| 5 | 31 31 31 | 43 29 9285 | use Readonly; | |||
| 6 | ||||||
| 7 | # -------------------------------------------------- | |||||
| 8 | # Base cyclomatic complexity score before any analysis | |||||
| 9 | # -------------------------------------------------- | |||||
| 10 | Readonly my $CYCLOMATIC_BASE => 1; | |||||
| 11 | ||||||
| 12 | # -------------------------------------------------- | |||||
| 13 | # Complexity level thresholds — scores at or below | |||||
| 14 | # LOW_THRESHOLD are low, at or below HIGH_THRESHOLD | |||||
| 15 | # are moderate, above HIGH_THRESHOLD are high | |||||
| 16 | # -------------------------------------------------- | |||||
| 17 | Readonly my $LOW_THRESHOLD => 3; | |||||
| 18 | Readonly my $HIGH_THRESHOLD => 7; | |||||
| 19 | ||||||
| 20 | # -------------------------------------------------- | |||||
| 21 | # Complexity level labels | |||||
| 22 | # -------------------------------------------------- | |||||
| 23 | Readonly my $LEVEL_LOW => 'low'; | |||||
| 24 | Readonly my $LEVEL_MODERATE => 'moderate'; | |||||
| 25 | Readonly my $LEVEL_HIGH => 'high'; | |||||
| 26 | ||||||
| 27 | # -------------------------------------------------- | |||||
| 28 | # Keywords that introduce branching decision points | |||||
| 29 | # -------------------------------------------------- | |||||
| 30 | Readonly my @BRANCH_TOKENS => qw( | |||||
| 31 | if elsif unless for foreach while until given when | |||||
| 32 | ); | |||||
| 33 | ||||||
| 34 | # -------------------------------------------------- | |||||
| 35 | # Keywords that introduce exception or error paths | |||||
| 36 | # -------------------------------------------------- | |||||
| 37 | Readonly my @EXCEPTION_TOKENS => qw( | |||||
| 38 | die croak confess try catch eval | |||||
| 39 | ); | |||||
| 40 | ||||||
| 41 | our $VERSION = '0.41'; | |||||
| 42 | ||||||
| 43 - 82 | =head1 VERSION
Version 0.41
=head1 DESCRIPTION
Analyses the source body of a method and produces a complexity report
including cyclomatic score, branching points, early returns, exception
paths, and nesting depth. Used by L<App::Test::Generator> to guide test
planning — higher complexity methods are prioritised for more thorough
test generation.
=head2 new
Construct a new Complexity analyser.
my $analyser = App::Test::Generator::Analyzer::Complexity->new;
=head3 Arguments
None.
=head3 Returns
A blessed hashref.
=head3 API specification
=head4 input
{}
=head4 output
{
type => OBJECT,
isa => 'App::Test::Generator::Analyzer::Complexity',
}
=cut | |||||
| 83 | ||||||
| 84 | 334 | 121267 | sub new { bless {}, shift } | |||
| 85 | ||||||
| 86 - 162 | =head2 analyze
Analyse the source of a method and return a complexity report hashref.
my $analyser = App::Test::Generator::Analyzer::Complexity->new;
my $report = $analyser->analyze($method);
printf "Cyclomatic score: %d\n", $report->{cyclomatic_score};
printf "Complexity level: %s\n", $report->{complexity_level};
=head3 Arguments
=over 4
=item * C<$method>
A hashref describing the method, as built internally by
L<App::Test::Generator::SchemaExtractor>. The method source is read
from its C<body> key (a plain string of Perl source); this is I<not>
an L<App::Test::Generator::Model::Method> object.
=back
=head3 Returns
A hashref with the following keys:
=over 4
=item * C<cyclomatic_score> — integer starting at 1, incremented for
each branching point, logical operator, early return, and exception path.
=item * C<branching_points> — count of branching keywords found.
=item * C<early_returns> — number of C<return> statements beyond the
first (each additional return adds a path).
=item * C<exception_paths> — count of exception-related keywords found.
=item * C<nesting_depth> — maximum brace nesting depth observed.
=item * C<complexity_level> — one of C<low>, C<moderate>, or C<high>
based on the cyclomatic score.
=back
=head3 Notes
Nesting depth is computed by naive brace counting and will be
inaccurate if the source contains braces inside strings or regexes.
This is a known limitation and is acceptable for dashboard display
purposes.
=head3 API specification
=head4 input
{
self => { type => OBJECT, isa => 'App::Test::Generator::Analyzer::Complexity' },
method => { type => HASHREF, keys => { body => { type => SCALAR, optional => 1 } } },
}
=head4 output
{
type => HASHREF,
keys => {
cyclomatic_score => { type => SCALAR },
branching_points => { type => SCALAR },
early_returns => { type => SCALAR },
exception_paths => { type => SCALAR },
nesting_depth => { type => SCALAR },
complexity_level => { type => SCALAR },
},
}
=cut | |||||
| 163 | ||||||
| 164 | sub analyze { | |||||
| 165 | 336 | 9343 | my ($self, $method) = @_; | |||
| 166 | ||||||
| 167 | # The method argument is a raw hashref from SchemaExtractor, | |||||
| 168 | # not a Model::Method object — access the body key directly | |||||
| 169 | 336 | 348 | my $body = $method->{body} // ''; | |||
| 170 | ||||||
| 171 | # Branch/logic/exception keywords and the ?/&&/|| operators are | |||||
| 172 | # only real decision points as actual code; the same characters | |||||
| 173 | # inside a string literal (e.g. "Are you sure?") or a comment | |||||
| 174 | # must not inflate the cyclomatic score | |||||
| 175 | 336 | 297 | my $code_only = _strip_strings_and_comments($body); | |||
| 176 | ||||||
| 177 | 336 | 424 | my %result = ( | |||
| 178 | cyclomatic_score => $CYCLOMATIC_BASE, | |||||
| 179 | branching_points => 0, | |||||
| 180 | early_returns => 0, | |||||
| 181 | exception_paths => 0, | |||||
| 182 | nesting_depth => 0, | |||||
| 183 | ); | |||||
| 184 | ||||||
| 185 | # -------------------------------------------------- | |||||
| 186 | # Count branching keywords — each one introduces a | |||||
| 187 | # new decision point that increases cyclomatic complexity | |||||
| 188 | # -------------------------------------------------- | |||||
| 189 | 336 | 1226 | for my $token (@BRANCH_TOKENS) { | |||
| 190 | 3024 | 6865 | my $count = () = $code_only =~ /\b$token\b/g; | |||
| 191 | 3024 | 13111 | $result{branching_points} += $count; | |||
| 192 | 3024 | 2950 | $result{cyclomatic_score} += $count; | |||
| 193 | } | |||||
| 194 | ||||||
| 195 | # Logical operators also introduce implicit branches | |||||
| 196 | 336 | 956 | my $logic_count = () = $code_only =~ /&&|\|\||\?/g; | |||
| 197 | 336 | 257 | $result{cyclomatic_score} += $logic_count; | |||
| 198 | ||||||
| 199 | # -------------------------------------------------- | |||||
| 200 | # Early returns — each return beyond the first adds | |||||
| 201 | # an additional exit path through the method | |||||
| 202 | # -------------------------------------------------- | |||||
| 203 | 336 | 526 | my $return_count = () = $code_only =~ /\breturn\b/g; | |||
| 204 | 336 | 380 | $result{early_returns} = $return_count > 1 ? $return_count - 1 : 0; | |||
| 205 | 336 | 261 | $result{cyclomatic_score} += $result{early_returns}; | |||
| 206 | ||||||
| 207 | # -------------------------------------------------- | |||||
| 208 | # Exception paths — die/croak/eval etc. each introduce | |||||
| 209 | # a path that must be tested separately | |||||
| 210 | # -------------------------------------------------- | |||||
| 211 | 336 | 343 | for my $token (@EXCEPTION_TOKENS) { | |||
| 212 | 2016 | 4219 | my $count = () = $code_only =~ /\b$token\b/g; | |||
| 213 | 2016 | 7453 | $result{exception_paths} += $count; | |||
| 214 | 2016 | 1871 | $result{cyclomatic_score} += $count; | |||
| 215 | } | |||||
| 216 | ||||||
| 217 | # -------------------------------------------------- | |||||
| 218 | # Nesting depth — count brace depth by scanning chars. | |||||
| 219 | # NOTE: this is naive and will overcount if braces | |||||
| 220 | # appear inside strings or regexes. Acceptable for | |||||
| 221 | # dashboard display purposes. | |||||
| 222 | # -------------------------------------------------- | |||||
| 223 | 336 | 641 | my $depth = 0; | |||
| 224 | 336 | 237 | my $max_depth = 0; | |||
| 225 | 336 | 1453 | for my $char (split //, $body) { | |||
| 226 | 24134 | 18126 | if($char eq '{') { | |||
| 227 | 510 | 303 | $depth++; | |||
| 228 | 510 | 492 | $max_depth = $depth if $depth > $max_depth; | |||
| 229 | } elsif($char eq '}') { | |||||
| 230 | 510 | 497 | $depth-- if $depth > 0; | |||
| 231 | } | |||||
| 232 | } | |||||
| 233 | 336 | 798 | $result{nesting_depth} = $max_depth; | |||
| 234 | ||||||
| 235 | # -------------------------------------------------- | |||||
| 236 | # Classify complexity level based on cyclomatic score | |||||
| 237 | # -------------------------------------------------- | |||||
| 238 | 336 | 262 | my $score = $result{cyclomatic_score}; | |||
| 239 | $result{complexity_level} = | |||||
| 240 | 336 | 402 | $score <= $LOW_THRESHOLD ? $LEVEL_LOW : | |||
| 241 | $score <= $HIGH_THRESHOLD ? $LEVEL_MODERATE : | |||||
| 242 | $LEVEL_HIGH; | |||||
| 243 | ||||||
| 244 | 336 | 1628 | return \%result; | |||
| 245 | } | |||||
| 246 | ||||||
| 247 | # -------------------------------------------------- | |||||
| 248 | # Purpose: blank out the contents of '...' and "..." string | |||||
| 249 | # literals and # line comments so that the keyword | |||||
| 250 | # and operator counts above only see real code, not | |||||
| 251 | # words/punctuation that merely appear inside a | |||||
| 252 | # message or comment. | |||||
| 253 | # Entry: a raw source body string. | |||||
| 254 | # Exit: the same string with string-literal contents and | |||||
| 255 | # comment text removed. | |||||
| 256 | # Side effects: none. Best-effort only — does not handle q//, | |||||
| 257 | # qq//, heredocs, or quote-like operators with custom | |||||
| 258 | # delimiters. | |||||
| 259 | # -------------------------------------------------- | |||||
| 260 | sub _strip_strings_and_comments { | |||||
| 261 | 342 | 2307 | my ($body) = @_; | |||
| 262 | ||||||
| 263 | 342 | 476 | $body =~ s/"(?:[^"\\]|\\.)*"//g; | |||
| 264 | 342 | 327 | $body =~ s/'(?:[^'\\]|\\.)*'//g; | |||
| 265 | 342 | 264 | $body =~ s/#.*$//mg; | |||
| 266 | ||||||
| 267 | 342 | 291 | return $body; | |||
| 268 | } | |||||
| 269 | ||||||
| 270 | 1; | |||||