lib/App/Test/Generator/Sample/Module.pm

Index Next ➡
Structural Coverage (Approximate)

TER1 (Statement): 100.00%
TER2 (Branch): 95.65%
TER3 (LCSAJ): 100.0% (2/2)
Approximate LCSAJ segments: 47

LCSAJ Legend

● 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.

Mutant Testing Legend

Survived (tests missed this) Killed (tests detected this) No mutation 
    1: package App::Test::Generator::Sample::Module;
    2: 
    3: use strict;
    4: use warnings;
    5: use Carp    qw(croak);
    6: use Readonly;
    7: 
    8: our $VERSION = '0.46';
    9: 
   10: # --------------------------------------------------
   11: # Validation constants — centralised so that changes
   12: # to limits only need to be made in one place
   13: # --------------------------------------------------
   14: Readonly my $MIN_EMAIL_LEN  => 5;
   15: Readonly my $MAX_EMAIL_LEN  => 254;
   16: Readonly my $MIN_BIRTH_YEAR => 1900;
   17: Readonly my $MIN_NAME_LEN   => 1;
   18: Readonly my $MAX_NAME_LEN   => 50;
   19: Readonly my $MIN_SCORE      => 0.0;
   20: Readonly my $MAX_SCORE      => 100.0;
   21: Readonly my $PASS_THRESHOLD => 60.0;
   22: 
   23: =head1 NAME
   24: 
   25: App::Test::Generator::Sample::Module - Example module for schema extraction testing
   26: 
   27: =head1 VERSION
   28: 
   29: Version 0.46
   30: 
   31: =head1 SYNOPSIS
   32: 
   33:     use App::Test::Generator::Sample::Module;
   34: 
   35:     my $obj = App::Test::Generator::Sample::Module->new();
   36:     my $result = $obj->validate_email('user@example.com');
   37: 
   38: =head1 DESCRIPTION
   39: 
   40: A sample module with a variety of well and poorly documented methods,
   41: used to exercise L<App::Test::Generator::SchemaExtractor>. The methods
   42: cover common parameter types, validation patterns, and confidence levels
   43: so that the extractor's heuristics can be tested against known inputs.
   44: 
   45: =head2 new
   46: 
   47: Constructor. Returns a new instance.
   48: 
   49:     my $obj = App::Test::Generator::Sample::Module->new();
   50: 
   51: =head3 Returns
   52: 
   53: A blessed hashref.
   54: 
   55: =head3 API specification
   56: 
   57: =head4 input
   58: 
   59:     { class => { type => SCALAR } }
   60: 
   61: =head4 output
   62: 
   63:     { type => OBJECT, isa => 'App::Test::Generator::Sample::Module' }
   64: 
   65: =cut
   66: 
   67: sub new {
   68: 	my $class = $_[0];
   69: 
   70: 	# Bless an empty hashref into the calling class
   71: 	return bless {}, $class;
   72: }
   73: 
   74: =head2 validate_email
   75: 
   76: Validate an email address against basic structural rules.
   77: 
   78:     my $ok = $obj->validate_email('user@example.com');
   79: 
   80: =head3 Arguments
   81: 
   82: =over 4
   83: 
   84: =item * C<$email>
   85: 
   86: String (C<$MIN_EMAIL_LEN>-C<$MAX_EMAIL_LEN> chars). Required.
   87: 
   88: =back
   89: 
   90: =head3 Returns
   91: 
   92: 1 if the address is valid. Croaks on any validation failure.
   93: 
   94: =head3 API specification
   95: 
   96: =head4 input
   97: 
   98:     {
   99:         self  => { type => OBJECT, isa => 'App::Test::Generator::Sample::Module' },
  100:         email => { type => SCALAR, min => 5, max => 254 },
  101:     }
  102: 
  103: =head4 output
  104: 
  105:     { type => SCALAR, value => 1 }
  106: 
  107: =cut
  108: 
  109: sub validate_email {
  110: 	my ($self, $email) = @_;
  111: 
  112: 	# Presence check before length checks to give a clear error
  113: 	croak 'Email is required' unless defined $email;
  114: 	croak 'Email too short'   unless length($email) >= $MIN_EMAIL_LEN;

					

					Mutants (Total: 3, Killed: 0, Survived: 3)
					

  115: 	croak 'Email too long'    unless length($email) <= $MAX_EMAIL_LEN;

					

					Mutants (Total: 3, Killed: 0, Survived: 3)
					

  116: 
  117: 	# Basic structural check — one @ with non-empty local and domain parts
  118: 	croak 'Invalid email format'
  119: 		unless $email =~ /^[^@]+\@[^@]+\.[^@]+$/;
  120: 
  121: 	return 1;

					

					Mutants (Total: 2, Killed: 0, Survived: 2)
					

  122: }
  123: 
  124: =head2 calculate_age
  125: 
  126: Calculate age in years from a birth year.
  127: 
  128:     my $age = $obj->calculate_age(1985);
  129: 
  130: =head3 Arguments
  131: 
  132: =over 4
  133: 
  134: =item * C<$birth_year>
  135: 
  136: A birth year value (C<$MIN_BIRTH_YEAR> to current year). Required.
  137: 
  138: =back
  139: 
  140: =head3 Returns
  141: 
  142: Age in years as an integer.
  143: 
  144: =head3 API specification
  145: 
  146: =head4 input
  147: 
  148:     {
  149:         self       => { type => OBJECT, isa => 'App::Test::Generator::Sample::Module' },
  150:         birth_year => { type => SCALAR, min => 1900 },
  151:     }
  152: 
  153: =head4 output
  154: 
  155:     { type => SCALAR }
  156: 
  157: =cut
  158: 
  159: sub calculate_age {
  160: 	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: 	my $current_year = (localtime)[5] + 1900;
  165: 
  166: 	croak 'Birth year required'          unless defined $birth_year;
  167: 	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: 	croak 'Birth year out of range'
  171: 		unless $birth_year >= $MIN_BIRTH_YEAR && $birth_year <= $current_year;

					

					Mutants (Total: 6, Killed: 0, Survived: 6)
					

  172: 
  173: 	return $current_year - $birth_year;

					

					Mutants (Total: 2, Killed: 0, Survived: 2)
					

  174: }
  175: 
  176: =head2 process_names
  177: 
  178: Process a list of names and return the count of non-empty entries.
  179: 
  180:     my $count = $obj->process_names(['Alice', 'Bob', '']);
  181: 
  182: =head3 Arguments
  183: 
  184: =over 4
  185: 
  186: =item * C<$names>
  187: 
  188: Arrayref of name strings. Required.
  189: 
  190: =back
  191: 
  192: =head3 Returns
  193: 
  194: Count of non-empty name strings as an integer.
  195: 
  196: =head3 API specification
  197: 
  198: =head4 input
  199: 
  200:     {
  201:         self  => { type => OBJECT,   isa => 'App::Test::Generator::Sample::Module' },
  202:         names => { type => ARRAYREF },
  203:     }
  204: 
  205: =head4 output
  206: 
  207:     { type => SCALAR, min => 0 }
  208: 
  209: =cut
  210: 
  211: sub process_names {
●212 → 219 → 224  212: 	my ($self, $names) = @_;
  213: 
  214: 	croak 'Names required'                    unless defined $names;
  215: 	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: 	my $count = 0;
  219: 	for my $name (@{$names}) {
  220: 		# Increment only for defined, non-empty entries
  221: 		$count++ if defined($name) && length($name) > 0;

					

					Mutants (Total: 3, Killed: 0, Survived: 3)
					

  222: 	}
  223: 
  224: 	return $count;

					

					Mutants (Total: 2, Killed: 0, Survived: 2)
					

  225: }
  226: 
  227: =head2 set_config
  228: 
  229: Store a configuration hashref on the object.
  230: 
  231:     $obj->set_config({ timeout => 30, retries => 3 });
  232: 
  233: =head3 Arguments
  234: 
  235: =over 4
  236: 
  237: =item * C<$config>
  238: 
  239: Hashref of configuration options. Required.
  240: 
  241: =back
  242: 
  243: =head3 Returns
  244: 
  245: 1 on success. Croaks if C<$config> is absent or not a hashref.
  246: 
  247: =head3 API specification
  248: 
  249: =head4 input
  250: 
  251:     {
  252:         self   => { type => OBJECT,  isa => 'App::Test::Generator::Sample::Module' },
  253:         config => { type => HASHREF },
  254:     }
  255: 
  256: =head4 output
  257: 
  258:     { type => SCALAR, value => 1 }
  259: 
  260: =cut
  261: 
  262: sub set_config {
  263: 	my ($self, $config) = @_;
  264: 
  265: 	croak 'Config required'                  unless defined $config;
  266: 	croak 'Config must be a hash reference'  unless ref($config) eq 'HASH';
  267: 
  268: 	# Store the config hashref directly — callers own the data
  269: 	$self->{config} = $config;
  270: 
  271: 	return 1;

					

					Mutants (Total: 2, Killed: 0, Survived: 2)
					

  272: }
  273: 
  274: =head2 greet
  275: 
  276: Generate a greeting message for a named person.
  277: 
  278:     my $msg = $obj->greet('Alice');
  279:     my $msg = $obj->greet('Alice', 'Good morning');
  280: 
  281: =head3 Arguments
  282: 
  283: =over 4
  284: 
  285: =item * C<$name>
  286: 
  287: String (C<$MIN_NAME_LEN>-C<$MAX_NAME_LEN> chars). Required.
  288: 
  289: =item * C<$greeting>
  290: 
  291: String. Optional — defaults to C<"Hello">.
  292: 
  293: =back
  294: 
  295: =head3 Returns
  296: 
  297: Greeting string of the form C<"$greeting, $name!">.
  298: 
  299: =head3 API specification
  300: 
  301: =head4 input
  302: 
  303:     {
  304:         self     => { type => OBJECT, isa => 'App::Test::Generator::Sample::Module' },
  305:         name     => { type => SCALAR, min => 1, max => 50 },
  306:         greeting => { type => SCALAR, optional => 1 },
  307:     }
  308: 
  309: =head4 output
  310: 
  311:     { type => SCALAR }
  312: 
  313: =cut
  314: 
  315: sub greet {
●316 → 323 → 328  316: 	my ($self, $name, $greeting) = @_;
  317: 
  318: 	croak 'Name is required'        unless defined $name;
  319: 	croak 'Name must be a string'   if ref($name);

					

					Mutants (Total: 3, Killed: 0, Survived: 3)
					

  320: 	croak 'Name too short'          unless length($name) >= $MIN_NAME_LEN;

					

					Mutants (Total: 3, Killed: 0, Survived: 3)
					

  321: 	croak 'Name too long'           unless length($name) <= $MAX_NAME_LEN;
  322: 
  323: 	if(defined $greeting) {
  324: 		croak 'Greeting must be a string' if ref($greeting);
  325: 	}

					

					Mutants (Total: 2, Killed: 0, Survived: 2)
					

  326: 
  327: 	# Apply default greeting when caller does not supply one
  328: 	$greeting ||= 'Hello';
  329: 
  330: 	return "$greeting, $name!";
  331: }
  332: 
  333: =head2 check_flag
  334: 
  335: Return a normalised boolean for a flag value.
  336: 
  337:     my $result = $obj->check_flag(1);   # returns 1
  338:     my $result = $obj->check_flag(0);   # returns 0
  339: 
  340: =head3 Arguments
  341: 
  342: =over 4
  343: 
  344: =item * C<$enabled>
  345: 
  346: Boolean scalar.
  347: 
  348: =back
  349: 
  350: =head3 Returns
  351: 
  352: 1 if C<$enabled> is true, 0 otherwise.
  353: 
  354: =head3 API specification
  355: 
  356: =head4 input
  357: 
  358:     {
  359:         self    => { type => OBJECT, isa => 'App::Test::Generator::Sample::Module' },
  360:         enabled => { type => SCALAR },
  361:     }
  362: 
  363: =head4 output
  364: 
  365:     { type => SCALAR }
  366: 
  367: =cut
  368: 

					

					Mutants (Total: 2, Killed: 0, Survived: 2)
					

  369: sub check_flag {
  370: 	my ($self, $enabled) = @_;
  371: 
  372: 	# Normalise any truthy/falsy value to a strict 1 or 0
  373: 	return $enabled ? 1 : 0;
  374: }
  375: 
  376: =head2 validate_score
  377: 
  378: Validate a numeric test score and return a pass/fail string.
  379: 
  380:     my $status = $obj->validate_score(75.5);  # returns 'Pass'
  381:     my $status = $obj->validate_score(45.0);  # returns 'Fail'
  382: 
  383: =head3 Arguments
  384: 
  385: =over 4
  386: 
  387: =item * C<$score>
  388: 
  389: Number (C<$MIN_SCORE>-C<$MAX_SCORE>). Required.
  390: 
  391: =back
  392: 
  393: =head3 Returns
  394: 
  395: The string C<'Pass'> if the score meets or exceeds C<$PASS_THRESHOLD>,
  396: C<'Fail'> otherwise. Croaks on invalid input.
  397: 
  398: =head3 API specification
  399: 
  400: =head4 input
  401: 
  402:     {
  403:         self  => { type => OBJECT, isa => 'App::Test::Generator::Sample::Module' },
  404:         score => { type => SCALAR, min => 0.0, max => 100.0 },
  405:     }
  406: 
  407: =head4 output
  408: 
  409:     { type => SCALAR }
  410: 
  411: =cut
  412: 
  413: sub validate_score {
  414: 	my ($self, $score) = @_;
  415: 
  416: 	croak 'Score is required'    unless defined $score;
  417: 
  418: 	# Accept integers, decimals, and values like '.5' but not '1.2.3'

					

					Mutants (Total: 6, Killed: 0, Survived: 6)
					

  419: 	croak 'Score must be numeric'
  420: 		unless $score =~ /^(?:\d+\.?\d*|\.\d+)$/;
  421: 

					

					Mutants (Total: 5, Killed: 0, Survived: 5)
					

  422: 	croak 'Score out of range'
  423: 		unless $score >= $MIN_SCORE && $score <= $MAX_SCORE;
  424: 
  425: 	# Compare against the pass threshold constant
  426: 	return $score >= $PASS_THRESHOLD ? 'Pass' : 'Fail';
  427: }
  428: 
  429: =head2 mysterious_method
  430: 
  431: A deliberately under-validated method used to test that
  432: L<App::Test::Generator::SchemaExtractor> correctly assigns low
  433: confidence when validation is absent.
  434: 
  435: =head3 Arguments
  436: 
  437: =over 4
  438: 
  439: =item * C<$thing>
  440: 
  441: A value to double. No type validation is performed intentionally.
  442: 
  443: =back
  444: 
  445: =head3 Returns
  446: 
  447: C<$thing * 2>.
  448: 
  449: =head3 API specification
  450: 
  451: =head4 input
  452: 
  453:     {
  454:         self  => { type => OBJECT },
  455:         thing => { type => 'any' },
  456:     }
  457: 
  458: =head4 output
  459: 
  460:     { type => 'number' }
  461: 
  462: =cut
  463: 
  464: sub mysterious_method {
  465: 	my ($self, $thing) = @_;
  466: 

					

					Mutants (Total: 2, Killed: 0, Survived: 2)
					

  467: 	# Intentionally unvalidated — used to verify that SchemaExtractor
  468: 	# flags low-confidence schemas when no validation logic is present.
  469: 	# Callers passing non-numeric values will trigger a Perl warning;
  470: 	# this is expected behaviour for this test fixture.
  471: 	return $thing * 2;
  472: }
  473: 
  474: =head1 AUTHOR
  475: 
  476: Example Author
  477: 
  478: =head1 LICENSE
  479: 
  480: This is free software.
  481: 
  482: =cut
  483: 
  484: 1;