File Coverage

File:	blib/lib/App/Test/Generator/Model/Method.pm
Coverage:	97.8%

line	stmt	bran	cond	sub	time	code
1						package App::Test::Generator::Model::Method;
2
3	25 25 25			25	130364 23 324	use strict;
4	25 25 25			25	41 20 542	use warnings;
5
6	25 25 25			25	39 23 486	use Carp qw(croak);
7	25 25 25			25	4049 32987 12471	use Readonly;
8
9						Readonly my $HIGH_CONFIDENCE_THRESHOLD => 40;
10						Readonly my $MEDIUM_CONFIDENCE_THRESHOLD => 20;
11
12						our $VERSION = '0.36';
13
14 - 18						=head1 VERSION Version 0.36 =cut
19
20						sub new {
21	376			376	265540	my ($class, %args) = @_;
22	376	100			461	croak 'name required' unless defined $args{name};
23	374	100			380	croak 'source required' unless defined $args{source};
24
25						my $self = {
26						name => $args{name},
27						source => $args{source},
28						# parameters => [],
29	372				872	evidence => [],
30						return_type => undef,
31						classification => undef,
32						confidence => undef,
33						};
34
35	372				597	return bless $self, $class;
36						}
37
38						# Read-only accessors â€” name and source are immutable after construction
39	9			9	332	sub name { $_[0]->{name} }
40	275			275	333	sub source { $_[0]->{source} }
41
42						sub return_type {
43	26			26	32	my ($self, $val) = @_;
44	26	100			27	$self->{return_type} = $val if @_ > 1;
45	26				37	return $self->{return_type};
46						}
47
48						sub classification {
49	281			281	319	my ($self, $val) = @_;
50	281	100			339	$self->{classification} = $val if @_ > 1;
51	281				399	return $self->{classification};
52						}
53
54						sub confidence {
55	280			280	245	my ($self, $val) = @_;
56	280	100			230	$self->{confidence} = $val if @_ > 1;
57	280				500	return $self->{confidence};
58						}
59
60						sub add_evidence {
61	538			538	3510	my ($self, %args) = @_;
62
63						# Validate category â€” must be one of the three recognised kinds
64	538 1614				874 1540	my %valid_categories = map { $_ => 1 } qw(return input effect);
65
66	538		100		635	my $cat = $args{category} // '';
67	538	100			510	croak "Invalid evidence category '$cat'" unless $valid_categories{$cat};
68
69						# Validate signal â€” must be a known signal name to catch typos early.
70						# Signals are per-category; we validate the full set across all categories.
71	534 5874				532 4668	my %valid_signals = map { $_ => 1 } qw(
72						returns_property returns_constant returns_self
73						legacy_type context_aware error_pattern
74						input_validated input_typed input_optional
75						has_side_effect no_side_effect
76						);
77
78	534		100		619	my $sig = $args{signal} // '';
79	534	100			499	croak "Invalid evidence signal '$sig'" unless $valid_signals{$sig};
80
81	530				1814	push @{ $self->{evidence} }, {
82						category => $args{category},
83						signal => $args{signal},
84						value => $args{value},
85	530	100			310	weight => defined $args{weight} ? $args{weight} : 1,
86						};
87						}
88
89						sub evidence {
90	33			33	598	my $self = $_[0];
91	33 33				17 49	return @{ $self->{evidence} };
92						}
93
94						sub evidence_ref {
95	4			4	585	my $self = $_[0];
96	4				4	return $self->{evidence};
97						}
98
99						sub resolve_return_type {
100	296			296	225	my $self = $_[0];
101	296				449	my %score = (property => 0, constant => 0, object => 0);
102
103	296 296				211 324	for my $ev (@{ $self->{evidence} }) {
104	480	100			521	next unless $ev->{category} eq 'return';
105	476	100 100 100 100 100 50			717	if($ev->{signal} eq 'returns_property') {
106	32				32	$score{property} += $ev->{weight};
107						} elsif($ev->{signal} eq 'returns_constant') {
108	152				159	$score{constant} += $ev->{weight};
109						} elsif($ev->{signal} eq 'returns_self') {
110	21				16	$score{object} += $ev->{weight};
111						} elsif($ev->{signal} eq 'legacy_type') {
112						# Legacy type hint â€” map to nearest score bucket if recognisable
113	251		50		327	my $t = $ev->{value} // '';
114	251 24	100 100			289 30	if($t eq 'object') { $score{object} += $ev->{weight} }
115	1				1	elsif($t eq 'self') { $score{object} += $ev->{weight} }
116	226				251	else { $score{property} += $ev->{weight} }
117						} elsif($ev->{signal} eq 'context_aware') {
118						# Context-aware return suggests getter behaviour
119	6				5	$score{property} += $ev->{weight};
120						} elsif($ev->{signal} eq 'error_pattern') {
121						# Error pattern return doesn't strongly imply a type â€”
122						# give a small nudge toward property (scalar return)
123	14				13	$score{property} += $ev->{weight};
124						}
125						# Unknown signals are ignored â€” they may be used by external consumers
126						}
127
128						# Tie-break alphabetically â€” deterministic but arbitrary
129	296 801	50	100 100		548 1612	my ($winner) = sort { ($score{$b} \|\| 0) <=> ($score{$a} \|\| 0) \|\| $a cmp $b } keys %score;
130
131	296		50		378	$self->{return_type} = $winner \|\| 'unknown';
132	296				410	return $self->{return_type};
133						}
134
135						sub resolve_confidence {
136	280			280	195	my $self = $_[0];
137
138	280				202	my $total = 0;
139	280 280				222 447	$total += $_->{weight} for @{ $self->{evidence} };
140
141	280	100 100			379	my $level = $total >= $HIGH_CONFIDENCE_THRESHOLD ? 'high' : $total >= $MEDIUM_CONFIDENCE_THRESHOLD ? 'medium' : 'low';
142
143	280				1239	$self->{confidence} = { score => $total, level => $level };
144
145	280				279	return $self->{confidence};
146						}
147
148						sub resolve_classification {
149	279			279	202	my $self = $_[0];
150
151						# Return_type must be resolved before classification can be determined
152	279	100			313	$self->resolve_return_type() unless defined $self->{return_type};
153
154	279	100 100 100			399	if($self->{return_type} eq 'object') {
155	28				31	$self->{classification} = 'chainable';
156						} elsif ($self->{return_type} eq 'property') {
157	230				230	$self->{classification} = 'getter';
158						} elsif ($self->{return_type} eq 'constant') {
159	19				19	$self->{classification} = 'constant';
160						} else {
161	2				2	$self->{classification} = 'unknown';
162						}
163
164	279				252	return $self->{classification};
165						}
166
167						sub absorb_legacy_output {
168	285			285	332	my ($self, $output) = @_;
169
170	285	100	100		508	return unless $output && ref $output eq 'HASH';
171
172	281	100			317	if ($output->{type}) {
173						$self->add_evidence(
174						category => 'return',
175						signal => 'legacy_type',
176						value => $output->{type},
177	252				337	weight => 20,
178						);
179						}
180
181	281	100			315	if ($output->{_returns_self}) {
182	9				7	$self->add_evidence(
183						category => 'return',
184						signal => 'returns_self',
185						weight => 25,
186						);
187						}
188
189	281	100			305	if ($output->{_context_aware}) {
190	9				10	$self->add_evidence(
191						category => 'return',
192						signal => 'context_aware',
193						weight => 15,
194						);
195						}
196
197	281	100			359	if ($output->{_error_return}) {
198						$self->add_evidence(
199						category => 'return',
200						signal => 'error_pattern',
201						value => $output->{_error_return},
202	17				16	weight => 15,
203						);
204						}
205						}
206
207						1;