File Coverage

File:blib/lib/App/Test/Generator/Sample/Module.pm
Coverage:98.3%

linestmtbrancondsubtimecode
1package App::Test::Generator::Sample::Module;
2
3
1
1
1
1
385
1
12
use strict;
4
1
1
1
1
1
1
18
use warnings;
5
1
1
1
1
2
0
16
use Carp    qw(croak);
6
1
1
1
1
1
1
373
use Readonly;
7
8our $VERSION = '0.41';
9
10# --------------------------------------------------
11# Validation constants — centralised so that changes
12# to limits only need to be made in one place
13# --------------------------------------------------
14Readonly my $MIN_EMAIL_LEN  => 5;
15Readonly my $MAX_EMAIL_LEN  => 254;
16Readonly my $MIN_BIRTH_YEAR => 1900;
17Readonly my $MIN_NAME_LEN   => 1;
18Readonly my $MAX_NAME_LEN   => 50;
19Readonly my $MIN_SCORE      => 0.0;
20Readonly my $MAX_SCORE      => 100.0;
21Readonly my $PASS_THRESHOLD => 60.0;
22
23 - 65
=head1 NAME

App::Test::Generator::Sample::Module - Example module for schema extraction testing

=head1 VERSION

Version 0.41

=head1 SYNOPSIS

    use App::Test::Generator::Sample::Module;

    my $obj = App::Test::Generator::Sample::Module->new();
    my $result = $obj->validate_email('user@example.com');

=head1 DESCRIPTION

A sample module with a variety of well and poorly documented methods,
used to exercise L<App::Test::Generator::SchemaExtractor>. The methods
cover common parameter types, validation patterns, and confidence levels
so that the extractor's heuristics can be tested against known inputs.

=head2 new

Constructor. Returns a new instance.

    my $obj = App::Test::Generator::Sample::Module->new();

=head3 Returns

A blessed hashref.

=head3 API specification

=head4 input

    { class => { type => SCALAR } }

=head4 output

    { type => OBJECT, isa => 'App::Test::Generator::Sample::Module' }

=cut
66
67sub new {
68
11
11
19288
        my $class = $_[0];
69
70        # Bless an empty hashref into the calling class
71
11
14
        return bless {}, $class;
72}
73
74 - 107
=head2 validate_email

Validate an email address against basic structural rules.

    my $ok = $obj->validate_email('user@example.com');

=head3 Arguments

=over 4

=item * C<$email>

String (C<$MIN_EMAIL_LEN>-C<$MAX_EMAIL_LEN> chars). Required.

=back

=head3 Returns

1 if the address is valid. Croaks on any validation failure.

=head3 API specification

=head4 input

    {
        self  => { type => OBJECT, isa => 'App::Test::Generator::Sample::Module' },
        email => { type => SCALAR, min => 5, max => 254 },
    }

=head4 output

    { type => SCALAR, value => 1 }

=cut
108
109sub validate_email {
110
7
7
1771
        my ($self, $email) = @_;
111
112        # Presence check before length checks to give a clear error
113
7
100
24
        croak 'Email is required' unless defined $email;
114
6
100
13
        croak 'Email too short'   unless length($email) >= $MIN_EMAIL_LEN;
115
4
100
17
        croak 'Email too long'    unless length($email) <= $MAX_EMAIL_LEN;
116
117        # Basic structural check — one @ with non-empty local and domain parts
118
3
100
27
        croak 'Invalid email format'
119                unless $email =~ /^[^@]+\@[^@]+\.[^@]+$/;
120
121
2
5
        return 1;
122}
123
124 - 157
=head2 calculate_age

Calculate age in years from a birth year.

    my $age = $obj->calculate_age(1985);

=head3 Arguments

=over 4

=item * C<$birth_year>

A birth year value (C<$MIN_BIRTH_YEAR> to current year). Required.

=back

=head3 Returns

Age in years as an integer.

=head3 API specification

=head4 input

    {
        self       => { type => OBJECT, isa => 'App::Test::Generator::Sample::Module' },
        birth_year => { type => SCALAR, min => 1900 },
    }

=head4 output

    { type => SCALAR }

=cut
158
159sub calculate_age {
160
6
6
5495
        my ($self, $birth_year) = @_;
161
162        # Get the current year from the system clock rather than using
163        # a hardcoded value that would become stale each year
164
6
44
        my $current_year = (localtime)[5] + 1900;
165
166
6
100
16
        croak 'Birth year required'          unless defined $birth_year;
167
5
100
21
        croak 'Birth year must be a number'  unless $birth_year =~ /^\d+$/;
168
169        # Upper bound is the current year — you cannot be born in the future
170
4
100
100
7
        croak 'Birth year out of range'
171                unless $birth_year >= $MIN_BIRTH_YEAR && $birth_year <= $current_year;
172
173
2
12
        return $current_year - $birth_year;
174}
175
176 - 209
=head2 process_names

Process a list of names and return the count of non-empty entries.

    my $count = $obj->process_names(['Alice', 'Bob', '']);

=head3 Arguments

=over 4

=item * C<$names>

Arrayref of name strings. Required.

=back

=head3 Returns

Count of non-empty name strings as an integer.

=head3 API specification

=head4 input

    {
        self  => { type => OBJECT,   isa => 'App::Test::Generator::Sample::Module' },
        names => { type => ARRAYREF },
    }

=head4 output

    { type => SCALAR, min => 0 }

=cut
210
211sub process_names {
212
6
6
52
        my ($self, $names) = @_;
213
214
6
100
15
        croak 'Names required'                    unless defined $names;
215
5
100
20
        croak 'Names must be an array reference'  unless ref($names) eq 'ARRAY';
216
217        # Count only non-empty name strings — undef and '' are skipped
218
3
2
        my $count = 0;
219
3
3
2
5
        for my $name (@{$names}) {
220                # Increment only for defined, non-empty entries
221
6
100
100
11
                $count++ if defined($name) && length($name) > 0;
222        }
223
224
3
7
        return $count;
225}
226
227 - 260
=head2 set_config

Store a configuration hashref on the object.

    $obj->set_config({ timeout => 30, retries => 3 });

=head3 Arguments

=over 4

=item * C<$config>

Hashref of configuration options. Required.

=back

=head3 Returns

1 on success. Croaks if C<$config> is absent or not a hashref.

=head3 API specification

=head4 input

    {
        self   => { type => OBJECT,  isa => 'App::Test::Generator::Sample::Module' },
        config => { type => HASHREF },
    }

=head4 output

    { type => SCALAR, value => 1 }

=cut
261
262sub set_config {
263
4
4
52
        my ($self, $config) = @_;
264
265
4
100
12
        croak 'Config required'                  unless defined $config;
266
3
100
17
        croak 'Config must be a hash reference'  unless ref($config) eq 'HASH';
267
268        # Store the config hashref directly — callers own the data
269
1
3
        $self->{config} = $config;
270
271
1
2
        return 1;
272}
273
274 - 313
=head2 greet

Generate a greeting message for a named person.

    my $msg = $obj->greet('Alice');
    my $msg = $obj->greet('Alice', 'Good morning');

=head3 Arguments

=over 4

=item * C<$name>

String (C<$MIN_NAME_LEN>-C<$MAX_NAME_LEN> chars). Required.

=item * C<$greeting>

String. Optional — defaults to C<"Hello">.

=back

=head3 Returns

Greeting string of the form C<"$greeting, $name!">.

=head3 API specification

=head4 input

    {
        self     => { type => OBJECT, isa => 'App::Test::Generator::Sample::Module' },
        name     => { type => SCALAR, min => 1, max => 50 },
        greeting => { type => SCALAR, optional => 1 },
    }

=head4 output

    { type => SCALAR }

=cut
314
315sub greet {
316
8
8
361
        my ($self, $name, $greeting) = @_;
317
318
8
100
18
        croak 'Name is required' unless defined $name;
319
7
50
11
        croak 'Name too short'   unless length($name) >= $MIN_NAME_LEN;
320
7
100
18
        croak 'Name too long'    unless length($name) <= $MAX_NAME_LEN;
321
322        # Apply default greeting when caller does not supply one
323
6
100
21
        $greeting ||= 'Hello';
324
325
6
13
        return "$greeting, $name!";
326}
327
328 - 362
=head2 check_flag

Return a normalised boolean for a flag value.

    my $result = $obj->check_flag(1);   # returns 1
    my $result = $obj->check_flag(0);   # returns 0

=head3 Arguments

=over 4

=item * C<$enabled>

Boolean scalar.

=back

=head3 Returns

1 if C<$enabled> is true, 0 otherwise.

=head3 API specification

=head4 input

    {
        self    => { type => OBJECT, isa => 'App::Test::Generator::Sample::Module' },
        enabled => { type => SCALAR },
    }

=head4 output

    { type => SCALAR }

=cut
363
364sub check_flag {
365
5
5
8
        my ($self, $enabled) = @_;
366
367        # Normalise any truthy/falsy value to a strict 1 or 0
368
5
100
12
        return $enabled ? 1 : 0;
369}
370
371 - 406
=head2 validate_score

Validate a numeric test score and return a pass/fail string.

    my $status = $obj->validate_score(75.5);  # returns 'Pass'
    my $status = $obj->validate_score(45.0);  # returns 'Fail'

=head3 Arguments

=over 4

=item * C<$score>

Number (C<$MIN_SCORE>-C<$MAX_SCORE>). Required.

=back

=head3 Returns

The string C<'Pass'> if the score meets or exceeds C<$PASS_THRESHOLD>,
C<'Fail'> otherwise. Croaks on invalid input.

=head3 API specification

=head4 input

    {
        self  => { type => OBJECT, isa => 'App::Test::Generator::Sample::Module' },
        score => { type => SCALAR, min => 0.0, max => 100.0 },
    }

=head4 output

    { type => SCALAR }

=cut
407
408sub validate_score {
409
12
12
120
        my ($self, $score) = @_;
410
411
12
100
26
        croak 'Score is required'    unless defined $score;
412
413        # Accept integers, decimals, and values like '.5' but not '1.2.3'
414
11
100
56
        croak 'Score must be numeric'
415                unless $score =~ /^(?:\d+\.?\d*|\.\d+)$/;
416
417
8
100
67
11
        croak 'Score out of range'
418                unless $score >= $MIN_SCORE && $score <= $MAX_SCORE;
419
420        # Compare against the pass threshold constant
421
7
100
34
        return $score >= $PASS_THRESHOLD ? 'Pass' : 'Fail';
422}
423
424 - 457
=head2 mysterious_method

A deliberately under-validated method used to test that
L<App::Test::Generator::SchemaExtractor> correctly assigns low
confidence when validation is absent.

=head3 Arguments

=over 4

=item * C<$thing>

A value to double. No type validation is performed intentionally.

=back

=head3 Returns

C<$thing * 2>.

=head3 API specification

=head4 input

    {
        self  => { type => OBJECT },
        thing => { type => 'any' },
    }

=head4 output

    { type => 'number' }

=cut
458
459sub mysterious_method {
460
4
4
20
        my ($self, $thing) = @_;
461
462        # Intentionally unvalidated — used to verify that SchemaExtractor
463        # flags low-confidence schemas when no validation logic is present.
464        # Callers passing non-numeric values will trigger a Perl warning;
465        # this is expected behaviour for this test fixture.
466
4
14
        return $thing * 2;
467}
468
469 - 477
=head1 AUTHOR

Example Author

=head1 LICENSE

This is free software.

=cut
478
4791;