lib/App/Test/Generator/SchemaExtractor.pm

        start → end → jump
        

    1: package App::Test::Generator::SchemaExtractor;
    2: 
    3: use strict;
    4: use warnings;
    5: use autodie qw(:all);
    6: 
    7: use App::Test::Generator::Model::Method;
    8: use App::Test::Generator::Analyzer::Complexity;
    9: use App::Test::Generator::Analyzer::Return;
   10: use App::Test::Generator::Analyzer::ReturnMeta;
   11: use App::Test::Generator::Analyzer::SideEffect;
   12: 
   13: use Carp qw(carp croak);
   14: use PPI;
   15: use Pod::Simple::Text;
   16: use File::Basename;
   17: use File::Path qw(make_path);
   18: use Params::Get;
   19: use Safe;
   20: use Scalar::Util qw(looks_like_number);
   21: use YAML::XS;
   22: use IPC::Open3;
   23: use JSON::MaybeXS qw(encode_json decode_json);
   24: use Readonly;
   25: use Symbol qw(gensym);
   26: 
   27: # --------------------------------------------------
   28: # Confidence score thresholds for input and output analysis
   29: # --------------------------------------------------
   30: Readonly my $CONFIDENCE_HIGH_THRESHOLD   => 60;
   31: Readonly my $CONFIDENCE_MEDIUM_THRESHOLD => 35;
   32: Readonly my $CONFIDENCE_LOW_THRESHOLD    => 15;
   33: 
   34: # --------------------------------------------------
   35: # Confidence level label strings
   36: # --------------------------------------------------
   37: Readonly my $LEVEL_HIGH     => 'high';
   38: Readonly my $LEVEL_MEDIUM   => 'medium';
   39: Readonly my $LEVEL_LOW      => 'low';
   40: Readonly my $LEVEL_VERY_LOW => 'very_low';
   41: Readonly my $LEVEL_NONE     => 'none';
   42: 
   43: # --------------------------------------------------
   44: # Analysis limits
   45: # --------------------------------------------------
   46: Readonly my $DEFAULT_MAX_PARAMETERS     => 20;
   47: Readonly my $DEFAULT_CONFIDENCE_THRESH  => 0.5;
   48: Readonly my $POD_WALK_LIMIT             => 200;
   49: Readonly my $SIGNATURE_TIMEOUT_SECS     => 3;
   50: Readonly my $MEMORY_LIMIT_BYTES         => 50_000_000;
   51: 
   52: # --------------------------------------------------
   53: # Patterns for rejecting dangerous signature expressions
   54: # in _compile_signature_isolated
   55: # --------------------------------------------------
   56: Readonly my $UNSAFE_KEYWORD_RE => qr/\b(?:system|exec|open|fork|require|do|eval|qx)\b/;
   57: Readonly my $UNSAFE_CHAR_RE    => qr/[`{};]/;
   58: 
   59: # --------------------------------------------------
   60: # strict_pod levels — integer values stored internally
   61: # but referred to by name everywhere in code
   62: # --------------------------------------------------
   63: Readonly my $STRICT_POD_OFF   => 0;
   64: Readonly my $STRICT_POD_WARN  => 1;
   65: Readonly my $STRICT_POD_FATAL => 2;
   66: 
   67: # --------------------------------------------------
   68: # Numeric boundary values for test hint generation
   69: # --------------------------------------------------
   70: Readonly my $INT32_MAX => 2_147_483_647;
   71: 
   72: # --------------------------------------------------
   73: # Boolean return score thresholds
   74: # --------------------------------------------------
   75: Readonly my $BOOLEAN_SCORE_THRESHOLD => 30;
   76: 
   77: =head1 NAME
   78: 
   79: App::Test::Generator::SchemaExtractor - Extract test schemas from Perl modules
   80: 
   81: =head1 VERSION
   82: 
   83: Version 0.46
   84: 
   85: =cut
   86: 
   87: our $VERSION = '0.46';
   88: 
   89: =head1 SYNOPSIS
   90: 
   91: 	use App::Test::Generator::SchemaExtractor;
   92: 
   93: 	my $extractor = App::Test::Generator::SchemaExtractor->new(
   94: 		input_file => 'lib/MyModule.pm',
   95: 		output_dir => 'schemas/',
   96: 		verbose	=> 1,
   97: 	);
   98: 
   99: 	my $schemas = $extractor->extract_all();
  100: 
  101: =head1 DESCRIPTION
  102: 
  103: App::Test::Generator::SchemaExtractor analyzes Perl modules and generates
  104: structured YAML schema files suitable for automated test generation by L<App::Test::Generator>.
  105: This module employs
  106: static analysis techniques to infer parameter types, constraints, and
  107: method behaviors directly from your source code.
  108: 
  109: =head2 Analysis Methods
  110: 
  111: The extractor combines multiple analysis approaches for a comprehensive schema generation:
  112: 
  113: =over 4
  114: 
  115: =item * B<POD Documentation Analysis>
  116: 
  117: Parses embedded documentation to extract:
  118:   - Parameter names, types, and descriptions from =head2 sections
  119:   - Method signatures with positional parameters
  120:   - Return value specifications from "Returns:" sections
  121:   - Constraints (ranges, patterns, required/optional status)
  122:   - Semantic type detection (email, URL, filename)
  123: 
  124: =item * B<Code Pattern Detection>
  125: 
  126: Analyzes source code using PPI to identify:
  127:   - Method signatures and parameter extraction patterns
  128:   - Type validation (ref(), isa(), blessed())
  129:   - Constraint patterns (length checks, numeric comparisons, regex matches)
  130:   - Return statement analysis and value type inference
  131:   - Object instantiation requirements and accessor methods
  132: 
  133: =item * B<Signature Analysis>
  134: 
  135: Examines method declarations for:
  136:   - Parameter names and positional information
  137:   - Instance vs. class method detection
  138:   - Method modifiers (Moose-style before/after/around)
  139:   - Various parameter declaration styles (shift, @_ assignment)
  140: 
  141: =item * B<Heuristic Inference>
  142: 
  143: Applies Perl-specific domain knowledge:
  144:   - Boolean return detection from method names (is_*, has_*, can_*)
  145:   - Common Perl idioms and coding patterns
  146:   - Context awareness (scalar vs list, wantarray usage)
  147:   - Object-oriented patterns (constructors, accessors, chaining)
  148: 
  149: =back
  150: 
  151: =head2 Generated Schema Structure
  152: 
  153: The extracted schemas follow this YAML structure:
  154: 
  155:     function: method_name
  156:     module: Package::Name
  157:     input:
  158:       param1:
  159:         type: string
  160:         min: 3
  161:         max: 50
  162:         optional: 0
  163:         position: 0
  164:       param2:
  165:         type: integer
  166:         min: 0
  167:         max: 100
  168:         optional: 1
  169:         position: 1
  170:     output:
  171:       type: boolean
  172:       value: 1
  173:     new: Package::Name # if object instantiation required
  174:     config:
  175:       test_empty: 1
  176:       test_nuls: 0
  177:       test_undef: 0
  178:       test_non_ascii: 0
  179: 
  180: =head2 Advanced Detection Capabilities
  181: 
  182: =over 4
  183: 
  184: =item * B<Accessor Method Detection>
  185: 
  186: Automatically identifies getter, setter, and combined accessor methods
  187: by analyzing common patterns like C<return $self-E<gt>{property}> and
  188: C<$self-E<gt>{property} = $value>.
  189: 
  190: =item * B<Params::Get Integration>
  191: 
  192: Recognises parameters extracted via C<Params::Get::get_params('key', \@_)>,
  193: treating the quoted key as a named parameter equivalent to a traditional
  194: C<my ($self, $key) = @_> signature.  This prevents false positives from
  195: C<--strict-pod> when the method body never declares an explicit C<$key>
  196: variable.
  197: 
  198: =item * B<Direct-Index Self Style>
  199: 
  200: Recognises C<my $self = $_[0]> as a valid method-invocant pattern.  Parameters
  201: at C<$_[1]>, C<$_[2]>, etc. are extracted as positional parameters.  Without
  202: this, the signature fallback would incorrectly pick up C<my (...) = @_> from
  203: inner closures defined in the method body and treat those variables as the
  204: outer method's parameters.
  205: 
  206: =item * B<Boolean Return Inference>
  207: 
  208: Detects boolean-returning methods through multiple signals:
  209:   - Method name patterns (is_*, has_*, can_*)
  210:   - Return patterns (consistent 1/0 returns)
  211:   - POD descriptions ("returns true on success")
  212:   - Ternary operators with boolean results
  213: 
  214: =item * B<Context Awareness>
  215: 
  216: Identifies methods that use C<wantarray> and can return different
  217: values in scalar vs list context.
  218: 
  219: =item * B<Object Lifecycle Management>
  220: 
  221: Detects instance methods requiring object instantiation and
  222: automatically adds the C<new> field to schemas.
  223: 
  224: =item * B<Enhanced Object Detection>
  225: 
  226: The extractor includes sophisticated object detection capabilities that go beyond simple instance method identification:
  227: 
  228: =over 4
  229: 
  230: =item * B<Factory Method Recognition>
  231: 
  232: Automatically identifies methods that create and return object instances, such as methods named C<create_*>, C<make_*>, C<build_*>, or C<get_*>. Factory methods are correctly classified as class methods that don't require pre-existing objects for testing.
  233: 
  234: =item * B<Singleton Pattern Detection>
  235: 
  236: Recognizes singleton patterns through multiple signals: method names like C<instance> or C<get_instance>, static variables holding instance references, lazy initialization patterns (C<$instance ||= new()>), and consistent return of the same instance variable.
  237: 
  238: =item * B<Constructor Parameter Analysis>
  239: 
  240: Examines C<new> methods to determine required and optional parameters, validation requirements, and default values. This enables test generators to provide appropriate constructor arguments when object instantiation is needed.
  241: 
  242: =item * B<Inheritance Relationship Handling>
  243: 
  244: Detects parent classes through C<use parent>, C<use base>, and C<@ISA> declarations. Identifies when methods use C<SUPER::> calls and determines whether the current class or a parent class constructor should be used for object instantiation.
  245: 
  246: =item * B<External Object Dependency Detection>
  247: 
  248: Identifies when methods create or depend on objects from other classes, enabling proper test setup with mock objects or real dependencies.
  249: 
  250: =back
  251: 
  252: These enhancements ensure that generated test schemas accurately reflect the object-oriented structure of the code, leading to more meaningful and effective test generation.
  253: 
  254: =back
  255: 
  256: =head2 Confidence Scoring
  257: 
  258: Each generated schema includes detailed confidence assessments:
  259: 
  260: =over 4
  261: 
  262: =item * B<High Confidence>
  263: 
  264: Multiple independent analysis sources converge on consistent,
  265: well-constrained parameters with explicit validation logic and
  266: comprehensive documentation.
  267: 
  268: =item * B<Medium Confidence>
  269: 
  270: Reasonable evidence from code patterns or partial documentation,
  271: but may lack comprehensive constraints or have some ambiguities.
  272: 
  273: =item * B<Low Confidence>
  274: 
  275: Minimal evidence - primarily based on naming conventions,
  276: default assumptions, or single-source analysis.
  277: 
  278: =item * B<Very Low Confidence>
  279: 
  280: Barely any detectable signals - schema should be thoroughly
  281: reviewed before use in test generation.
  282: 
  283: =back
  284: 
  285: =head2 Use Cases
  286: 
  287: =over 4
  288: 
  289: =item * B<Automated Test Generation>
  290: 
  291: Generate comprehensive test suites with L<App::Test::Generator> using
  292: extracted schemas as input. The schemas provide the necessary structure
  293: for generating both positive and negative test cases.
  294: 
  295: =item * B<API Documentation Generation>
  296: 
  297: Supplement existing documentation with automatically inferred interface
  298: specifications, parameter requirements, and return types.
  299: 
  300: =item * B<Code Quality Assessment>
  301: 
  302: Identify methods with poor documentation, inconsistent parameter handling,
  303: or unclear interfaces that may benefit from refactoring.
  304: 
  305: =item * B<Refactoring Assistance>
  306: 
  307: Detect method dependencies, object instantiation requirements, and
  308: parameter usage patterns to inform refactoring decisions.
  309: 
  310: =item * B<Legacy Code Analysis>
  311: 
  312: Quickly understand the interface contracts of legacy Perl codebases
  313: without extensive manual code reading.
  314: 
  315: =back
  316: 
  317: =head2 Integration with Testing Ecosystem
  318: 
  319: The generated schemas are specifically designed to work with the
  320: L<App::Test::Generator> ecosystem:
  321: 
  322:     # Extract schemas from your module
  323:     my $extractor = App::Test::Generator::SchemaExtractor->new(...);
  324:     my $schemas = $extractor->extract_all();
  325: 
  326:     # Use with test generator (typically as separate steps)
  327:     # fuzz-harness-generator -r schemas/method_name.yml
  328: 
  329: =head2 Limitations and Considerations
  330: 
  331: =over 4
  332: 
  333: =item * B<Dynamic Code Patterns>
  334: 
  335: Highly dynamic code (string evals, AUTOLOAD, symbolic references)
  336: may not be fully detected by static analysis.
  337: 
  338: =item * B<Complex Validation Logic>
  339: 
  340: Sophisticated validation involving multiple parameters or external
  341: dependencies may require manual schema refinement.
  342: 
  343: =item * B<Confidence Heuristics>
  344: 
  345: Confidence scores are based on heuristics and should be reviewed
  346: by developers familiar with the codebase.
  347: 
  348: =item * B<Perl Idiom Recognition>
  349: 
  350: Some Perl-specific idioms may require custom pattern recognition
  351: beyond the built-in detectors.
  352: 
  353: =item * B<Documentation Dependency>
  354: 
  355: Analysis quality improves significantly with comprehensive POD
  356: documentation following consistent patterns.
  357: 
  358: =back
  359: 
  360: =head2 Best Practices for Optimal Results
  361: 
  362: =over 4
  363: 
  364: =item * B<Comprehensive POD Documentation>
  365: 
  366: Write detailed POD with explicit parameter documentation using
  367: consistent patterns like C<$param - type (constraints), description>.
  368: 
  369: =item * B<Consistent Coding Patterns>
  370: 
  371: Use consistent parameter validation patterns and method signatures
  372: throughout your codebase.
  373: 
  374: =item * B<Schema Review Process>
  375: 
  376: Review and refine automatically generated schemas, particularly
  377: those with low confidence scores.
  378: 
  379: =item * B<Descriptive Naming>
  380: 
  381: Use descriptive method and parameter names that clearly indicate
  382: purpose and expected types.
  383: 
  384: =item * B<Progressive Enhancement>
  385: 
  386: Start with automatically generated schemas and progressively
  387: refine them based on test results and code understanding.
  388: 
  389: =back
  390: 
  391: The module is particularly valuable for large codebases where manual schema
  392: creation would be prohibitively time-consuming, and for maintaining test
  393: coverage as code evolves through continuous integration pipelines.
  394: 
  395: =head2 Advanced Type Detection
  396: 
  397: The schema extractor includes enhanced type detection capabilities that identify specialized Perl types beyond basic strings and integers.
  398: L<DateTime> and L<Time::Piece> objects are detected through isa() checks and method call patterns, while date strings (ISO 8601, YYYY-MM-DD) and UNIX timestamps are recognized through regex validation and numeric range checks.
  399: File handles and file paths are identified via I/O operations and file test operators, coderefs are detected through ref() checks and invocation patterns, and enum-like parameters are extracted from validation code including regex patterns (C</^(a|b|c)$/>), hash lookups, grep statements, and if/elsif chains.
  400: These detected types are preserved in the generated YAML schemas with appropriate semantic annotations, enabling test generators to create more accurate and meaningful test cases.
  401: 
  402: =head3 Example Advanced Type Schema
  403: 
  404: For a method like:
  405: 
  406:     sub process_event {
  407:         my ($self, $timestamp, $status, $callback) = @_;
  408:         croak unless $timestamp > 1000000000;
  409:         croak unless $status =~ /^(active|pending|complete)$/;
  410:         croak unless ref($callback) eq 'CODE';
  411:         $callback->($timestamp, $status);
  412:     }
  413: 
  414: The extractor generates:
  415: 
  416:     ---
  417:     function: process_event
  418:     module: MyModule
  419:     input:
  420:       timestamp:
  421:         type: integer
  422:         # min: 0
  423:         # max: 2147483647
  424:         position: 0
  425:         _note: Unix timestamp
  426: 	semantic: unix_timestamp
  427:       status:
  428:         type: string
  429:         enum:
  430:           - active
  431:           - pending
  432:           - complete
  433:         position: 1
  434:         _note: 'Must be one of: active, pending, complete'
  435:       callback:
  436:         type: coderef
  437:         position: 2
  438:         _note: 'CODE reference - provide sub { } in tests'
  439: 
  440: =head1 RELATIONSHIP DETECTION
  441: 
  442: The schema extractor detects relationships and dependencies between parameters,
  443: enabling more sophisticated validation and test generation.
  444: 
  445: =head2 Relationship Types
  446: 
  447: =over 4
  448: 
  449: =item * B<mutually_exclusive>
  450: 
  451: Parameters that cannot be used together.
  452: 
  453:     die if $file && $content;  # Can't specify both
  454: 
  455: Generated schema:
  456: 
  457:     relationships:
  458:       - type: mutually_exclusive
  459:         params: [file, content]
  460:         description: Cannot specify both file and content
  461: 
  462: =item * B<required_group>
  463: 
  464: At least one parameter from the group must be specified (OR logic).
  465: 
  466:     die unless $id || $name;  # Must provide one
  467: 
  468: Generated schema:
  469: 
  470:     relationships:
  471:       - type: required_group
  472:         params: [id, name]
  473:         logic: or
  474:         description: Must specify either id or name
  475: 
  476: =item * B<conditional_requirement>
  477: 
  478: If one parameter is specified, another becomes required (IF-THEN logic).
  479: 
  480:     die if $async && !$callback;  # async requires callback
  481: 
  482: Generated schema:
  483: 
  484:     relationships:
  485:       - type: conditional_requirement
  486:         if: async
  487:         then_required: callback
  488:         description: When async is specified, callback is required
  489: 
  490: =item * B<dependency>
  491: 
  492: One parameter depends on another being present.
  493: 
  494:     die "Port requires host" if $port && !$host;
  495: 
  496: Generated schema:
  497: 
  498:     relationships:
  499:       - type: dependency
  500:         param: port
  501:         requires: host
  502:         description: port requires host to be specified
  503: 
  504: =item * B<value_constraint>
  505: 
  506: Specific value requirements between parameters.
  507: 
  508:     die if $ssl && $port != 443;  # ssl requires port 443
  509: 
  510: Generated schema:
  511: 
  512:     relationships:
  513:       - type: value_constraint
  514:         if: ssl
  515:         then: port
  516:         operator: ==
  517:         value: 443
  518:         description: When ssl is specified, port must equal 443
  519: 
  520: =item * B<value_conditional>
  521: 
  522: Parameter required when another has a specific value.
  523: 
  524:     die if $mode eq 'secure' && !$key;
  525: 
  526: Generated schema:
  527: 
  528:     relationships:
  529:       - type: value_conditional
  530:         if: mode
  531:         equals: secure
  532:         then_required: key
  533:         description: When mode equals 'secure', key is required
  534: 
  535: =back
  536: 
  537: =head2 Default Value Extraction
  538: 
  539: The extractor comprehensively extracts default values from both code and POD documentation:
  540: 
  541: =head3 Code Pattern Recognition
  542: 
  543: Extracts defaults from multiple Perl idioms:
  544: 
  545: =over 4
  546: 
  547: =item * Logical OR operator: C<$param = $param || 'default'>
  548: 
  549: =item * Defined-or operator: C<$param //= 'default'>
  550: 
  551: =item * Ternary operator: C<$param = defined $param ? $param : 'default'>
  552: 
  553: =item * Unless conditional: C<$param = 'default' unless defined $param>
  554: 
  555: =item * Chained defaults: C<$param = $param || $self->{_default} || 'fallback'>
  556: 
  557: =item * Multi-line patterns: C<$param = {} unless $param>
  558: 
  559: =back
  560: 
  561: =head3 POD Pattern Recognition
  562: 
  563: Extracts defaults from documentation:
  564: 
  565: =over 4
  566: 
  567: =item * Standard format: C<Default: 'value'>
  568: 
  569: =item * Alternative format: C<Defaults to: 'value'>
  570: 
  571: =item * Inline format: C<Optional, default: 'value'>
  572: 
  573: =item * Parameter lists: C<$param - type, default 'value'>
  574: 
  575: =back
  576: 
  577: =head3 Value Processing
  578: 
  579: Properly handles:
  580: 
  581: =over 4
  582: 
  583: =item * String literals with quotes and escape sequences
  584: 
  585: =item * Numeric values (integers and floats)
  586: 
  587: =item * Boolean values (true/false converted to 1/0)
  588: 
  589: =item * Empty data structures ([] and {})
  590: 
  591: =item * Special values (undef, __PACKAGE__)
  592: 
  593: =item * Complex expressions (preserved as-is when unevaluatable)
  594: 
  595: =item * Quote operators (q{}, qq{}, qw{})
  596: 
  597: =back
  598: 
  599: =head3 Type Inference
  600: 
  601: When a parameter has a default value but no explicit type annotation,
  602: the type is automatically inferred from the default:
  603: 
  604:     $options = {}        # inferred as hashref
  605:     $items = []          # inferred as arrayref
  606:     $count = 42          # inferred as integer
  607:     $ratio = 3.14        # inferred as number
  608:     $enabled = 1         # inferred as boolean
  609: 
  610: =head2 Context-Aware Return Analysis
  611: 
  612: The extractor provides comprehensive analysis of method return behavior,
  613: including context sensitivity, error handling conventions, and method chaining patterns.
  614: 
  615: When a method's POD contains a C<=head4 Output> block in
  616: L<Params::Validate::Strict> schema format, the C<type> declared there is
  617: used as the authoritative output type and takes precedence over all
  618: heuristic code analysis:
  619: 
  620:     =head4 Output
  621: 
  622:         {
  623:             type => 'hashref',
  624:         }
  625: 
  626: This is the recommended way to document methods whose return type would
  627: otherwise be misidentified (e.g. a method that returns C<$self-E<gt>{cache}>
  628: where the cache happens to hold a hashref).
  629: 
  630: Using parentheses as the outer container emits C<type: array>, indicating a
  631: list-returning method.  L<App::Test::Generator> 0.39+ (with L<Test::Returns>
  632: 0.03+) captures these results in list context automatically:
  633: 
  634:     =head4 Output
  635: 
  636:         (
  637:             {
  638:                 type => 'hashref',
  639:             },
  640:             ...
  641:         )
  642: 
  643: =head3 List vs Scalar Context Detection
  644: 
  645: Automatically detects methods that return different values based on calling context:
  646: 
  647:     sub get_items {
  648:         my $self = $_[0];
  649:         return wantarray ? @items : scalar(@items);
  650:     }
  651: 
  652: Detection captures:
  653: 
  654: =over 4
  655: 
  656: =item * C<_context_aware> flag - Method uses wantarray
  657: 
  658: =item * C<_list_context> - Type returned in list context (e.g., 'array')
  659: 
  660: =item * C<_scalar_context> - Type returned in scalar context (e.g., 'integer')
  661: 
  662: =back
  663: 
  664: Recognizes both ternary operator patterns and conditional return patterns.
  665: 
  666: =head3 Void Context Methods
  667: 
  668: Identifies methods that don't return meaningful values:
  669: 
  670: =over 4
  671: 
  672: =item * Setters (C<set_*> methods)
  673: 
  674: =item * Mutators (C<add_*, remove_*, delete_*, clear_*, reset_*, update_*>)
  675: 
  676: =item * Loggers (C<log, debug, warn, error, info>)
  677: 
  678: =item * Methods with only empty returns
  679: 
  680: =back
  681: 
  682: Example:
  683: 
  684:     sub set_name {
  685:         my ($self, $name) = @_;
  686:         $self->{name} = $name;
  687:         return;  # Void context
  688:     }
  689: 
  690: Sets C<_void_context> flag and C<type =E<gt> 'void'>.
  691: 
  692: =head3 Method Chaining Detection
  693: 
  694: Identifies chainable methods that return C<$self> for fluent interfaces:
  695: 
  696:     sub set_width {
  697:         my ($self, $width) = @_;
  698:         $self->{width} = $width;
  699:         return $self;  # Chainable
  700:     }
  701: 
  702: Detection provides:
  703: 
  704: =over 4
  705: 
  706: =item * C<_returns_self> - Returns invocant for chaining
  707: 
  708: =item * C<class> - The class name being returned
  709: 
  710: =back
  711: 
  712: Also detects chaining documentation in POD (keywords: "chainable", "fluent interface",
  713: "returns self", "method chaining").
  714: 
  715: =head3 Error Return Conventions
  716: 
  717: Analyzes how methods signal errors:
  718: 
  719: B<Pattern Detection:>
  720: 
  721: =over 4
  722: 
  723: =item * C<undef_on_error> - Explicit C<return undef if/unless condition>
  724: 
  725: =item * C<implicit_undef> - Bare C<return if/unless condition>
  726: 
  727: =item * C<empty_list> - C<return ()> for list context errors
  728: 
  729: =item * C<zero_on_error> - Returns 0/false for boolean error indication
  730: 
  731: =item * C<exception_handling> - Uses eval blocks with error checking
  732: 
  733: =back
  734: 
  735: B<Example Analysis:>
  736: 
  737:     sub fetch_user {
  738:         my ($self, $id) = @_;
  739: 
  740:         return undef unless $id;        # undef_on_error
  741:         return undef if $id < 0;        # undef_on_error
  742: 
  743:         return $self->{users}{$id};
  744:     }
  745: 
  746: Results in:
  747: 
  748:     _error_return: 'undef'
  749:     _success_failure_pattern: 1
  750:     _error_handling: {
  751:         undef_on_error: ['$id', '$id < 0']
  752:     }
  753: 
  754: B<Success/Failure Pattern:>
  755: 
  756: Methods that return different types for success vs. failure are flagged with
  757: C<_success_failure_pattern>. Common patterns:
  758: 
  759: =over 4
  760: 
  761: =item * Returns value on success, undef on failure
  762: 
  763: =item * Returns true on success, false on failure
  764: 
  765: =item * Returns data on success, empty list on failure
  766: 
  767: =back
  768: 
  769: =head3 Success Indicator Detection
  770: 
  771: Methods that always return true (typically for side effects):
  772: 
  773:     sub update_status {
  774:         my ($self, $status) = @_;
  775:         $self->{status} = $status;
  776:         return 1;  # Success indicator
  777:     }
  778: 
  779: Sets C<_success_indicator> flag when method consistently returns 1.
  780: 
  781: =head3 Schema Output
  782: 
  783: Enhanced return analysis adds these fields to method schemas:
  784: 
  785:     output:
  786:       type: boolean              # Inferred return type
  787:       _context_aware: 1           # Uses wantarray
  788:       _list_context:
  789:         type: array
  790:       _scalar_context:
  791:         type: integer
  792:       _returns_self: 1               # Returns $self
  793:       _void_context: 1            # No meaningful return
  794:       _success_indicator: 1       # Always returns true
  795:       _error_return: undef        # How errors are signaled
  796:       _success_failure_pattern: 1 # Mixed return types
  797:       _error_handling:            # Detailed error patterns
  798:         undef_on_error: [...]
  799:         exception_handling: 1
  800: 
  801: This comprehensive analysis enables:
  802: 
  803: =over 4
  804: 
  805: =item * Better test generation (testing both contexts, error paths)
  806: 
  807: =item * Documentation generation (clear error conventions)
  808: 
  809: =item * API design validation (consistent error handling)
  810: 
  811: =item * Contract specification (precise return behavior)
  812: 
  813: =back
  814: 
  815: =head2 Example
  816: 
  817: For a method like:
  818: 
  819:     sub connect {
  820:         my ($self, $host, $port, $ssl, $file, $content) = @_;
  821: 
  822:         die if $file && $content;                    # mutually exclusive
  823:         die unless $host || $file;                   # required group
  824:         die "Port requires host" if $port && !$host; # dependency
  825:         die if $ssl && $port != 443;                 # value constraint
  826: 
  827:         # ... connection logic
  828:     }
  829: 
  830: The extractor generates:
  831: 
  832:     relationships:
  833:       - type: mutually_exclusive
  834:         params: [file, content]
  835:         description: Cannot specify both file and content
  836:       - type: required_group
  837:         params: [host, file]
  838:         logic: or
  839:         description: Must specify either host or file
  840:       - type: dependency
  841:         param: port
  842:         requires: host
  843:         description: port requires host to be specified
  844:       - type: value_constraint
  845:         if: ssl
  846:         then: port
  847:         operator: ==
  848:         value: 443
  849:         description: When ssl is specified, port must equal 443
  850: 
  851: =head1 MODERN PERL FEATURES
  852: 
  853: This module adds support for:
  854: 
  855: =head2 Subroutine Signatures (Perl 5.20+)
  856: 
  857:     sub connect($host, $port = 3306, %options) {
  858:         ...
  859:     }
  860: 
  861: Extracts: required params, optional params with defaults, slurpy params
  862: 
  863: =head2 Type Constraints (Perl 5.36+)
  864: 
  865:     sub calculate($x :Int, $y :Num) {
  866:         ...
  867:     }
  868: 
  869: Recognizes: Int, Num, Str, Bool, ArrayRef, HashRef, custom classes
  870: 
  871: =head3 Subroutine Attributes
  872: 
  873:     sub get_value :lvalue :Returns(Int) {
  874:         ...
  875:     }
  876: 
  877: Detects: :lvalue, :method, :Returns(Type), custom attributes
  878: 
  879: =head2 Postfix Dereferencing (Perl 5.20+)
  880: 
  881:     my @array = $arrayref->@*;
  882:     my %hash = $hashref->%*;
  883:     my @slice = $arrayref->@[1,3,5];
  884: 
  885: Tracks usage of modern dereferencing syntax
  886: 
  887: =head2 Field Declarations (Perl 5.38+)
  888: 
  889:     field $host :param = 'localhost';
  890:     field $port :param(port_number) = 3306;
  891:     field $logger :param :isa(Log::Any);
  892: 
  893: Extracts fields and maps them to parameters
  894: 
  895: =head2 Modern Perl Features Support
  896: 
  897: The schema extractor supports modern Perl syntax introduced in versions 5.20, 5.36, and 5.38+.
  898: 
  899: =head3 Subroutine Signatures (Perl 5.20+)
  900: 
  901: Automatically extracts parameters from native Perl signatures:
  902: 
  903:     use feature 'signatures';
  904: 
  905:     sub connect($host, $port = 3306, $database = undef) {
  906:         ...
  907:     }
  908: 
  909: Extracted schema includes:
  910: 
  911: =over 4
  912: 
  913: =item * Parameter positions
  914: 
  915: =item * Optional vs required parameters
  916: 
  917: =item * Default values from signature
  918: 
  919: =item * Slurpy parameters (@array, %hash)
  920: 
  921: =back
  922: 
  923: B<Example:>
  924: 
  925:     # Signature with defaults
  926:     sub process($file, %options) { ... }
  927: 
  928:     # Extracts:
  929:     # $file: position 0, required
  930:     # %options: position 1, optional, slurpy hash
  931: 
  932: =head3 Type Constraints in Signatures (Perl 5.36+)
  933: 
  934: Recognizes type constraints in signature parameters:
  935: 
  936:     sub calculate($x :Int, $y :Num, $name :Str = "result") {
  937:         return $x + $y;
  938:     }
  939: 
  940: Supported constraint types:
  941: 
  942: =over 4
  943: 
  944: =item * C<:Int, :Integer> -> integer
  945: 
  946: =item * C<:Num, :Number> -> number
  947: 
  948: =item * C<:Str, :String> -> string
  949: 
  950: =item * C<:Bool, :Boolean> -> boolean
  951: 
  952: =item * C<:ArrayRef, :Array> -> arrayref
  953: 
  954: =item * C<:HashRef, :Hash> -> hashref
  955: 
  956: =item * C<:ClassName> -> object with isa constraint
  957: 
  958: =back
  959: 
  960: Type constraints are combined with defaults when both are present.
  961: 
  962: =head3 Subroutine Attributes
  963: 
  964: Extracts and documents subroutine attributes:
  965: 
  966:     sub get_value :lvalue {
  967:         my $self = shift;
  968:         return $self->{value};
  969:     }
  970: 
  971:     sub calculate :Returns(Int) :method {
  972:         my ($self, $x, $y) = @_;
  973:         return $x + $y;
  974:     }
  975: 
  976: Recognized attributes stored in C<_attributes> field:
  977: 
  978: =over 4
  979: 
  980: =item * C<:lvalue> - Method can be assigned to
  981: 
  982: =item * C<:method> - Explicitly marked as method
  983: 
  984: =item * C<:Returns(Type)> - Declares return type
  985: 
  986: =item * Custom attributes with values: C<:MyAttr(value)>
  987: 
  988: =back
  989: 
  990: =head3 Postfix Dereferencing (Perl 5.20+)
  991: 
  992: Detects usage of postfix dereferencing syntax:
  993: 
  994:     use feature 'postderef';
  995: 
  996:     sub process_array {
  997:         my ($self, $arrayref) = @_;
  998:         my @array = $arrayref->@*;        # Array dereference
  999:         my @slice = $arrayref->@[1,3,5];  # Array slice
 1000:         return @array;
 1001:     }
 1002: 
 1003:     sub process_hash {
 1004:         my ($self, $hashref) = @_;
 1005:         my %hash = $hashref->%*;          # Hash dereference
 1006:         return keys %hash;
 1007:     }
 1008: 
 1009: Tracked features stored in C<_modern_features>:
 1010: 
 1011: =over 4
 1012: 
 1013: =item * C<array_deref> - Uses C<-E<gt>@*>
 1014: 
 1015: =item * C<hash_deref> - Uses C<-E<gt>%*>
 1016: 
 1017: =item * C<scalar_deref> - Uses C<-E<gt>$*>
 1018: 
 1019: =item * C<code_deref> - Uses C<-E<gt>&*>
 1020: 
 1021: =item * C<array_slice> - Uses C<-E<gt>@[...]>
 1022: 
 1023: =item * C<hash_slice> - Uses C<-E<gt>%{...}>
 1024: 
 1025: =back
 1026: 
 1027: =head3 Field Declarations (Perl 5.38+)
 1028: 
 1029: Extracts field declarations from class syntax and maps them to method parameters:
 1030: 
 1031:     use feature 'class';
 1032: 
 1033:     class DatabaseConnection {
 1034:         field $host :param = 'localhost';
 1035:         field $port :param = 3306;
 1036:         field $username :param(user);
 1037:         field $password :param;
 1038:         field $logger :param :isa(Log::Any);
 1039: 
 1040:         method connect() {
 1041:             # Fields available as instance variables
 1042:         }
 1043:     }
 1044: 
 1045: Field attributes:
 1046: 
 1047: =over 4
 1048: 
 1049: =item * C<:param> - Field is a constructor parameter (uses field name)
 1050: 
 1051: =item * C<:param(name)> - Field maps to parameter with different name
 1052: 
 1053: =item * C<:isa(Class)> - Type constraint for the field
 1054: 
 1055: =item * Default values in field declarations
 1056: 
 1057: =back
 1058: 
 1059: Extracted schema includes both field information in C<_fields> and merged parameter
 1060: information in C<input>, allowing proper validation of class constructors.
 1061: 
 1062: =head3 Mixed Modern and Traditional Syntax
 1063: 
 1064: The extractor handles code that mixes modern and traditional syntax:
 1065: 
 1066:     sub modern($x, $y = 5) {
 1067:         # Modern signature with default
 1068:     }
 1069: 
 1070:     sub traditional {
 1071:         my ($self, $x, $y) = @_;
 1072:         $y //= 5;  # Traditional default in code
 1073:         # Both extract same parameter information
 1074:     }
 1075: 
 1076: Priority order for parameter information:
 1077: 
 1078: =over 4
 1079: 
 1080: =item 1. Signature declarations (highest priority)
 1081: 
 1082: =item 2. Field declarations (for class methods)
 1083: 
 1084: =item 3. POD documentation
 1085: 
 1086: =item 4. Code analysis (lowest priority)
 1087: 
 1088: =back
 1089: 
 1090: This ensures that explicit declarations in signatures take precedence over
 1091: inferred information from code analysis.
 1092: 
 1093: =head3 Backwards Compatibility
 1094: 
 1095: All modern Perl feature detection is optional and automatic:
 1096: 
 1097: =over 4
 1098: 
 1099: =item * Traditional C<sub> declarations continue to work
 1100: 
 1101: =item * Code without modern features extracts parameters as before
 1102: 
 1103: =item * Modern features are additive - they enhance rather than replace existing extraction
 1104: 
 1105: =item * Schemas include C<_source> field indicating where parameter info came from
 1106: 
 1107: =back
 1108: 
 1109: =head2 _yamltest_hints
 1110: 
 1111: Each method schema returned by L</extract_all> now optionally includes a
 1112: C<_yamltest_hints> key, which provides guidance for automated test generation
 1113: based on the code analysis.
 1114: 
 1115: This is intended to help L<App::Test::Generator> create meaningful tests,
 1116: including boundary and invalid input cases, without manually specifying them.
 1117: 
 1118: The structure is a hashref with the following keys:
 1119: 
 1120: =over 4
 1121: 
 1122: =item * boundary_values
 1123: 
 1124: An arrayref of numeric values that represent boundaries detected from
 1125: comparisons in the code. These are derived from literals in statements
 1126: like C<$x < 0> or C<$y >= 255>. The generator can use these to create
 1127: boundary tests.
 1128: 
 1129: Example:
 1130: 
 1131:     _yamltest_hints:
 1132:       boundary_values: [0, 1, 100, 255]
 1133: 
 1134: =item * invalid_inputs
 1135: 
 1136: An arrayref of values that are likely to be rejected by the method,
 1137: based on checks like C<defined>, empty strings, or numeric validations.
 1138: 
 1139: Example:
 1140: 
 1141:     _yamltest_hints:
 1142:       invalid_inputs: [undef, '', -1]
 1143: 
 1144: =item * equivalence_classes
 1145: 
 1146: An arrayref intended to capture detected equivalence classes or patterns
 1147: among inputs. Currently this is empty by default, but future enhancements
 1148: may populate it based on detected input groupings.
 1149: 
 1150: Example:
 1151: 
 1152:     _yamltest_hints:
 1153:       equivalence_classes: []
 1154: 
 1155: =back
 1156: 
 1157: =head3 Usage
 1158: 
 1159: When calling C<extract_all>, each method schema will include
 1160: C<_yamltest_hints> if any hints were detected:
 1161: 
 1162:     my $schemas = $extractor->extract_all;
 1163:     my $hints  = $schemas->{example_method}->{_yamltest_hints};
 1164: 
 1165: You can then feed these hints into automated test generators to produce
 1166: negative tests, boundary tests, and parameter-specific test cases.
 1167: 
 1168: =head3 Notes
 1169: 
 1170: =over 4
 1171: 
 1172: =item * Hints are inferred heuristically from code and validation statements.
 1173: 
 1174: =item * Not all inputs are guaranteed to be detected; the feature is additive
 1175: and will never remove information from the schema.
 1176: 
 1177: =item * Currently, equivalence classes are not populated, but the field exists
 1178: for future extension.
 1179: 
 1180: =item * Boundary and invalid input hints are deduplicated to avoid repeated
 1181: test values.
 1182: 
 1183: =back
 1184: 
 1185: =head3 Examples
 1186: 
 1187: Given a method like:
 1188: 
 1189:     sub example {
 1190:         my ($x) = @_;
 1191:         die "negative" if $x < 0;
 1192:         return unless defined($x);
 1193:         return $x * 2;
 1194:     }
 1195: 
 1196: After running:
 1197: 
 1198:     my $extractor = App::Test::Generator::SchemaExtractor->new(
 1199:         input_file => 'TestHints.pm',
 1200:         output_dir => '/tmp',
 1201:         quiet    => 1,
 1202:     );
 1203: 
 1204:     my $schemas = $extractor->extract_all;
 1205: 
 1206: The schema for the method "example" will include:
 1207: 
 1208:     $schemas->{example} = {
 1209:         function => 'example',
 1210:         _confidence => {
 1211:             input  => 'unknown',
 1212:             output => 'unknown',
 1213:         },
 1214:         input => {
 1215:             x => {
 1216:                 type     => 'scalar',
 1217:                 optional => 0,
 1218:             }
 1219:         },
 1220:         output => {
 1221:             type => 'scalar',
 1222:         },
 1223:         _yamltest_hints => {
 1224:             boundary_values => [0, 1],
 1225:             invalid_inputs  => [undef, -1],
 1226:             equivalence_classes => [],
 1227:         },
 1228:         _notes => '...',
 1229:         _analysis => {
 1230:             input_confidence  => 'low',
 1231:             output_confidence => 'unknown',
 1232:             confidence_factors => {
 1233:                 input  => {...},
 1234:                 output => {...},
 1235:             },
 1236:             overall_confidence => 'low',
 1237:         },
 1238:         _fields => {},
 1239:         _modern_features => {},
 1240:         _attributes => {},
 1241:     };
 1242: 
 1243: =head1 METHODS
 1244: 
 1245: =head2 new
 1246: 
 1247: Construct a new SchemaExtractor for a given Perl source file.
 1248: 
 1249:     my $extractor = App::Test::Generator::SchemaExtractor->new(
 1250:         input_file           => 'lib/MyModule.pm',  # Required
 1251:         output_dir           => 'schemas/',         # Optional - only needed if writing schemas
 1252:         verbose              => 1,                  # Default: 0
 1253:         include_private      => 1,                  # Default: 0
 1254:         max_parameters       => 50,                 # Default: 20
 1255:         confidence_threshold => 0.7,               # Default: 0.5
 1256:         strict_pod           => 0|1|2,              # Default: 0 (off)
 1257:         allow_signature_exec => 1,                  # Default: 0 (off)
 1258:     );
 1259: 
 1260: =head3 Arguments
 1261: 
 1262: =over 4
 1263: 
 1264: =item * C<$input_file>
 1265: 
 1266: Path to the Perl source file to analyse. Required. Must exist on disk.
 1267: 
 1268: =item * C<output_dir>
 1269: 
 1270: Directory to write generated schema YAML files. Optional - only
 1271: required if C<_write_schema> will be called. Callers passing
 1272: C<no_write =E<gt> 1> to C<extract_all> do not need to supply it.
 1273: 
 1274: =item * C<verbose>
 1275: 
 1276: Print progress messages to stdout during analysis. Optional, default 0.
 1277: 
 1278: =item * C<include_private>
 1279: 
 1280: Include methods whose names begin with C<_> in the analysis. Optional,
 1281: default 0. Methods whose name begins with C<_new>, C<_init>, or
 1282: C<_build> are always included regardless of this setting (a prefix
 1283: match, so e.g. C<_build_attribute> and C<_init_logger> qualify too,
 1284: matching common Moose builder/initializer naming conventions).
 1285: 
 1286: =item * C<max_parameters>
 1287: 
 1288: Safety limit on the number of parameters analysed per method to prevent
 1289: runaway processing on pathological code. Optional, default 20.
 1290: 
 1291: =item * C<confidence_threshold>
 1292: 
 1293: Minimum confidence score (0.0-1.0) below which a schema is marked with
 1294: C<_low_confidence =E<gt> 1>. Optional, default 0.5.
 1295: 
 1296: =item * C<strict_pod>
 1297: 
 1298: Controls POD/code agreement validation. C<0> disables validation,
 1299: C<1> emits warnings, C<2> croaks on first disagreement. Also accepts
 1300: the strings C<off>, C<warn>, and C<fatal>. Optional, default 0.
 1301: 
 1302: =item * C<allow_signature_exec>
 1303: 
 1304: Opt-in flag allowing extraction of parameter types from a
 1305: L<Type::Params> C<signature_for()> declaration. This requires actually
 1306: running the C<signature_for> expression (sliced from the target
 1307: module's own source) in a forked C<perl -T> process, since
 1308: L<Type::Params> types are runtime objects that cannot be introspected
 1309: statically. Every other extraction path in this module is static
 1310: (L<PPI>-only) analysis that never executes any of the target module's
 1311: code; this is the one exception. Optional, default 0 (the
 1312: C<signature_for> path is silently skipped, with a warning under
 1313: C<verbose>, when off). Only enable this for modules whose code you
 1314: already trust enough to execute.
 1315: 
 1316: =back
 1317: 
 1318: =head3 Returns
 1319: 
 1320: A blessed hashref. Croaks if C<input_file> is missing or does not
 1321: exist on disk.
 1322: 
 1323: =head3 Side effects
 1324: 
 1325: Reads and parses the input file using L<PPI> at construction time.
 1326: 
 1327: =head3 API specification
 1328: 
 1329: =head4 input
 1330: 
 1331:     {
 1332:         input_file           => { type => SCALAR },
 1333:         output_dir           => { type => SCALAR,  optional => 1 },
 1334:         verbose              => { type => SCALAR,  optional => 1 },
 1335:         include_private      => { type => SCALAR,  optional => 1 },
 1336:         max_parameters       => { type => SCALAR,  optional => 1 },
 1337:         confidence_threshold => { type => SCALAR,  optional => 1 },
 1338:         strict_pod           => { type => SCALAR,  optional => 1 },
 1339:         allow_signature_exec => { type => SCALAR,  optional => 1 },
 1340:     }
 1341: 
 1342: =head4 output
 1343: 
 1344:     {
 1345:         type => OBJECT,
 1346:         isa  => 'App::Test::Generator::SchemaExtractor',
 1347:     }
 1348: 
 1349: =cut
 1350: 
 1351: sub new {
●1352 → 1373 → 1377 1352: 	my $class = shift;
 1353: 
 1354: 	# Handle hash or hashref arguments
 1355: 	my $params = Params::Get::get_params('input_file', @_) || {};
 1356: 
 1357: 	croak(__PACKAGE__, ': input_file required') unless exists $params->{input_file};
 1358: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1359: 	my $self = {
 1360: 		input_file => $params->{input_file},
 1361: 		# output_dir is optional — only required if _write_schema will be called.
 1362: 		# Callers using extract_all(no_write => 1) do not need to supply it.
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1363: 		output_dir => $params->{output_dir},
 1364: 		verbose	=> $params->{verbose} // 0,
 1365: 		include_private => $params->{include_private} // 0,	# include _private methods
 1366: 		confidence_threshold => $params->{confidence_threshold} // $DEFAULT_CONFIDENCE_THRESH,
 1367: 		max_parameters       => $params->{max_parameters}       // $DEFAULT_MAX_PARAMETERS,	# safety limit
 1368: 		strict_pod => _validate_strictness_level($params->{strict_pod}),	# Enable strict POD checking
 1369: 		allow_signature_exec => $params->{allow_signature_exec} // 0,	# opt-in: execute Type::Params signature_for() exprs from the target module
 1370: 	};
 1371: 
 1372: 	# Validate input file exists
 1373: 	unless (-f $self->{input_file}) {
 1374: 		croak(__PACKAGE__, ": Input file '$self->{input_file}' does not exist");
 1375: 	}
 1376: 
 1377: 	return bless $self, $class;
 1378: }
 1379: 
 1380: =head2 extract_all
 1381: 
 1382: Extract schemas for all qualifying methods in the module and return
 1383: them as a hashref.
 1384: 
 1385:     my $schemas = $extractor->extract_all();
 1386: 
 1387:     # Suppress writing .yml files to disk
 1388:     my $schemas = $extractor->extract_all(no_write => 1);
 1389: 
 1390: =head3 Arguments
 1391: 
 1392: =over 4
 1393: 
 1394: =item * C<no_write>
 1395: 
 1396: When true, schema files are not written to C<output_dir>. The returned
 1397: hashref is still fully populated. Useful when the caller wants to
 1398: inspect or augment schemas before deciding whether to write them.
 1399: Optional, default 0.
 1400: 
 1401: =back
 1402: 
 1403: =head3 Returns
 1404: 
 1405: A hashref mapping method name strings to schema hashrefs. Each schema
 1406: contains at minimum the keys C<function>, C<module>, C<input>,
 1407: C<output>, and C<_analysis>. See L</Generated Schema Structure> for
 1408: the full structure.
 1409: 
 1410: =head3 Side effects
 1411: 
 1412: Parses the input file with L<PPI>. Writes one YAML file per method to
 1413: C<output_dir> unless C<no_write> is set. Creates C<output_dir> if it
 1414: does not exist and writing is enabled.
 1415: 
 1416: =head3 Notes
 1417: 
 1418: Private methods (names beginning with C<_>) are excluded unless
 1419: C<include_private =E<gt> 1> was passed to C<new>. Duplicate method
 1420: names are deduplicated with a warning logged to stdout in verbose mode.
 1421: 
 1422: POD/code agreement validation is applied if C<strict_pod> was set in
 1423: C<new>. At level 2 (fatal), the first disagreement causes an immediate
 1424: croak.
 1425: 
 1426: =head3 API specification
 1427: 
 1428: =head4 input
 1429: 
 1430:     {
 1431:         self     => { type => OBJECT, isa => 'App::Test::Generator::SchemaExtractor' },
 1432:         no_write => { type => SCALAR, optional => 1 },
 1433:     }
 1434: 
 1435: =head4 output
 1436: 
 1437:     {
 1438:         type => HASHREF,
 1439:         keys => {
 1440:             '*' => {
 1441:                 type => HASHREF,
 1442:                 keys => {
 1443:                     function  => { type => SCALAR  },
 1444:                     module    => { type => SCALAR  },
 1445:                     input     => { type => HASHREF },
 1446:                     output    => { type => HASHREF },
 1447:                     _analysis => { type => HASHREF },
 1448:                 },
 1449:             },
 1450:         },
 1451:     }
 1452: 
 1453: =cut
 1454: 
 1455: sub extract_all {
●1456 → 1477 → 1489 1456: 	my $self = shift;
 1457: 	my $params = Params::Get::get_params(undef, @_) || {};
 1458: 
 1459: 	$self->_log("Parsing $self->{input_file}...");
 1460: 	$self->_log('Strict POD mode: ' . (qw(off warn fatal))[$self->{strict_pod}]);
 1461: 
 1462: 	# $! is not meaningful here — PPI does not set errno on failure
 1463: 	my $document = PPI::Document->new($self->{input_file})
 1464: 		or croak "Failed to parse $self->{input_file}";
 1465: 
 1466: 	# Store document for later use
 1467: 	$self->{_document} = $document;
 1468: 
 1469: 	my $package_name = $self->_extract_package_name($document);
 1470: 	$self->{_package_name} //= $package_name;
 1471: 	$self->_log("Package: $package_name");
 1472: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1473: 	my $methods = $self->_find_methods($document);
 1474: 	$self->_log('Found ' . scalar(@$methods) . ' methods (pre-dedup)');
 1475: 
 1476: 	my %schemas;
 1477: 	foreach my $method (@{$methods}) {
 1478: 		$self->_log("\nAnalyzing method: $method->{name}");
 1479: 
 1480: 		my $schema = $self->_analyze_method($method);
 1481: 		$schemas{$method->{name}} = $schema;
 1482: 		$schema->{'module'} = $package_name;
 1483: 
 1484: 		# Write individual schema file
 1485: 		# Only write schema files if no_write is not set
 1486: 		$self->_write_schema($method->{name}, $schema) unless $params->{no_write};
 1487: 	}
 1488: 
 1489: 	return \%schemas;
 1490: }
 1491: 
 1492: # --------------------------------------------------
 1493: # _extract_package_name
 1494: #
 1495: # Purpose:    Extract the Perl package name from a
 1496: #             PPI document, or from the cached value
 1497: #             stored at construction time.
 1498: #
 1499: # Entry:      $document - a PPI::Document, or undef
 1500: #                         to use $self->{_document}.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1501: #
 1502: # Exit:       Returns the package namespace string,
 1503: #             or an empty string if no package
 1504: #             statement is found.
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1505: #
 1506: # Side effects: Stores the package name in
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1507: #               $self->{_package_name} if not already
 1508: #               set.

					

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

				
NUM_BOUNDARY_1508_61_<: Numeric boundary flip > to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1508_61_>=: Numeric boundary flip > to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1508_61_<=: Numeric boundary flip > to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 1509: #
 1510: # Notes:      Croaks if more than one package
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1511: #             declaration is found — multi-package
 1512: #             files are not supported.
 1513: # --------------------------------------------------
 1514: sub _extract_package_name {
●1515 → 1517 → 1520 1515: 	my ($self, $document) = @_;
 1516: 
 1517: 	if(!defined($document)) {
 1518: 		$document = $self->{_document};
 1519: 	}
●1520 → 1521 → 1525 1520: 	my $pkgs = $document->find('PPI::Statement::Package') || [];
 1521: 	if(@$pkgs == 0) {
 1522: 		my $package_stmt = $document->find_first('PPI::Statement::Package');
 1523: 		return $package_stmt ? $package_stmt->namespace() : '';
 1524: 	}
 1525: 	croak('More than one package declaration found') if @$pkgs > 1;
 1526: 	$self->{_package_name} //= $pkgs->[0]->namespace();
 1527: 	return $pkgs->[0]->namespace();
 1528: }
 1529: 
 1530: # --------------------------------------------------
 1531: # _find_methods
 1532: #
 1533: # Purpose:    Locate all subroutine and method
 1534: #             declarations in a PPI document,
 1535: #             including Moose-style method modifiers
 1536: #             and Perl 5.38 class/method syntax.
 1537: #
 1538: # Entry:      $document - a PPI::Document.
 1539: #
 1540: # Exit:       Returns an arrayref of method hashrefs,
 1541: #             each containing: name, node, body, pod,
 1542: #             type, and optionally modifier, class,
 1543: #             and fields keys.
 1544: #             Private methods (names beginning with
 1545: #             _) are excluded unless include_private
 1546: #             was set in new(), except for _new,
 1547: #             _init, and _build which are always
 1548: #             included.
 1549: #
 1550: # Side effects: Logs progress and warnings to stdout
 1551: #               when verbose is set.
 1552: #
 1553: # Notes:      Duplicate method names are silently
 1554: #             deduplicated — the second occurrence
 1555: #             is dropped with a verbose warning.
 1556: #             Class/method detection is regex-based
 1557: #             and may misbehave on complex code.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1558: # --------------------------------------------------
 1559: sub _find_methods {
●1560 → 1572 → 1597 1560: 	my ($self, $document) = @_;
 1561: 
 1562: 	my $subs = $document->find('PPI::Statement::Sub') || [];
 1563: 	# Only fetch statements that begin with a Moose modifier keyword —
 1564: 	# fetching ALL PPI::Statement nodes on a large file returns thousands
 1565: 	# of nodes and then discards nearly all of them in the loop below.
 1566: 	my $sub_decls = $document->find(sub {
 1567: 		$_[1]->isa('PPI::Statement')
 1568: 		&& $_[1]->content =~ /^\s*(?:before|after|around)\b/
 1569: 	}) || [];
 1570: 
 1571: 	my @methods;
 1572: 	foreach my $sub (@$subs) {
 1573: 		my $name = $sub->name();
 1574: 
 1575: 		next unless defined $name;	# Skip anonymous routines
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1576: 		next if $name =~ /^(BEGIN|END|DESTROY|AUTOLOAD|CHECK|INIT|UNITCHECK)$/;
 1577: 		next if $name =~ /::/;		# cross-package sub (e.g. sub DB::DB { })
 1578: 
 1579: 		# Skip private methods unless explicitly included, or they're special
 1580: 		if ($name =~ /^_/ && $name !~ /^_(new|init|build)/) {
 1581: 			next unless $self->{include_private};
 1582: 		}
 1583: 
 1584: 		# Get the POD before this sub
 1585: 		my $pod = $self->_extract_pod_before($sub);
 1586: 
 1587: 		push @methods, {
 1588: 			name => $name,
 1589: 			node => $sub,
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1590: 			body => $sub->content(),
 1591: 			pod => $pod,
 1592: 			type => 'sub',
 1593: 		};
 1594: 	}
 1595: 
 1596: 	# Look for class { method } syntax (Perl 5.38+)
●1597 → 1598 → 1610 1597: 	my $content = $document->content();
 1598: 	if ($content =~ /\bclass\b/) {
 1599: 		$self->_log('  Detecting class/method syntax...');

					

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

				
COND_INV_1599_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1600: 		# Strip POD blocks and line comments before the regex scan so that
 1601: 		# patterns like  class Name {  inside documentation examples or
 1602: 		# the comment  # find "class Name {" blocks  don't produce
 1603: 		# spurious method names (e.g. the keyword 'if').
 1604: 		(my $code_only = $content) =~ s/^=\w[^\n]*.*?^=cut[^\n]*\n//gms;
 1605: 		$code_only =~ s/\s*#[^\n]*//g;
 1606: 		$self->_extract_class_methods($code_only, \@methods);
 1607: 	}
 1608: 
 1609: 	# Process method modifiers (Moose)
●1610 → 1610 → 1639 1610: 	foreach my $decl (@$sub_decls) {
 1611: 		my $content = $decl->content;
 1612: 		if ($content =~ /^\s*(before|after|around)\s+['"]?(\w+)['"]?\b/) {
 1613: 			my ($modifier, $method_name) = ($1, $2);
 1614: 			my $full_name = "${modifier}_$method_name";
 1615: 
 1616: 			# Look for the actual sub definition that follows
 1617: 			my $next_sib = $decl->next_sibling;
 1618: 			while ($next_sib && !$next_sib->isa('PPI::Statement::Sub')) {
 1619: 				$next_sib = $next_sib->next_sibling;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1620: 			}
 1621: 
 1622: 			if ($next_sib && $next_sib->isa('PPI::Statement::Sub')) {
 1623: 				my $pod = $self->_extract_pod_before($decl); # POD might be before modifier
 1624: 				push @methods, {
 1625: 					name => $full_name,
 1626: 					node => $next_sib,
 1627: 					body => $next_sib->content,
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1628: 					pod => $pod,
 1629: 					type => 'modifier',
 1630: 					original_method => $method_name,
 1631: 					modifier => $modifier,
 1632: 				};
 1633: 				$self->_log("  Found method modifier: $full_name");
 1634: 			}
 1635: 		}
 1636: 	}
 1637: 
 1638: 	# Prevent silent duplicate method overwrites
 1639: 	my %seen;
 1640: 	@methods = grep {
 1641: 		my $n = $_->{name};
 1642: 		if ($seen{$n}++) {
 1643: 			$self->_log("  WARNING: duplicate method '$n' ignored");
 1644: 			0;
 1645: 		} else {
 1646: 			1;
 1647: 		}
 1648: 	} @methods;
 1649: 
 1650: 	return \@methods;
 1651: }
 1652: 
 1653: # --------------------------------------------------
 1654: # _extract_class_methods
 1655: #
 1656: # Purpose:    Extract method declarations from
 1657: #             Perl 5.38 class { method {} } syntax
 1658: #             by regex-based scanning of the class
 1659: #             body content.
 1660: #
 1661: # Entry:      $content - full document source string.
 1662: #             $methods - arrayref to push discovered
 1663: #                        method hashrefs onto
 1664: #                        (modified in place).
 1665: #
 1666: # Exit:       Returns nothing. Appends to $methods.
 1667: #
 1668: # Side effects: Logs class and method discoveries
 1669: #               to stdout when verbose is set.
 1670: #
 1671: # Notes:      This is experimental — regex-based
 1672: #             class body parsing may misbehave on
 1673: #             complex or nested class declarations.
 1674: #             Class body boundaries are tracked by
 1675: #             simple brace counting, which will
 1676: #             fail on unbalanced braces in strings
 1677: #             or heredocs.
 1678: # --------------------------------------------------
 1679: sub _extract_class_methods {
●1680 → 1686 → 0 1680: 	my ($self, $content, $methods) = @_;
 1681: 
 1682: 	# EXPERIMENTAL: regex-based parsing, may misbehave on complex code
 1683: 
 1684: 	# Simple pattern: find "class Name {" blocks
 1685: 	# This won't handle all edge cases but will work for simple classes
 1686: 	while ($content =~ /class\s+(\w+)\s*\{/g) {
 1687: 		my $class_name = $1;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1688: 		my $start_pos = pos($content);
 1689: 
 1690: 		# Find the matching closing brace. $start_pos is just after the
 1691: 		# opening '{' consumed by the regex above, so back up one
 1692: 		# character to hand the brace itself to extract_bracketed.
 1693: 		require Text::Balanced;
 1694: 		my $extracted = Text::Balanced::extract_bracketed(substr($content, $start_pos - 1), '{}');
 1695: 
 1696: 		next unless defined $extracted;	# unbalanced braces, skip class
 1697: 
 1698: 		my $class_body = substr($extracted, 1, length($extracted) - 2);
 1699: 
 1700: 		$self->_log("  Found class $class_name");
 1701: 
 1702: 		# Extract field declarations from class
 1703: 		my $fields = $self->_extract_field_declarations($class_body);
 1704: 
 1705: 		# Find methods in the class body
 1706: 		while ($class_body =~ /method\s+(\w+)\s*(\([^)]*\))?\s*\{/g) {
 1707: 			my ($method_name, $sig_with_parens) = ($1, $2 || '()');
 1708: 
 1709: 			# Skip private unless configured
 1710: 			if ($method_name =~ /^_/ && $method_name !~ /^_(new|init|build)/) {
 1711: 				next unless $self->{include_private};
 1712: 			}
 1713: 
 1714: 			# Reconstruct as sub for analysis
 1715: 			my $signature = $sig_with_parens;
 1716: 			$signature =~ s/^\(//;
 1717: 			$signature =~ s/\)$//;
 1718: 
 1719: 			# Build a fake sub declaration
 1720: 			my $fake_sub = "sub $method_name($signature) { }";
 1721: 
 1722: 			push @$methods, {
 1723: 				name => $method_name,
 1724: 				node => undef,
 1725: 				body => $fake_sub,	# Just the signature for now
 1726: 				is_stub => 1,
 1727: 				pod => '',
 1728: 				type => 'method',
 1729: 				class => $class_name,
 1730: 				fields => $fields,
 1731: 			};
 1732: 
 1733: 			$self->_log("  Found method $method_name in class $class_name");
 1734: 		}
 1735: 	}
 1736: }
 1737: 
 1738: # --------------------------------------------------
 1739: # _extract_pod_before
 1740: #
 1741: # Purpose:    Collect the POD documentation that
 1742: #             appears immediately before a
 1743: #             subroutine in the PPI document, by
 1744: #             walking backwards through siblings.
 1745: #
 1746: # Entry:      $sub - a PPI node (typically a
 1747: #                    PPI::Statement::Sub).
 1748: #
 1749: # Exit:       Returns a string containing all POD
 1750: #             content found before the sub, with
 1751: #             inline parameter comments converted
 1752: #             to =item format. Returns an empty
  Mutants (Total: 3, Killed: 3, Survived: 0)
 1753: #             string if no POD is found.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1754: #
 1755: # Side effects: None.
 1756: #
 1757: # Notes:      Stops walking backwards on the first
 1758: #             non-POD, non-whitespace, non-separator,
 1759: #             non-include node encountered.

					

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

				
COND_INV_1759_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1760: #             Walking is capped at $POD_WALK_LIMIT
 1761: #             steps to prevent runaway processing
 1762: #             on pathological documents.
 1763: # --------------------------------------------------
 1764: sub _extract_pod_before {
●1765 → 1775 → 1797 1765: 	my ($self, $sub) = @_;
 1766: 
 1767: 	my $pod = '';
 1768: 	my $current = $sub->previous_sibling();
 1769: 	my $seen_code = 0;
 1770: 	my $steps = 0;
 1771: 
 1772: 	# Walk backwards collecting POD.
 1773: 	# Stop after the first pod token so that a =cut before =head1 METHODS
 1774: 	# prevents class-level POD from being mistaken for method-specific POD.
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1775: 	while($current && $steps++ < $POD_WALK_LIMIT) {
 1776: 		if ($current->isa('PPI::Token::Pod')) {
 1777: 			$pod = $current->content() . $pod;
 1778: 			last;	# Only take the immediately adjacent pod block
 1779: 		} elsif ($current->isa('PPI::Token::Comment')) {
 1780: 			# Include comments that might contain parameter info
 1781: 			my $comment = $current->content();
 1782: 			if ($comment =~ /#\s*(?:param|arg|input)\s+\$(\w+)\s*:\s*(.+)/i) {
 1783: 				$pod .= "=item \$$1\n$2\n\n";
 1784: 			}
 1785: 		} elsif ($current->isa('PPI::Token::Whitespace') ||
 1786: 			 $current->isa('PPI::Token::Separator')) {
 1787: 			# Skip whitespace and separators
 1788: 		} elsif ($current->isa('PPI::Statement::Include')) {
 1789: 			# allow 'use strict', 'use warnings' between POD and sub
 1790: 		} else {
 1791: 			# Hit non-POD, non-whitespace - stop
 1792: 			last;
 1793: 		}
 1794: 		$current = $current->previous_sibling();
 1795: 	}
 1796: 
 1797: 	return $pod;
 1798: }
 1799: 
 1800: # --------------------------------------------------
 1801: # _analyze_method
 1802: #
 1803: # Purpose:    Perform full multi-source analysis of
 1804: #             a single method and produce a complete
 1805: #             schema hashref, combining POD analysis,
 1806: #             code pattern detection, signature
 1807: #             analysis, validator schema extraction,
 1808: #             confidence scoring, relationship
 1809: #             detection, and modern Perl feature
 1810: #             extraction.
 1811: #
 1812: # Entry:      $method - a method hashref as produced
 1813: #                       by _find_methods, containing
 1814: #                       at minimum: name, body, pod.
 1815: #
 1816: # Exit:       Returns a schema hashref containing:
 1817: #             function, input, output, _confidence,
 1818: #             _analysis, _notes, and optionally:
 1819: #             new, accessor, relationships,
 1820: #             _yamltest_hints, _attributes,
 1821: #             _modern_features, _fields, _model,
 1822: #             _low_confidence.
 1823: #
 1824: # Side effects: Logs progress to stdout when verbose
 1825: #               is set. May carp or croak if
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1826: #               strict_pod is enabled and POD/code
 1827: #               disagreements are found.
 1828: #
 1829: # Notes:      This is the central analysis entry
 1830: #             point — it orchestrates all other
 1831: #             analysis helpers and merges their
 1832: #             results. The non-invasive reasoning
 1833: #             layer (Model::Method, Analyzer::*)
 1834: #             runs after the main schema is built
 1835: #             and attaches metadata only.
 1836: # --------------------------------------------------
 1837: sub _analyze_method {
●1838 → 1848 → 1852 1838: 	my ($self, $method) = @_;
 1839: 	my $code = $method->{body};
 1840: 	my $pod = $method->{pod};
 1841: 
 1842: 	# Extract modern features
 1843: 	my $attributes = $self->_extract_subroutine_attributes($code);
 1844: 	my $postfix_derefs = $self->_analyze_postfix_dereferencing($code);
 1845: 	my $fields = $self->_extract_field_declarations($code);
 1846: 
 1847: 	# If this method came from a class, use those field declarations
 1848: 	if ($method->{fields} && keys %{$method->{fields}}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1849: 		$fields = $method->{fields};
 1850: 	}
 1851: 
●1852 → 1871 → 1901 1852: 	my $schema = {
 1853: 		function => $method->{name},
 1854: 		_confidence => {
 1855: 			'input' => {},
 1856: 			'output' => {}
 1857: 		},
 1858: 		input => {},
 1859: 		output => {},
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1860: 		setup => undef,
 1861: 		transforms => {},
 1862: 	};
 1863: 
 1864: 	# Analyze different sources
 1865: 	my $pod_params = $self->_analyze_pod($pod);
 1866: 	my $code_params = $self->_analyze_code($code, $method);
 1867: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1868: 	# Validate POD/code agreement if strict mode is enabled.
 1869: 	# Skip when there is no POD at all — strict_pod checks accuracy of
 1870: 	# existing documentation, not whether every method is documented.
 1871: 	if ($self->{strict_pod} && $pod) {
 1872: 		my @validation_errors = $self->_validate_pod_code_agreement(
 1873: 			$pod_params,
 1874: 			$code_params,
 1875: 			$method->{name},
 1876: 			{
 1877: 				ignore_self => 1,
 1878: 				allow_renames => 1,
 1879: 			}
 1880: 		);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1881: 
 1882: 		if (@validation_errors) {
 1883: 			my $error_msg = "POD/Code disagreement in method '$method->{name}':\n  " .
 1884: 				join("\n  ", @validation_errors);
 1885: 
 1886: 			# Add to schema for reference even if we croak
 1887: 			$schema->{_pod_validation_errors} = \@validation_errors;
 1888: 
 1889: 			# Either croak immediately or log based on configuration
 1890: 			if($self->{strict_pod} == $STRICT_POD_FATAL) {
 1891: 				croak("[POD STRICT] $error_msg");
 1892: 			} else {	# 1 = warnings
 1893: 				carp("[POD STRICT] $error_msg");
 1894: 				# Continue with analysis, but mark as problematic
 1895: 				$schema->{_pod_disagreement} = 1;
 1896: 			}
 1897: 		}
 1898: 		$schema->{_strict_pod_level} = $self->{strict_pod};
 1899: 	}
 1900: 
●1901 → 1903 → 1941 1901: 	my $validator_params = $self->_extract_validator_schema($code);
 1902: 
 1903: 	if ($validator_params) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1904: 		$schema->{input} = $validator_params->{input};
 1905: 		$schema->{input_style} = 'hash';
 1906: 		$schema->{_confidence}{input} = { 'factors' => [ 'Determined from validator' ], 'level' => 'high' };
 1907: 		$schema->{_analysis}{confidence_factors}{input} = [
 1908: 			'Input schema extracted from validator'
 1909: 		];
 1910: 		# =head4 Input spec overrides take highest priority — apply them on top of
 1911: 		# the validator schema so authors can tune test constraints (optional,
 1912: 		# memberof, matches) without altering the runtime validation call.
 1913: 		for my $name (keys %$pod_params) {
 1914: 			next unless $pod_params->{$name}{_from_input_spec};
 1915: 			my $pod_p = $pod_params->{$name};
 1916: 			$schema->{input}{$name} //= {};
 1917: 			$schema->{input}{$name}{optional}  = $pod_p->{optional}  if defined $pod_p->{optional};
 1918: 			$schema->{input}{$name}{memberof}  = $pod_p->{memberof}  if defined $pod_p->{memberof};
 1919: 			$schema->{input}{$name}{matches}   = $pod_p->{matches}   if defined $pod_p->{matches};
 1920: 			$schema->{input}{$name}{type}      = $pod_p->{type}      if defined $pod_p->{type};
 1921: 			$schema->{input}{$name}{min}       = $pod_p->{min}       if defined $pod_p->{min};
 1922: 			$schema->{input}{$name}{max}       = $pod_p->{max}       if defined $pod_p->{max};
 1923: 		}
 1924: 	} else {
 1925: 		# Merge field declarations into code_params before merging analyses
 1926: 		if (keys %$fields) {
 1927: 			$self->_merge_field_declarations($code_params, $fields);
 1928: 		}
 1929: 
 1930: 		# Merge analyses
 1931: 		$schema->{input} = $self->_merge_parameter_analyses(
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1932: 			$pod_params,
 1933: 			$code_params,
 1934: 		);
 1935: 	}
 1936: 
 1937: # ----------------------------------------
 1938: # Legacy Output Analysis (unchanged)

					

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

				
COND_INV_1938_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1939: # ----------------------------------------
 1940: 
●1941 → 1954 → 1960 1941: $schema->{output} = $self->_analyze_output(
 1942:     $method->{pod},
 1943:     $method->{body},
 1944:     $method->{name}
 1945: );
 1946: 
 1947: 
 1948: 	# Detect accessor methods
 1949: 	$self->_detect_accessor_methods($method, $schema);
 1950: 
 1951: 	# Detect if this is an instance method that needs object instantiation
 1952: 	# Constructors never require object instantiation
 1953: 	my $needs_object = $self->_needs_object_instantiation($method->{name}, $method->{body}, $method);
 1954: 	if($method->{name} ne 'new' && $needs_object) {
 1955: 		$schema->{new} = $needs_object;
 1956: 		$self->_log("  NEW: Method requires object instantiation: $needs_object");
 1957: 	}
 1958: 
 1959: 	# Calculate confidences

					

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

				
COND_INV_1959_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

●1960 → 1961 → 1964 1960: 	my $input_confidence = $schema->{_confidence}{'input'};
 1961: 	if(!ref($input_confidence)) {
 1962: 		$input_confidence = $schema->{_confidence}{'input'} = $self->_calculate_input_confidence($schema->{input});
 1963: 	}
●1964 → 1977 → 1982 1964: 	my $output_confidence = $schema->{_confidence}{'output'} = $self->_calculate_output_confidence($schema->{output});
 1965: 
 1966: 	# Add metadata
 1967: 	$schema->{_notes} = $self->_generate_notes($schema->{input});
 1968: 
 1969: 	# Add analytics
 1970: 	$schema->{_analysis} ||= {};
 1971: 	$schema->{_analysis}{input_confidence} = $input_confidence->{level};
 1972: 	$schema->{_analysis}{output_confidence} = $output_confidence->{level};
 1973: 	$schema->{_analysis}{confidence_factors} ||= {};
 1974: 	$schema->{_analysis}{confidence_factors}{input} ||= $input_confidence->{factors};
 1975: 	$schema->{_analysis}{confidence_factors}{output} ||= $output_confidence->{factors};
 1976: 
 1977: 	foreach my $mode('input', 'output') {
 1978: 		$self->_set_defaults($schema, $mode);

					

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

				
NUM_BOUNDARY_1978_42_>: Numeric boundary flip < to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1978_42_<=: Numeric boundary flip < to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1978_42_>=: Numeric boundary flip < to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 1979: 	}
 1980: 
 1981: 	# Optionally store detailed per-parameter analysis
●1982 → 1982 → 1987 1982: 	if ($input_confidence->{per_parameter}) {
 1983: 		$schema->{_analysis}{per_parameter_scores} = $input_confidence->{per_parameter};
 1984: 	}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1985: 
 1986: 	# Calculate overall confidence (for backward compatibility)
●1987 → 2007 → 2013 1987: 	my $input_level = $input_confidence->{level};
 1988: 	my $output_level = $output_confidence->{level};
 1989: 
 1990: 	my %level_rank = (
 1991: 		none => 0,
 1992: 		very_low => 1,
 1993: 		low => 2,
 1994: 		medium => 3,
 1995: 		high => 4

					

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

				
COND_INV_1995_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1996: 	);
 1997: 
 1998: 	# Overall is the lower of input and output
 1999: 	$input_level //= 'none';
 2000: 	$output_level //= 'none';
 2001: 	my $overall = $level_rank{$input_level} < $level_rank{$output_level} ? $input_level : $output_level;
 2002: 
 2003: 	$schema->{_analysis}{overall_confidence} = $overall;
 2004: 
 2005: 	# Analyze parameter relationships
 2006: 	my $relationships = $self->_analyze_relationships($method);
 2007: 	if ($relationships && @{$relationships}) {
 2008: 		$schema->{relationships} = $relationships;
 2009: 		$self->_log("  Found " . scalar(@$relationships) . " parameter relationships");
 2010: 	}
 2011: 
 2012: 	# Store modern feature info in schema
●2013 → 2018 → 2022 2013: 	$schema->{_attributes} = $attributes if keys %$attributes;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2014: 	$schema->{_modern_features}{postfix_dereferencing} = $postfix_derefs if keys %$postfix_derefs;
 2015: 	$schema->{_fields} = $fields if keys %$fields;
 2016: 
 2017: 	# Store class info if this is a class method
 2018: 	if ($method->{class}) {
 2019: 		$schema->{_class} = $method->{class};
 2020: 	}
 2021: 
●2022 → 2025 → 2036 2022: 	my $hints = $self->_extract_test_hints($method, $schema);
 2023: 	$self->_extract_pod_examples($pod, $hints);
 2024: 
 2025: 	for my $k (qw(boundary_values invalid_inputs valid_inputs equivalence_classes)) {
 2026: 		my %seen;
 2027: 		$hints->{$k} = [
 2028: 			grep { !$seen{ defined $_ ? $_ : '__undef__' }++ }
 2029: 			@{ $hints->{$k} }
 2030: 		];
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2031: 	}
 2032: 
 2033: 	# --------------------------------------------------
 2034: 	# YAML test hints: numeric boundaries
 2035: 	# --------------------------------------------------
●2036 → 2036 → 2053 2036: 	if ($self->_method_has_numeric_intent($schema)) {
 2037: 		$schema->{_yamltest_hints} ||= {};
 2038: 

					

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

				
NUM_BOUNDARY_2038_28_>: Numeric boundary flip < to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_2038_28_<=: Numeric boundary flip < to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_2038_28_>=: Numeric boundary flip < to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
COND_INV_2038_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2039: 		# Do not override existing hints

					

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

				
NUM_BOUNDARY_2039_28_>: Numeric boundary flip < to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_2039_28_<=: Numeric boundary flip < to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_2039_28_>=: Numeric boundary flip < to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 2040: 		$schema->{_yamltest_hints}{boundary_values} ||= [];
 2041: 
 2042: 		my %seen = map { (defined $_ ? $_ : '__undef__') => 1 }
 2043: 			@{ $schema->{_yamltest_hints}{boundary_values} };
 2044: 
 2045: 		foreach my $v (@{ $self->_numeric_boundary_values }) {
 2046: 			my $key = defined $v ? $v : '__undef__';
 2047: 			push @{ $schema->{_yamltest_hints}{boundary_values} }, $v unless $seen{$key}++;
 2048: 		}
 2049: 
 2050: 		$self->_log('  HINTS: Added numeric boundary values');
 2051: 	}
 2052: 
●2053 → 2053 → 2061 2053: 	if (keys %$hints) {
 2054: 		$schema->{_yamltest_hints} ||= {};
 2055: 		foreach my $k (keys %$hints) {
 2056: 			$schema->{_yamltest_hints}{$k} = $hints->{$k}

					

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

				
COND_INV_2056_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2057: 			unless exists $schema->{_yamltest_hints}{$k};
 2058: 		}
 2059: 	}
 2060: 
●2061 → 2061 → 2070 2061: 	if(($level_rank{$overall} < $level_rank{$LEVEL_MEDIUM}) &&
 2062: 	   ($level_rank{$overall} < ($self->{confidence_threshold} * 4))) {
 2063: 		$schema->{_low_confidence} = 1
 2064: 	}
 2065: 
 2066: 	# ----------------------------------------
 2067: 	# Non-invasive reasoning layer
 2068: 	# ----------------------------------------
 2069: 
●2070 → 2079 → 2083 2070: 	my $method_model = App::Test::Generator::Model::Method->new(
 2071: 		name => $method->{name},
 2072: 		source => $method->{body},
 2073: 	);
 2074: 
 2075: 	my $return_analyzer = App::Test::Generator::Analyzer::Return->new();
 2076: 	$return_analyzer->analyze($method_model);
 2077: 
 2078: 	# Let model learn from finalized schema
 2079: 	if ($schema->{output}) {
 2080: 		$method_model->absorb_legacy_output($schema->{output});
 2081: 	}
 2082: 
 2083: 	$method_model->resolve_return_type();
 2084: 	$method_model->resolve_classification();
 2085: 	$method_model->resolve_confidence();
 2086: 
 2087: 	# Attach only metadata
 2088: 	$schema->{_model} = {
 2089: 		classification => $method_model->classification,
 2090: 		confidence => $method_model->confidence,
 2091: 	};
 2092: 
 2093: 	# ----------------------------------------
 2094: 	# Return Meta Analysis (Non-invasive)
 2095: 	# ----------------------------------------
 2096: 
 2097: 	my $meta = App::Test::Generator::Analyzer::ReturnMeta->new();
 2098: 	my $analysis = $meta->analyze($schema);
 2099: 
 2100: 	$schema->{_analysis}{stability_score} = $analysis->{stability_score};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2101: 	$schema->{_analysis}{consistency_score} = $analysis->{consistency_score};
 2102: 	$schema->{_analysis}{risk_flags} = $analysis->{risk_flags};
 2103: 
 2104: 	# ----------------------------------------
 2105: 	# Side Effect Analysis (Non-invasive)
 2106: 	# ----------------------------------------
 2107: 
 2108: 	my $se = App::Test::Generator::Analyzer::SideEffect->new();
 2109: 
 2110: 	my $effects = $se->analyze($method);
 2111: 
 2112: 	$schema->{_analysis}{side_effects} = $effects;
 2113: 
 2114: 	# ----------------------------------------
 2115: 	# Complexity Analysis (Non-invasive)
 2116: 	# ----------------------------------------
 2117: 
 2118: 	my $cx = App::Test::Generator::Analyzer::Complexity->new();
 2119: 	my $complexity = $cx->analyze($method);
 2120: 
 2121: 	$schema->{_analysis}{complexity} = $complexity;
 2122: 
 2123: 	return $schema;
 2124: }
 2125: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2126: # --------------------------------------------------
 2127: # _method_has_numeric_intent
 2128: #
 2129: # Purpose:    Determine whether a method schema
 2130: #             has numeric intent — either a numeric
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2131: #             output type or at least one required
 2132: #             numeric input parameter — to decide
 2133: #             whether to add standard numeric
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2134: #             boundary hint values.
 2135: #
 2136: # Entry:      $schema - schema hashref as built by
 2137: #                       _analyze_method.
 2138: #
 2139: # Exit:       Returns 1 if numeric intent is
 2140: #             detected, 0 otherwise.
 2141: #
 2142: # Side effects: None.
 2143: # --------------------------------------------------
 2144: sub _method_has_numeric_intent {
●2145 → 2151 → 2156 2145: 	my ($self, $schema) = @_;
 2146: 
 2147: 	# Numeric output
 2148: 	return 1 if ($schema->{output} && $schema->{output}{type} && $schema->{output}{type} =~ /^(number|integer)$/);
 2149: 
 2150: 	# Numeric inputs
 2151: 	foreach my $p (values %{ $schema->{input} || {} }) {
 2152: 		next if $p->{optional};
 2153: 		return 1 if ($p->{type} && $p->{type} =~ /^(number|integer)$/);
 2154: 	}
 2155: 
 2156: 	return 0;
 2157: }
 2158: 
 2159: # --------------------------------------------------
 2160: # _numeric_boundary_values
 2161: #
 2162: # Purpose:    Return the standard set of numeric
 2163: #             boundary values used as test hints
 2164: #             for methods with numeric intent.
 2165: #
 2166: # Entry:      None.
 2167: #
 2168: # Exit:       Returns an arrayref of boundary
 2169: #             values: [-1, 0, 1, 2, 100].
 2170: #
 2171: # Side effects: None.
 2172: # --------------------------------------------------
 2173: sub _numeric_boundary_values {
 2174: 	return [ -1, 0, 1, 2, 100 ];
 2175: }
 2176: 
 2177: # --------------------------------------------------
 2178: # _detect_accessor_methods
 2179: #
 2180: # Purpose:    Detect whether a method is a getter,
 2181: #             setter, or combined getter/setter
 2182: #             accessor by analysing assignment and
 2183: #             return patterns involving $self->{...}.
 2184: #
 2185: # Entry:      $method - method hashref containing
 2186: #                       at minimum 'body' and
 2187: #                       optionally 'pod'.
 2188: #             $schema - schema hashref (modified
 2189: #                       in place).
 2190: #
 2191: # Exit:       Returns nothing. Modifies $schema in
 2192: #             place, setting accessor, input,
 2193: #             input_style, output, and _confidence
 2194: #             keys as appropriate.
 2195: #
 2196: # Side effects: Croaks if a getter/setter has more
 2197: #               than one argument, or if a setter
 2198: #               returns non-self data.
 2199: #               Logs detections to stdout when
 2200: #               verbose is set.
 2201: #

					

					
Mutants (Total: 4, Killed: 1, Survived: 3)
					

				
NUM_BOUNDARY_2201_25_<: Numeric boundary flip > to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_2201_25_>=: Numeric boundary flip > to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_2201_25_<=: Numeric boundary flip > to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 2202: # Notes:      Four accessor patterns are detected
 2203: #             in order: (1) combined getter/setter
 2204: #             with shift, (2) combined getter/setter
 2205: #             with validated input, (3) getter only,
 2206: #             (4) setter that returns $self. Methods
 2207: #             accessing multiple $self fields are
 2208: #             skipped immediately.
 2209: # --------------------------------------------------
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2210: sub _detect_accessor_methods {
●2211 → 2221 → 2224 2211: 	my ($self, $method, $schema) = @_;
 2212: 
 2213: 	my $body = $method->{body};
 2214: 
 2215: 	# Normalize whitespace for regex sanity
 2216: 	my $code = $body;
 2217: 	$code =~ s/\s+/ /g;

					

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

				
COND_INV_2217_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2218: 

					

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

				
COND_INV_2218_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2219: 	# If a method touches more than one $self->{...}, it’s not an accessor.
 2220: 	my %fields_seen;
 2221: 	while ($code =~ /\$self\s*->\s*\{\s*['"]?([^}'"]+)['"]?\s*\}/g) {
 2222: 		$fields_seen{$1}++;
 2223: 	}
●2224 → 2224 → 2232 2224: 	if (keys(%fields_seen) > 1) {
 2225: 		$self->_log("  Skipping accessor detection: multiple fields accessed");
 2226: 		return;
 2227: 	}
 2228: 
 2229: 	# -------------------------------
 2230: 	# Getter/Setter combo
 2231: 	# -------------------------------
●2232 → 2232 → 2438 2232: 	if (
 2233: 		# Require get/set of the same property
 2234: 		$code =~ /\$self\s*->\s*\{\s*['"]?([^}'"]+)['"]?\s*\}\s*=\s*shift\s*;/ &&
 2235: 		$code =~ /return\s+\$self\s*->\s*\{\s*['"]?\Q$1\E['"]?\s*\}\s*;/ &&
 2236: 		$code =~ /if\s*\(\s*\@_/
 2237: 	) {
 2238: 		my $property = $1;

					

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

				
COND_INV_2238_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2239: 

					

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

				
COND_INV_2239_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2240: 		if(!defined($property)) {
 2241: 			if($code =~ /\$self\s*->\s*\{\s*['"]?([^}'"]+)['"]?\s*\}\s*=\s*shift\s*;/) {
 2242: 				$property = $1;
 2243: 			}
 2244: 		}
 2245: 
 2246: 		$schema->{accessor} = {
 2247: 			type => 'getset',
 2248: 			property => $property,
 2249: 		};
 2250: 
 2251: 		$self->_log("  Detected getter/setter accessor for property: $property");
 2252: 
 2253: 		$schema->{input} ||= { value => { type => 'string', optional => 1 } };
 2254: 
 2255: 		$schema->{input_style} = 'hash';
 2256: 
 2257: 		$schema->{_confidence}{input} = {
 2258: 			level => 'high',
 2259: 			factors => ['Detected combined getter/setter accessor'],
 2260: 		};
 2261: 		if (my $pod = $method->{pod}) {
 2262: 			if ($pod =~ /\b(LWP::UserAgent(?:::\w+)*)\b/) {
 2263: 				my $class = $1;
 2264: 				$schema->{output} = {
 2265: 					type => 'object',
 2266: 					isa => $class,
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2267: 				};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2268: 				$schema->{input}{$property} = {
 2269: 					type => 'object',
 2270: 					isa => $class,
 2271: 					optional => 1,

					

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

				
COND_INV_2271_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2272: 				};
 2273: 
 2274: 				$schema->{_confidence}{output} = {
 2275: 					level => 'high',
 2276: 					factors => ['POD specifies UserAgent object'],
 2277: 				};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2278: 			}
 2279: 		}
 2280: 	} elsif($code =~ /if\s*\(\s*(?:\@_|[\$]\w+)/ &&
 2281: 	    $code =~ /\$self\s*->\s*\{\s*['"]?([^}'"]+)['"]?\s*\}\s*=\s*(?:shift|\@_|\$_\[\d+\]|\$\w+)\b/x &&
 2282: 	    $code =~ /return\b/
 2283: 	) {
 2284: 		# -------------------------------
 2285: 		# Getter/Setter (validated input)
 2286: 		# -------------------------------
 2287: 		my $property = $1;
 2288: 
 2289: 		if(!defined($property)) {
 2290: 			if($code =~ /\$self\s*->\s*\{\s*['"]?([^}'"]+)['"]?\s*\}\s*=/) {
 2291: 				$property = $1;
 2292: 			}
 2293: 		}
 2294: 		if ($code =~ /validate_strict/) {
 2295: 			push @{ $schema->{_confidence}{input}{factors} }, 'Setter uses Params::Validate::Strict';
 2296: 		} else {
 2297: 			# ---------------------------------------
 2298: 			# Detect object input via blessed($arg)
 2299: 			# ---------------------------------------
 2300: 			if ($code =~ /blessed\s*\(\s*\$(\w+)\s*\)/) {
 2301: 				my $param = $1;
 2302: 
 2303: 				$self->_log("  Detected object input via blessed(\$$param)");
 2304: 
 2305: 				$schema->{input} = {
 2306: 					$param => {

					

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

				
COND_INV_2306_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2307: 						type => 'object',
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2308: 						optional => 1,
 2309: 					}
 2310: 				};
 2311: 
 2312: 				$schema->{_confidence}{input} = {
 2313: 					level   => 'high',
 2314: 					factors => ['Input validated by Scalar::Util::blessed'],
 2315: 				};
 2316: 			} else {
 2317: 				# fallback ONLY if nothing known
 2318: 				$schema->{input} ||= {
 2319: 					value => { type => 'string', optional => 1 },
 2320: 				};
 2321: 			}
 2322: 		};
 2323: 		$schema->{accessor} = {
 2324: 			type => 'getset',
 2325: 			property => $property,
 2326: 		};
 2327: 
 2328: 		$self->_log("  Detected getter/setter accessor for property: $property");
 2329: 		if (my $pod = $method->{pod}) {
 2330: 			if ($pod =~ /\b(LWP::UserAgent(?:::\w+)*)\b/) {
 2331: 				my $class = $1;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2332: 				$schema->{output} = {
 2333: 					type => 'object',

					

					
Mutants (Total: 4, Killed: 1, Survived: 3)
					

				
NUM_BOUNDARY_2333_26_<: Numeric boundary flip > to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_2333_26_>=: Numeric boundary flip > to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_2333_26_<=: Numeric boundary flip > to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 2334: 					isa => $class,
 2335: 				};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2336: 				$schema->{input}{$property} = {
 2337: 					type => 'object',
 2338: 					isa => $class,
 2339: 					optional => 1,
 2340: 				};
 2341: 
 2342: 				$schema->{_confidence}{output} = {
 2343: 					level => 'high',
 2344: 					factors => ['POD specifies UserAgent object'],
 2345: 				};
 2346: 			}
 2347: 		}
 2348: 		# Set position 0 on whichever single input parameter already exists.
 2349: 		# The parameter may be named differently from the stored property
 2350: 		# (e.g. $dir for the logdir property), so find the existing key
 2351: 		# rather than creating a new entry keyed by $property — doing the
 2352: 		# latter produces a duplicate-position collision between the real
 2353: 		# param and the spurious $property key.
 2354: 		if(ref($schema->{input}) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2355: 			my @input_keys = keys %{$schema->{input}};
 2356: 			if(scalar @input_keys > 1) {
 2357: 				croak(__PACKAGE__, ': A getset accessor function can have at most one argument');
 2358: 			} elsif(@input_keys == 1) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2359: 				$schema->{input}{$input_keys[0]}{position} = 0;
 2360: 			} else {
 2361: 				$schema->{input}{$property}{position} = 0;
 2362: 			}
 2363: 		}
 2364: 	} elsif ($code =~ /return\s+\$self\s*->\s*\{\s*['"]?([^}'"]+)['"]?\s*\}\s*;/) {
 2365: 		# -------------------------------
 2366: 		# Getter
 2367: 		# -------------------------------
 2368: 		my $property = $1;
 2369: 
 2370: 		# Don't flag mutators like
 2371: 		# sub foo {
 2372: 		    # my $self = shift;
 2373: 		    # $self->{bar} = shift;
 2374: 		    # return $self->{bar};
 2375: 		# }
 2376: 		# Only exclude if the property is being set FROM EXTERNAL INPUT
 2377: 		if($code !~ /\$self\s*->\s*\{\s*['"]?\Q$property\E['"]?\s*\}\s*=\s*(?:shift|\$\w+\s*=\s*shift|\@_|\$_\[\d+\])/) {
 2378: 			my @returns = $code =~ /return\b/g;
 2379: 			my @self_returns = $code =~ /return\s+\$self\s*->\s*\{\s*['"]?\Q$property\E['"]?\s*\}/g;
 2380: 			# it's a getter
 2381: 			if (scalar(@returns) == scalar(@self_returns)) {
 2382: 				# all returns are returning $self->{$property}, so it's a getter
 2383: 				$schema->{accessor} = {
 2384: 					type => 'getter',
 2385: 					property => $property,
 2386: 				};
 2387: 
 2388: 				$self->_log("  Detected getter accessor for property: $property");
 2389: 
 2390: 				$schema->{_confidence}{output} = {
 2391: 					level => 'high',
 2392: 					factors => ['Detected getter method'],
 2393: 				};
 2394: 				delete $schema->{input};
 2395: 			}
 2396: 		}
 2397: 	} elsif (
 2398: 		$code =~ /return\s+\$self\b/ &&
 2399: 		$code =~ /\$self\s*->\s*\{\s*['"]?([^}'"]+)['"]?\s*\}\s*=\s*\$(\w+)\s*;/
 2400: 	) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2401: 		# -------------------------------
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2402: 		# Setter
 2403: 		# -------------------------------
 2404: 		my ($property, $param) = ($1, $2);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2405: 
 2406: 		$schema->{accessor} = {
 2407: 			type => 'setter',

					

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

				
NUM_BOUNDARY_2407_45_==: Numeric boundary flip != to ==
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 2408: 			property => $property,
 2409: 			param => $param,
 2410: 		};
 2411: 
 2412: 		$self->_log("  Detected setter accessor for property: $property");
 2413: 
 2414: 		$schema->{input} = {
 2415: 			$param => { type => 'string' }, # safe default
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2416: 		};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2417: 		$schema->{input_style} = 'hash';
 2418: 
 2419: 		$schema->{_confidence}{input} = {
 2420: 			level => 'high',
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2421: 			factors => ['Detected setter/accessor method'],
 2422: 		};
 2423: 		if($schema->{output}{_returns_self}) {
 2424: 			if($schema->{output}{type} ne 'object') {
 2425: 				croak 'Setter can not return data other than $self';
 2426: 			}
 2427: 			if($schema->{output}{isa} ne $self->{_package_name}) {
 2428: 				croak 'Setter can not return data other than $self';
 2429: 			}
 2430: 		} elsif(scalar(keys %{$schema->{output}}) != 0) {
 2431: 			$self->_analysis_error(
 2432: 				method  => $method->{name},
 2433: 				message => "Setter cannot return data",
 2434: 			);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2435: 		}
 2436: 	}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2437: 
●2438 → 2438 → 0 2438: 	if(exists($schema->{accessor})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2439: 		if($schema->{accessor}{type} && $schema->{accessor}{type} =~ /setter|getset/ && $schema->{input}) {
 2440: 			for my $param (keys %{ $schema->{input} }) {
 2441: 				my $in = $schema->{input}{$param};
 2442: 
 2443: 				if ($in->{type} && ($in->{type} eq 'object')) {
 2444: 					$schema->{output} = {
 2445: 						type => 'object',
 2446: 						($in->{isa} ? (isa => $in->{isa}) : ()),
 2447: 					};
 2448: 
 2449: 					$schema->{_confidence}{output} = {
 2450: 						level => 'high',
 2451: 						factors => ['Output type propagated from setter input'],
 2452: 					};
 2453: 				}
 2454: 			}
 2455: 		}
 2456: 
 2457: 		if($schema->{accessor}{type} && $schema->{accessor}{property} && ($schema->{accessor}{type} =~ /getter|getset/) &&
 2458: 		   ((!defined($schema->{output}{type})) || ($schema->{output}{type} eq 'string'))) {
 2459: 			if (my $pod = $method->{pod}) {
 2460: 				# POD says "UserAgent object"
 2461: 				if ($pod =~ /\bUser[- ]?Agent\b.*\bobject\b/i) {
 2462: 					$schema->{output}{type} = 'object';
 2463: 					$schema->{output}{isa} = 'LWP::UserAgent';
 2464: 
 2465: 					push @{ $schema->{_confidence}{output}{factors} }, 'POD indicates UserAgent object';
 2466: 
 2467: 					$schema->{_confidence}{output}{level} = 'high';
 2468: 				}
 2469: 			}
 2470: 		}
 2471: 	}
 2472: }
 2473: 
 2474: # --------------------------------------------------
 2475: # _analysis_error
 2476: #
 2477: # Purpose:    Report a fatal analysis error with
 2478: #             module, method, and file context,
 2479: #             then croak.
 2480: #
 2481: # Entry:      Named args:
 2482: #               method  - method name string.
 2483: #               message - error description string.
 2484: #
 2485: # Exit:       Does not return — always croaks.
 2486: #
 2487: # Side effects: None beyond the croak.
 2488: # --------------------------------------------------
 2489: sub _analysis_error {
 2490: 	my ($self, %args) = @_;
 2491: 
 2492: 	my $method = $args{method} // 'UNKNOWN';
 2493: 	my $msg = $args{message} // 'Analysis error';
 2494: 
 2495: 	my $module = $self->{_package_name} // 'UNKNOWN';
 2496: 	my $file   = $self->{input_file} // 'UNKNOWN';
 2497: 
 2498: 	croak join "\n",
 2499: 		$msg,
 2500: 		"  Module: $module",
 2501: 		"  Method: $method",
 2502: 		"  File:   $file",
 2503: 	'';
 2504: }
 2505: 
 2506: # --------------------------------------------------
 2507: # _extract_validator_schema
 2508: #
 2509: # Purpose:    Try each supported validator extractor
 2510: #             in priority order and return the first
 2511: #             schema that yields a non-empty input
 2512: #             spec. Used to detect explicit
 2513: #             parameter validation declarations
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2514: #             before falling back to heuristic
 2515: #             code analysis.
 2516: #
 2517: # Entry:      $code - method body source string.
 2518: #
 2519: # Exit:       Returns a schema hashref on success,
 2520: #             or undef if no supported validator
 2521: #             call is detected.
 2522: #
 2523: # Side effects: None.
 2524: #
 2525: # Notes:      Extractors tried in order:
 2526: #             Params::Validate::Strict,
 2527: #             Params::Validate,
 2528: #             MooseX::Params::Validate,
 2529: #             Type::Params.
 2530: # --------------------------------------------------
 2531: sub _extract_validator_schema {
●2532 → 2534 → 2539 2532: 	my ($self, $code) = @_;
 2533: 
 2534: 	for my $extractor ('_extract_pvs_schema', '_extract_pv_schema', '_extract_moosex_params_schema', '_extract_type_params_schema') {
 2535: 		my $res = $self->$extractor($code);
 2536: 		return $res if ($res && ref($res) eq 'HASH' && keys %{ $res->{input} || {} });
 2537: 	}
 2538: 
 2539: 	return;
 2540: }
 2541: 
 2542: # --------------------------------------------------
 2543: # _parse_schema_hash
 2544: #
 2545: # Purpose:    Parse a PPI block node representing
 2546: #             a validator schema hash literal and
 2547: #             return a normalised schema structure
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2548: #             suitable for use as input spec.
 2549: #
 2550: # Entry:      $hash - a PPI node with a children()
 2551: #                     method, typically a
 2552: #                     PPI::Structure::Block from
 2553: #                     a validate_strict call.
 2554: #
 2555: # Exit:       Returns a hashref with keys:

					

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

				
NUM_BOUNDARY_2555_23_>: Numeric boundary flip < to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_2555_23_<=: Numeric boundary flip < to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_2555_23_>=: Numeric boundary flip < to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 2556: #               input       - hashref of param specs

					

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

				
COND_INV_2556_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2557: #               input_style - 'hash'
 2558: #               _confidence - confidence hashref
 2559: #             or undef if parsing fails.
 2560: #
 2561: # Side effects: None.
 2562: # --------------------------------------------------
 2563: sub _parse_schema_hash {
●2564 → 2568 → 2623 2564: 	my ($self, $hash) = @_;
 2565: 
 2566: 	my %result;
 2567: 
 2568: 	for my $child ($hash->children) {
 2569: 		# skip whitespace and operators
 2570: 		if ($child->isa('PPI::Statement') || $child->isa('PPI::Statement::Expression')) {
 2571: 			my ($key, $val);
 2572: 
 2573: 			my @tokens = grep {
 2574: 				!$_->isa('PPI::Token::Whitespace') &&
 2575: 				!$_->isa('PPI::Token::Operator')
 2576: 			} $child->children;
 2577: 
 2578: 			for (my $i = 0; $i < @tokens - 1; $i++) {
 2579: 				if(($tokens[$i]->isa('PPI::Token::Word') || $tokens[$i]->isa('PPI::Token::Quote')) &&
 2580: 				   $tokens[$i+1]->isa('PPI::Structure::Constructor')) {
 2581: 					$key = $tokens[$i]->content;
 2582: 					$key =~ s/^['"]|['"]$//g;

					

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

				
COND_INV_2582_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2583: 					$val = $tokens[$i+1];
 2584: 					last;
 2585: 				}
 2586: 			}
 2587: 
 2588: 			next unless $key && $val;
 2589: 
 2590: 			my %param;
 2591: 			for my $inner ($val->children) {
 2592: 				next unless $inner->isa('PPI::Statement') || $inner->isa('PPI::Statement::Expression');
 2593: 
 2594: 				my ($k, undef, $v) = grep {
 2595: 					!$_->isa('PPI::Token::Whitespace') &&
 2596: 					!$_->isa('PPI::Token::Operator')
 2597: 				} $inner->children;
 2598: 
 2599: 				next unless $k && $v;
 2600: 
 2601: 				my $keyname = $k->content;
 2602: 				my $value = $v->can('content') ? $v->content : undef;
 2603: 				$value =~ s/^['"]|['"]$//g if defined $value;
 2604: 
 2605: 				if ($keyname eq 'type') {
 2606: 					$param{type} = lc($value);
 2607: 				} elsif ($keyname eq 'optional') {
 2608: 					$param{optional} = $value ? 1 : 0;
 2609: 				} elsif ($keyname =~ /^(min|max)$/ && looks_like_number($value)) {
 2610: 					$param{$keyname} = 0 + $value;
 2611: 				} elsif ($keyname eq 'matches') {
 2612: 					$param{matches} = qr/$value/;
 2613: 				}
 2614: 			}
 2615: 
 2616: 			$param{type} //= 'string';
 2617: 			$param{optional} //= 0;
 2618: 
 2619: 			$result{$key} = \%param;
 2620: 		}
 2621: 	}
 2622: 
 2623: 	return {
 2624: 		input => \%result,
 2625: 		input_style => 'hash',
 2626: 		_confidence => {
 2627: 			input => {
 2628: 				level => 'high',
 2629: 				factors => ['Input schema extracted from validator'],
 2630: 			},
 2631: 		},
 2632: 	};
 2633: }
 2634: 
 2635: # --------------------------------------------------
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2636: # _ppi
 2637: #
 2638: # Purpose:    Return a PPI::Document for a code
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2639: #             string, using a per-instance cache
 2640: #             to avoid re-parsing the same string
 2641: #             multiple times during a single
 2642: #             analysis pass.
 2643: #
 2644: # Entry:      $code - either a string of Perl source
 2645: #                     code, or an object that
 2646: #                     already has a find() method
 2647: #                     (returned as-is).
 2648: #
 2649: # Exit:       Returns a PPI::Document, or the
 2650: #             original object if it already
 2651: #             supports find().
 2652: #
 2653: # Side effects: Populates $self->{_ppi_cache}.
 2654: # --------------------------------------------------
 2655: sub _ppi {
 2656: 	my ($self, $code) = @_;
 2657: 
 2658: 	return $code if ref($code) && $code->can('find');
 2659: 
 2660: 	$self->{_ppi_cache} ||= {};
 2661: 	return $self->{_ppi_cache}{$code} //= PPI::Document->new(\$code);
 2662: }
 2663: 
 2664: # --------------------------------------------------
 2665: # _extract_pvs_schema
 2666: #
 2667: # Purpose:    Detect and extract a parameter schema
 2668: #             from a Params::Validate::Strict
 2669: #             validate_strict() call in the method
 2670: #             body.
 2671: #
 2672: # Entry:      $code - method body source string.
 2673: #
 2674: # Exit:       Returns a schema hashref with input,
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2675: #             style, and source keys on success,
 2676: #             or undef if no validate_strict call
 2677: #             is found or parsing fails.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2678: #
 2679: # Side effects: None.
 2680: # --------------------------------------------------
 2681: sub _extract_pvs_schema {
●2682 → 2692 → 2727 2682: 	my ($self, $code) = @_;
 2683: 
 2684: 	return unless $code =~ /\bvalidate_strict\s*\(/;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2685: 
 2686: 	my $doc = $self->_ppi($code) or return;
 2687: 
 2688: 	my $calls = $doc->find(sub {
 2689: 		$_[1]->isa('PPI::Token::Word') && ($_[1]->content eq 'validate_strict' || $_[1]->content eq 'Params::Validate::Strict::validate_strict')
 2690: 	}) or return;
 2691: 
 2692: 	for my $call (@$calls) {
 2693: 		my $list = $call->parent();
 2694: 		while ($list && !$list->isa('PPI::Structure::List')) {
 2695: 			$list = $list->parent();
 2696: 		}
 2697: 		if(!defined($list)) {
 2698: 			my $next = $call->next_sibling();
 2699: 			next unless defined $next;
 2700: 			if($next->content() =~ /schema\s*=>\s*(\{(?:[^{}]|\{(?:[^{}]|\{[^{}]*\})*\})*\})/s) {

					

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

				
BOOL_NEGATE_2700_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_2700_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 2701: 				my $schema_text = $1;
 2702: 				next if $schema_text =~ $UNSAFE_KEYWORD_RE;
 2703: 				my $compartment = Safe->new();
 2704: 				$compartment->permit_only(qw(:base_core :base_mem :base_orig));
 2705: 
 2706: 				my $schema_str = "my \$schema = $schema_text";
 2707: 				my $schema = $compartment->reval($schema_str);
 2708: 				if(scalar keys %{$schema}) {
 2709: 					return {
 2710: 						input => $schema,
 2711: 						style => 'hash',
 2712: 						source => 'validator'
 2713: 					}
 2714: 				}
 2715: 			}
 2716: 		}
 2717: 		next unless $list;
 2718: 
 2719: 		my ($schema_block) = grep { $_->isa('PPI::Structure::Block') } $list->children;
 2720: 
 2721: 		next unless $schema_block;
 2722: 
 2723: 		my $schema = $self->_extract_schema_hash_from_block($schema_block);
 2724: 		return $self->_normalize_validator_schema($schema) if $schema;
 2725: 	}
 2726: 
 2727: 	return;
 2728: }
 2729: 
 2730: # --------------------------------------------------
 2731: # _extract_pv_schema
 2732: #
 2733: # Purpose:    Detect and extract a parameter schema
 2734: #             from a Params::Validate validate()
 2735: #             call in the method body.
 2736: #
 2737: # Entry:      $code - method body source string.
 2738: #
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2739: # Exit:       Returns a schema hashref with input,
 2740: #             style, and source keys on success,
 2741: #             or undef if no validate() call is
 2742: #             found or parsing fails.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2743: #
 2744: # Side effects: None.
 2745: # --------------------------------------------------
 2746: sub _extract_pv_schema {
●2747 → 2757 → 2804 2747: 	my ($self, $code) = @_;
 2748: 
 2749: 	return unless $code =~ /\bvalidate\s*\(/;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2750: 
 2751: 	my $doc = $self->_ppi($code) or return;
 2752: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2753: 	my $calls = $doc->find(sub {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2754: 		$_[1]->isa('PPI::Token::Word') && ($_[1]->content eq 'validate' || $_[1]->content eq 'Params::Validate::validate')
 2755: 	}) or return;
 2756: 
 2757: 	for my $call (@$calls) {
 2758: 		my $list = $call->parent;
 2759: 		while ($list && !$list->isa('PPI::Structure::List')) {
 2760: 			$list = $list->parent;
 2761: 		}
 2762: 		if(!defined($list)) {
 2763: 			my $next = $call->next_sibling();
 2764: 			my ($arglist, $schema_text) = $self->_parse_pv_call($next);
 2765: 
 2766: 			if($schema_text && $schema_text !~ $UNSAFE_KEYWORD_RE) {
 2767: 				my $compartment = Safe->new();
 2768: 				$compartment->permit_only(qw(:base_core :base_mem :base_orig));
 2769: 
 2770: 				my $schema_str = "my \$schema = $schema_text";
 2771: 				my $schema = $compartment->reval($schema_str);
 2772: 
 2773: 				if(scalar keys %{$schema}) {
 2774: 					foreach my $arg(keys %{$schema}) {
 2775: 						my $field = $schema->{$arg};
 2776: 						if(my $type = $field->{'type'}) {
 2777: 							if($type eq 'ARRAYREF') {

					

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

				
BOOL_NEGATE_2777_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_2777_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 2778: 								$field->{'type'} = 'arrayref';
 2779: 							} elsif($type eq 'SCALAR') {
 2780: 								$field->{'type'} = 'string';
 2781: 							}
 2782: 						}
 2783: 						delete $field->{'callbacks'};
 2784: 					}
 2785: 
 2786: 					return {
 2787: 						input => $schema,
 2788: 						style => 'hash',
 2789: 						source => 'validator'
 2790: 					}
 2791: 				}
 2792: 			}
 2793: 		}
 2794: 		next unless $list;
 2795: 
 2796: 		my ($schema_block) = grep { $_->isa('PPI::Structure::Block') } $list->children;
 2797: 
 2798: 		next unless $schema_block;
 2799: 
 2800: 		my $schema = $self->_extract_schema_hash_from_block($schema_block);
 2801: 		return $self->_normalize_validator_schema($schema) if $schema;
 2802: 	}
 2803: 
 2804: 	return;
 2805: }
 2806: 
 2807: # --------------------------------------------------
 2808: # _parse_pv_call
 2809: #
 2810: # Purpose:    Split a Params::Validate call argument
 2811: #             string into its two components: the
 2812: #             first argument (typically \@_) and
 2813: #             the schema hash string.
 2814: #
 2815: # Entry:      $string - the raw argument string
 2816: #                       from the validate() call,
 2817: #                       including outer parentheses.
 2818: #
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2819: # Exit:       Returns a two-element list:
 2820: #               ($first_arg, $hash_str)
 2821: #             or an empty list if no comma is found
 2822: #             at brace depth zero (malformed call).
 2823: #
 2824: # Side effects: None.
 2825: # --------------------------------------------------
 2826: sub _parse_pv_call {
  Mutants (Total: 1, Killed: 1, Survived: 0)
●2827 → 2841 → 2858 2827: 	my ($self, $string) = @_;
 2828: 
 2829: 	# Remove outer parentheses and whitespace
 2830: 	$string =~ s/^\s*\(\s*//;
 2831: 	$string =~ s/\s*\)\s*$//;
 2832: 
 2833: 	# Find the first comma at brace-depth 0, jumping over each balanced
 2834: 	# {...} block in one step via extract_bracketed rather than
 2835: 	# counting depth character by character
 2836: 	require Text::Balanced;
 2837: 	my $rest = $string;
 2838: 	my $comma_pos = 0;
 2839: 	my $found_comma = 0;
 2840: 
 2841: 	while (length $rest) {
 2842: 		if (substr($rest, 0, 1) eq '{') {
 2843: 			# extract_bracketed advances $rest past the extracted block
 2844: 			# in place, so $rest must not be re-truncated afterwards
 2845: 			my $extracted = Text::Balanced::extract_bracketed($rest, '{}');
 2846: 			return unless defined $extracted;	# Broken source code
 2847: 			$comma_pos += length $extracted;
 2848: 			next;
 2849: 		}
 2850: 		if (substr($rest, 0, 1) eq ',') {
 2851: 			$found_comma = 1;
 2852: 			last;
 2853: 		}
 2854: 		$comma_pos++;
 2855: 		$rest = substr($rest, 1);
 2856: 	}
 2857: 
 2858: 	return unless $found_comma;
 2859: 
 2860: 	my $first_arg = substr($string, 0, $comma_pos);
 2861: 	my $hash_str = substr($string, $comma_pos + 1);
 2862: 
 2863: 	# Trim whitespace
 2864: 	$first_arg =~ s/^\s+|\s+$//g;
 2865: 	$hash_str =~ s/^\s+|\s+$//g;
 2866: 
 2867: 	return ($first_arg, $hash_str);
 2868: }
 2869: 
 2870: # --------------------------------------------------
 2871: # _extract_moosex_params_schema
 2872: #
 2873: # Purpose:    Detect and extract a parameter schema
 2874: #             from a MooseX::Params::Validate
 2875: #             validated_hash() call in the method
 2876: #             body.
 2877: #
 2878: # Entry:      $code - method body source string.
 2879: #
 2880: # Exit:       Returns a schema hashref with input,
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2881: #             style, and source keys on success,
 2882: #             or undef if no validated_hash() call
 2883: #             is found or parsing fails.
 2884: #
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2885: # Side effects: None.
 2886: # --------------------------------------------------
 2887: sub _extract_moosex_params_schema
 2888: {
●2889 → 2899 → 2963 2889: 	my ($self, $code) = @_;
 2890: 
 2891: 	return unless $code =~ /\bvalidated_hash\s*\(/;
 2892: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2893: 	my $doc = $self->_ppi($code) or return;
 2894: 
 2895: 	my $calls = $doc->find(sub {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2896: 		$_[1]->isa('PPI::Token::Word') && ($_[1]->content eq 'validated_hash')
 2897: 	}) or return;
 2898: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2899: 	for my $call (@$calls) {
 2900: 		my $list = $call->parent();
 2901: 		while ($list && !$list->isa('PPI::Structure::List')) {
 2902: 			$list = $list->parent;
 2903: 		}
 2904: 		if(!defined($list)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2905: 			my $next = $call->next_sibling();
 2906: 			my ($arglist, $schema_text) = $self->_parse_pv_call($next);
 2907: 
 2908: 			if($schema_text && $schema_text !~ $UNSAFE_KEYWORD_RE) {
 2909: 				my $compartment = Safe->new();
 2910: 				$compartment->permit_only(qw(:base_core :base_mem :base_orig));
 2911: 

					

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

				
COND_INV_2911_7: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2912: 				my $schema_str = "my \$schema = { $schema_text }";
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2913: 				$schema_str =~ s/ArrayRef\[(.+?)\]/arrayref, element_type => $1/g;
 2914: 				my $schema = $compartment->reval($schema_str);
 2915: 
 2916: 				if(scalar keys %{$schema}) {
 2917: 					foreach my $arg(keys %{$schema}) {
 2918: 						my $field = $schema->{$arg};
 2919: 						if(my $isa = delete $field->{'isa'}) {
 2920: 							$field->{'type'} = $isa;
 2921: 						}
 2922: 						if(exists($field->{'required'})) {
 2923: 							my $required = delete $field->{'required'};
 2924: 							$field->{'optional'} = $required ? 0 : 1;
 2925: 						} else {
 2926: 							$field->{'optional'} = 1;
 2927: 						}
 2928: 						if(ref($field->{'default'}) eq 'CODE') {
 2929: 							delete $field->{'default'};	# TODO
 2930: 						}
 2931: 					}
 2932: 
 2933: 					foreach my $arg(keys %{$schema}) {
 2934: 						my $field = $schema->{$arg};
 2935: 						if(my $type = $field->{'type'}) {
 2936: 							if($type eq 'ARRAYREF') {

					

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

				
BOOL_NEGATE_2936_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_2936_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 2937: 								$field->{'type'} = 'arrayref';
 2938: 							} elsif($type eq 'SCALAR') {
 2939: 								$field->{'type'} = 'string';
 2940: 							}
 2941: 						}
 2942: 						delete $field->{'callbacks'};
 2943: 					}
 2944: 
 2945: 					return {
 2946: 						input => $schema,
 2947: 						style => 'hash',
 2948: 						source => 'validator'
 2949: 					}
 2950: 				}
 2951: 			}
 2952: 		}
 2953: 		next unless $list;
 2954: 
 2955: 		my ($schema_block) = grep { $_->isa('PPI::Structure::Block') } $list->children;
 2956: 
 2957: 		next unless $schema_block;
 2958: 
 2959: 		my $schema = $self->_extract_schema_hash_from_block($schema_block);
 2960: 		return $self->_normalize_validator_schema($schema) if $schema;
 2961: 	}
 2962: 
 2963: 	return;
 2964: }
 2965: 
 2966: # --------------------------------------------------
 2967: # _extract_schema_hash_from_block
 2968: #
 2969: # Purpose:    Extract a parameter schema hashref from
 2970: #             a PPI::Structure::Block node representing
 2971: #             the schema argument to a validator call

					

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

				
BOOL_NEGATE_2971_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_2971_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 2972: #             such as validate_strict({ ... }).
 2973: #
 2974: # Entry:      $block - a PPI::Structure::Block node.
 2975: #
 2976: # Exit:       Returns a hashref of parameter name to
 2977: #             spec hashref, or undef if parsing fails.
 2978: #
 2979: # Side effects: None.
 2980: #
 2981: # Notes:      Delegates to _parse_schema_hash which
 2982: #             expects a PPI node with a children()
 2983: #             method. This method exists to provide
 2984: #             a clear semantic name at the call site.
 2985: # --------------------------------------------------
 2986: sub _extract_schema_hash_from_block {
 2987: 	my ($self, $block) = @_;
 2988: 
 2989: 	return unless $block && $block->can('children');
 2990: 
 2991: 	my $result = $self->_parse_schema_hash($block);
 2992: 
 2993: 	return unless $result && ref($result) eq 'HASH' && $result->{input};
 2994: 
 2995: 	return $result->{input};
 2996: }
 2997: 
 2998: # --------------------------------------------------
 2999: # _normalize_validator_schema
 3000: #
 3001: # Purpose:    Normalise a raw validator schema
 3002: #             hashref (as extracted from PPI) into
 3003: #             the standard input spec format used
 3004: #             throughout the extractor.
 3005: #
 3006: # Entry:      $schema - hashref of parameter name
 3007: #                       to raw spec hashref, as
 3008: #                       produced by
 3009: #                       _extract_schema_hash_from_block.
 3010: #
 3011: # Exit:       Returns a hashref with keys:
 3012: #               input_style - 'hash'
 3013: #               input       - normalised param specs
 3014: #             Each param spec gains an explicit
 3015: #             optional key and _source / _type_confidence
 3016: #             metadata.
 3017: #
 3018: # Side effects: None.
 3019: # --------------------------------------------------
 3020: sub _normalize_validator_schema {
●3021 → 3025 → 3036 3021: 	my ($self, $schema) = @_;
 3022: 
 3023: 	my %input;
 3024: 
 3025: 	for my $name (keys %$schema) {
 3026: 		my $spec = $schema->{$name};
 3027: 
 3028: 		$input{$name} = {
 3029: 			%$spec,
 3030: 			optional => exists $spec->{optional} ? $spec->{optional} : 0,
 3031: 			_source => 'validator',
 3032: 			_type_confidence => 'high',
 3033: 		};
 3034: 	}
 3035: 
 3036: 	return {
 3037: 		input_style => 'hash',
 3038: 		input => \%input,
 3039: 	};
 3040: }
 3041: 
 3042: # --------------------------------------------------
 3043: # _extract_type_params_schema
 3044: #
 3045: # Purpose:    Detect and extract a parameter schema
 3046: #             from a Type::Params signature_for()
 3047: #             declaration for the current method,
 3048: #             located in the module-level document.
 3049: #
 3050: # Entry:      $code - method body source string
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3051: #                     (used to extract the function
 3052: #                     name for lookup).
 3053: #
 3054: # Exit:       Returns a schema hashref on success,
 3055: #             or undef if no signature_for
 3056: #             declaration is found or compilation
 3057: #             fails.
 3058: #
 3059: # Side effects: May fork a child process to compile
 3060: #               the signature in isolation.
 3061: # --------------------------------------------------
 3062: sub _extract_type_params_schema {
 3063: 	my ($self, $code) = @_;
 3064: 
 3065: 	my $function = $self->_extract_function_name($code) or return;
 3066: 
 3067: 	my $doc = $self->{_document} or return;
 3068: 	my $stmt = $self->_find_signature_statement($doc, $function) or return;
 3069: 
 3070: 	my $signature_expr = $self->_extract_signature_expression($stmt, $function) or return;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3071: 
 3072: 	my $meta = $self->_compile_signature_isolated($function, $signature_expr) or return;
 3073: 
 3074: 	return $self->_build_schema_from_meta($meta);
 3075: }
 3076: 
 3077: # --------------------------------------------------
 3078: # _extract_function_name
 3079: #
 3080: # Purpose:    Extract the subroutine name from the
 3081: #             start of a method body string, used
 3082: #             to look up its Type::Params signature.
 3083: #
 3084: # Entry:      $code - method body source string.
 3085: #
 3086: # Exit:       Returns the subroutine name string,
 3087: #             or undef if no 'sub name' declaration
 3088: #             is found.
 3089: #
 3090: # Side effects: None.
 3091: # --------------------------------------------------
 3092: sub _extract_function_name {
 3093: 	my ($self, $code) = @_;
 3094: 	return $1 if $code =~ /^\s*sub\s+([a-zA-Z0-9_]+)/;
 3095: 	return;
 3096: }
 3097: 
 3098: # --------------------------------------------------
 3099: # _find_signature_statement
 3100: #
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3101: # Purpose:    Search a PPI document for a

					

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

				
BOOL_NEGATE_3101_4: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_3101_4: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 3102: #             signature_for statement that
 3103: #             corresponds to a named function.
 3104: #
 3105: # Entry:      $doc      - PPI::Document to search.
 3106: #             $function - function name string.
 3107: #
 3108: # Exit:       Returns the matching PPI::Statement
 3109: #             node, or undef if none is found.
 3110: #
 3111: # Side effects: None.
 3112: # --------------------------------------------------
 3113: sub _find_signature_statement {
●3114 → 3122 → 3129 3114: 	my ($self, $doc, $function) = @_;
 3115: 
 3116: 	my $statements = $doc->find(
 3117: 		sub {
 3118: 			$_[1]->isa('PPI::Statement') && $_[1]->content =~ /^\s*signature_for\b/
 3119: 		}
 3120: 	) or return;
 3121: 
 3122: 	foreach my $stmt (@$statements) {
 3123: 		my $content = $stmt->content;
 3124: 		if ($content =~ /^\s*signature_for\s+\Q$function\E\b/) {
 3125: 			return $stmt;
 3126: 		}
 3127: 	}
 3128: 
 3129: 	return;
 3130: }
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3131: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3132: # --------------------------------------------------
 3133: # _extract_signature_expression
 3134: #
 3135: # Purpose:    Extract the Type::Params signature
 3136: #             expression (everything after =>) from
 3137: #             a signature_for statement node.
 3138: #
 3139: # Entry:      $stmt     - PPI::Statement node.
 3140: #             $function - function name string,
 3141: #                         used in the match pattern.
 3142: #
 3143: # Exit:       Returns the signature expression
 3144: #             string, or undef if the pattern
 3145: #             does not match.
 3146: #
 3147: # Side effects: None.
 3148: # --------------------------------------------------
 3149: sub _extract_signature_expression {
●3150 → 3154 → 3158 3150: 	my ($self, $stmt, $function) = @_;
 3151: 
 3152: 	my $content = $stmt->content;
 3153: 
 3154: 	if ($content =~ /^\s*signature_for\s+\Q$function\E\s*=>\s*(.+?);?\s*$/s) {
 3155: 		return $1;
 3156: 	}
 3157: 
 3158: 	return;
 3159: }
 3160: 
 3161: # --------------------------------------------------
 3162: # _compile_signature_isolated
 3163: #
 3164: # Purpose:    Compile and evaluate a Type::Params
 3165: #             signature expression in an isolated
 3166: #             process to extract parameter metadata
 3167: #             without polluting the current process.
 3168: #
 3169: #             Only runs when the caller passed
 3170: #             allow_signature_exec => 1 to new().
 3171: #             Extracting parameter types from a
 3172: #             Type::Params signature_for() declaration
 3173: #             requires actually building the type
 3174: #             objects at runtime -- there is no purely
 3175: #             static way to do it -- so this is real
 3176: #             execution of an excerpt of the target
 3177: #             module's own source. Every other code
 3178: #             path in this module is static (PPI-only)
 3179: #             analysis that never runs the target's
 3180: #             code, so this one feature must be opted
 3181: #             into explicitly rather than triggered
 3182: #             implicitly by extract_all().
 3183: #
 3184: #             A Safe compartment was previously tried
 3185: #             first as a "fast path" before falling
 3186: #             back to this subprocess unconditionally.
 3187: #             It was removed: Type::Params and
 3188: #             Types::Common pull in XS modules (e.g.
 3189: #             B.pm via Type::Params), and Safe cannot
 3190: #             host XS/dynamic loading at all, so the
 3191: #             compartment never succeeded for any real
 3192: #             signature_for() declaration -- it was
 3193: #             dead code that gave a false impression of
 3194: #             sandboxing while every real call fell
 3195: #             through to the unconditional subprocess
 3196: #             below.
 3197: #
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3198: # Entry:      $function        - function name string.
 3199: #             $signature_expr  - Type::Params
 3200: #                                signature expression
 3201: #                                string.
 3202: #
 3203: # Exit:       Returns a decoded JSON hashref
 3204: #             containing parameters and returns
 3205: #             metadata on success.
 3206: #             Returns undef without running anything if
 3207: #             allow_signature_exec was not enabled.
 3208: #             Croaks on unsafe expressions, timeout,
 3209: #             or compile errors.
 3210: #
 3211: # Side effects: May fork a child process with a
 3212: #               memory limit applied via
 3213: #               BSD::Resource if available.
 3214: #               Memory limiting is best-effort and

					

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

				
COND_INV_3214_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3215: #               silently skipped on platforms where
 3216: #               BSD::Resource is unavailable.
 3217: # --------------------------------------------------
 3218: sub _compile_signature_isolated {

					

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

				
COND_INV_3218_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

●3219 → 3221 → 3230 3219: 	my ($self, $function, $signature_expr) = @_;
 3220: 
 3221: 	unless ($self->{allow_signature_exec}) {
 3222: 		carp "Skipping Type::Params signature_for($function) extraction: ",
 3223: 			'allow_signature_exec => 1 was not passed to new() ',
 3224: 			'(this would execute code from the target module)'
 3225: 			if $self->{verbose};
 3226: 		return;
 3227: 	}
 3228: 
 3229: 	# Remove comments
●3230 → 3239 → 3243 3230: 	$signature_expr =~ s/#.*$//mg;
 3231: 
 3232: 	# Reject obviously dangerous constructs. This is defense in depth
 3233: 	# only, not a real security boundary -- it is a denylist of literal
 3234: 	# tokens and cannot catch e.g. a symbolic-ref call built by string
 3235: 	# concatenation. The actual control here is the allow_signature_exec
 3236: 	# opt-in above: this code must never run against a module the caller
 3237: 	# has not already decided to trust enough to execute.
 3238: 	# Both checks unified into one croak so the message and class are consistent
 3239: 	if ($signature_expr =~ $UNSAFE_KEYWORD_RE || $signature_expr =~ $UNSAFE_CHAR_RE) {
 3240: 		croak 'Unsafe signature expression -- rejected to prevent code execution';
 3241: 	}
 3242: 
●3243 → 3347 → 3355 3243: 	my $payload = <<'PERL';
 3244: use strict;
 3245: use warnings;
 3246: use Type::Params -sigs;
 3247: use Types::Common -types;
 3248: use JSON::MaybeXS;
 3249: 
 3250: # Apply address-space limit passed from parent via env.  Done here (in the
 3251: # child) rather than in the parent so the parent's memory is never capped.
 3252: if (my $limit = $ENV{_ATG_RLIMIT_AS}) {
 3253:     eval {
 3254:         require BSD::Resource;
 3255:         BSD::Resource::setrlimit(BSD::Resource::RLIMIT_AS(), $limit, $limit);
 3256:     };
 3257: }
 3258: 
 3259: # Stub sub so Perl can parse it
 3260: sub FUNCTION_NAME {}
 3261: 
 3262: # Create the Type::Params signature object
 3263: my $sig = signature_for FUNCTION_NAME => SIGNATURE_EXPR;
 3264: 
 3265: # Extract parameters — guard against older Type::Params (< 2.x) where
 3266: # signature_for() installs the constraint but returns undef rather than
 3267: # the signature object, so ->parameters() would die.
 3268: my @sig_params = (defined $sig && ref $sig && $sig->can('parameters'))
 3269: 	? @{ $sig->parameters || [] }
 3270: 	: ();
 3271: my $pos = 0;
 3272: my @params;
 3273: 
 3274: # if ($sig->method) {
 3275:     # The $self value
 3276:     # push @params, {
 3277:         # name     => 'arg0',
 3278:         # optional => 0,
 3279:         # position => $pos++,
 3280:     # };
 3281: # }
 3282: 
 3283: for my $p (@sig_params) {
 3284: 	my $name = ($p->can('name') && defined($p->name) && length($p->name))
 3285: 		? $p->name
 3286: 		: "arg$pos";
 3287: 	push @params, {
 3288: 		name => $name,
 3289: 		optional => $p->optional ? 1 : 0,
 3290: 		position => $pos,
 3291: 		type => $p->type->name
 3292: 	};
 3293: 	$pos++;
 3294: }
 3295: 
 3296: # Extract return type
 3297: my $returns;
 3298: if (my $r = $sig->returns_scalar) {
 3299: 	$returns = {
 3300: 		context => 'scalar',
 3301: 		type => $r ? $r->name : 'unknown',
 3302: 	};
 3303: } elsif ($r = $sig->returns_list) {
 3304: 	$returns = {
 3305: 		context => 'list',
 3306: 		type => $r ? $r->name : 'unknown',
 3307: 	};
 3308: }
 3309: 
 3310: print encode_json({
 3311: 	parameters => \@params,
 3312: 	returns => $returns,
 3313: });
 3314: PERL
 3315: 
 3316: 	# Substitute function name and signature expression
 3317: 	$payload =~ s/FUNCTION_NAME/$function/g;
 3318: 	$payload =~ s/SIGNATURE_EXPR/$signature_expr/;
 3319: 

					

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

				
COND_INV_3319_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3320: 	# Run in an isolated Perl process
 3321: 	my ($wtr, $rdr, $err) = (undef, undef, gensym);
 3322: 	local %ENV;
 3323: 
 3324: 	# Pass the memory limit to the child via env so the child can apply

					

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

				
BOOL_NEGATE_3324_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_3324_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 3325: 	# setrlimit on itself after exec.  Must NOT call setrlimit here in the
 3326: 	# parent: setrlimit(RLIMIT_AS) constrains the parent's own address
 3327: 	# space, and when the parent later tries to allocate memory for test
 3328: 	# framework teardown it would OOM and crash inside the Test::Builder
 3329: 	# subtest context, producing a "context destroyed" error.
 3330: 	$ENV{_ATG_RLIMIT_AS} = $MEMORY_LIMIT_BYTES;
 3331: 
 3332: 	my $pid = open3($wtr, $rdr, $err, $^X, '-T');
 3333: 
 3334: 	print $wtr $payload;
 3335: 	close $wtr;
 3336: 
 3337: 	local $SIG{ALRM} = sub { croak 'Signature compile timeout' };
 3338: 	eval { alarm($SIGNATURE_TIMEOUT_SECS) };	# no-op on Windows
 3339: 
 3340: 	my $stdout = do { local $/; <$rdr> };
 3341: 	my $stderr = do { local $/; <$err> };
 3342: 
 3343: 	eval { alarm 0 };
 3344: 
 3345: 	waitpid($pid, 0);
 3346: 
 3347: 	if ($stderr && length $stderr) {
 3348: 		carp "Error compiling signature:\n$stderr" if $self->{verbose};
 3349: 		return;
 3350: 	}
 3351: 
 3352: 	# Child may be killed by the kernel OOM killer (SIGKILL) before it can
 3353: 	# write anything to stdout or stderr.  Guard both cases so we degrade
 3354: 	# gracefully rather than croaking with "malformed JSON".
●3355 → 3355 → 3360 3355: 	if (!defined($stdout) || !length($stdout)) {
 3356: 		carp 'Signature subprocess produced no output' if $self->{verbose};
 3357: 		return;
 3358: 	}
 3359: 
●3360 → 3361 → 3365 3360: 	my $result = eval { decode_json($stdout) };
 3361: 	if ($@) {
 3362: 		carp "Error decoding signature output: $@" if $self->{verbose};
 3363: 		return;
 3364: 	}
 3365: 	return $result;
 3366: }
 3367: 
 3368: # --------------------------------------------------
 3369: # _build_schema_from_meta
 3370: #
 3371: # Purpose:    Convert the parameter and return type
 3372: #             metadata produced by

					

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

				
COND_INV_3372_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3373: #             _compile_signature_isolated into a
 3374: #             standard schema hashref.
 3375: #
 3376: # Entry:      $meta - hashref with 'parameters'
 3377: #                     arrayref and optional
 3378: #                     'returns' hashref, as decoded
 3379: #                     from the isolated compile
 3380: #                     JSON output.
 3381: #
 3382: # Exit:       Returns a schema hashref with input,
 3383: #             output, style, source, _notes, and
 3384: #             _confidence keys.
 3385: #
 3386: # Side effects: None.
 3387: #
 3388: # Notes:      Unknown Type::Params type names are
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3389: #             mapped to 'string' with a note added
 3390: #             and confidence downgraded to 'medium'.
 3391: # --------------------------------------------------

					

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

				
COND_INV_3391_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3392: sub _build_schema_from_meta {
●3393 → 3410 → 3427 3393: 	my ($self, $meta) = @_;
 3394: 
 3395: 	my %type_map = (
 3396: 		Num => 'number',
 3397: 		Int => 'integer',
 3398: 		Str => 'string',
 3399: 		Bool => 'boolean',
 3400: 		Object  => 'object',
 3401: 		ArrayRef => 'array',
 3402: 		HashRef  => 'object',
 3403: 	);
 3404: 
 3405: 	my $input;
 3406: 	my $position = 0;
 3407: 	my $confidence = 'high';
 3408: 	my @notes = ('Type::Params detected');
 3409: 
 3410: 	foreach my $p (@{ $meta->{parameters} || [] }) {
 3411: 		my $type = $type_map{ $p->{type} } // 'string';
 3412: 
 3413: 		if (!exists $type_map{$p->{type}}) {
 3414: 			push @notes, "Unknown type $p->{type}, defaulting to string";
 3415: 			$confidence = 'medium';
 3416: 		}
 3417: 
 3418: 		$input->{"arg$position"} = {
 3419: 			type => $type,
 3420: 			position => $position,
 3421: 			optional => $p->{optional} ? 1 : 0,
 3422: 		};
 3423: 
 3424: 		$position++;
 3425: 	}
 3426: 
●3427 → 3429 → 3443 3427: 	my $output;
 3428: 
 3429: 	if (my $ret = $meta->{returns}) {
 3430: 		my $type = $type_map{ $ret->{type} } // 'string';
 3431: 
 3432: 		if (!exists $type_map{$ret->{type}}) {
 3433: 			push @notes, "Unknown return type $ret->{type}, defaulting to string";
 3434: 			$confidence = 'medium';
 3435: 		}
 3436: 
 3437: 		$output = {
 3438: 			type => $type,
 3439: 			"_$ret->{context}_context" => { type => $type },
 3440: 		};
 3441: 	}
 3442: 
 3443: 	return {
 3444: 		input  => $input,
 3445: 		output => $output,
 3446: 		style  => 'hash',
 3447: 		source => 'validator',
 3448: 		_notes => \@notes,
 3449: 		_confidence => {
 3450: 			input => $confidence,
 3451: 		},
 3452: 	};
 3453: }
 3454: 
 3455: # --------------------------------------------------
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3456: # _analyze_pod
 3457: #
 3458: # Purpose:    Parse POD documentation for a method
 3459: #             and extract parameter names, types,
 3460: #             constraints, and optionality from
 3461: #             multiple POD patterns.
 3462: #
 3463: # Entry:      $pod - string of POD content as
 3464: #                    returned by _extract_pod_before.
 3465: #                    May be undef or empty.
 3466: #
 3467: # Exit:       Returns a hashref of parameter name
 3468: #             to parameter spec hashref. Returns an
 3469: #             empty hashref if no POD is provided
 3470: #             or no parameters are found.
 3471: #
 3472: # Side effects: Carps when a semantic type is
 3473: #               detected, advising the caller to
 3474: #               set config->properties.
 3475: #               Logs progress to stdout when
 3476: #               verbose is set.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3477: #
 3478: # Notes:      Three pattern strategies are tried
 3479: #             in order: (1) named Parameters section,
 3480: #             (2) inline $name - type format,
 3481: #             (3) =over/=item list. Parameters found
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3482: #             earlier take precedence over later
 3483: #             discoveries. Default values from POD
 3484: #             are merged in last.
 3485: # --------------------------------------------------
 3486: sub _analyze_pod {
●3487 → 3496 → 3512 3487: 	my ($self, $pod) = @_;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3488: 
 3489: 	return {} unless $pod;
 3490: 
 3491: 	my %params;
 3492: 	my $position_counter = 0;
 3493: 
 3494: 	# Check for positional arguments in method signature
 3495: 	# Pattern: =head2 method_name($arg1, $arg2, $arg3)
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3496: 	if ($pod =~ /=head2\s+\w+\s*\(([^)]+)\)/s) {
 3497: 		my $sig = $1;
 3498: 		# Extract parameter names in order
 3499: 		my @sig_params = $sig =~ /\$(\w+)/g;
 3500: 
 3501: 		# Skip $self or $class
 3502: 		shift @sig_params if @sig_params && $sig_params[0] =~ /^(self|class)$/i;
 3503: 
 3504: 		# Assign positions
 3505: 		foreach my $param (@sig_params) {
 3506: 			$params{$param}{position} //= $position_counter;
 3507: 			$self->_log("  POD: $param has position $params{$param}{position}");
 3508: 			$position_counter++;

					

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

				
COND_INV_3508_5: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

 3509: 		}
 3510: 	}
 3511: 
●3512 → 3517 → 3522 3512: 	$self->_log("  POD: Found $position_counter unnamed parameters to add to the position list");
 3513: 
 3514: 	# Pattern 1: Parse line-by-line in Parameters section
 3515: 	# First, extract the Parameters section
 3516: 	my $param_section;
 3517: 	if($pod =~ /(?:Parameters?|Arguments?|Inputs?):?\s*\n((?:\s*\$.*\n)+)/si) {
 3518: 		$param_section = $1;
 3519: 	} elsif ($pod =~ /^=head\d+\s+(?:Parameters?|Arguments?|Inputs?)\b.*?\n(.*?)(?=^=head|\Z)/msi) {
 3520: 		$param_section = $1;
 3521: 	}
●3522 → 3522 → 3599 3522: 	if($param_section) {
 3523: 		my $param_order = 0;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3524: 
 3525: 		$self->_log("  POD: Scan for named parameters in '$param_section'");
 3526: 		# Now parse each line that starts with $varname
 3527: 		foreach my $line (split /\n/, $param_section) {
 3528: 			if ($line =~ /C<\$(\w+)>\s*\((Required|Mandatory)\)/i) {
 3529: 				$params{$1}{optional} = 0;
 3530: 				$self->_log("  POD: $1 marked required from item header");
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3531: 			}
 3532: 
 3533: 			# Match: $name - type (constraints), description
 3534: 			# or:	$name - type, description
 3535: 			# or:	$name - type
 3536: 			if(($line =~ /^\s*\$(\w+)\s*-\s*(\w+)(?:\s*\(([^)]+)\))?\s*,?\s*(.*)$/i) ||
 3537: 			   ($line =~ /^\s*C<\$(\w+)>\s*-\s*(\w+)(?:\s*\(([^)]+)\))?\s*,?\s*(.*)$/i)) {
 3538: 				my ($name, $type, $constraint, $desc) = ($1, lc($2), $3, $4);
 3539: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3540: 				# Clean up
 3541: 				$desc =~ s/^\s+|\s+$//g if $desc;
 3542: 
 3543: 				# Skip common non-parameters
 3544: 				next if $name =~ /^(self|class|return|returns?)$/i;
 3545: 
 3546: 				$params{$name} ||= { _source => 'pod' };
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3547: 
 3548: 				# If we haven't already assigned a position from the signature, use order in Parameters section
 3549: 				unless (exists $params{$name}{position}) {
 3550: 					$params{$name}{position} = $param_order++;
 3551: 					$self->_log("  POD: $name has position $params{$name}{position} (from Parameters order)");
 3552: 				}
 3553: 
 3554: 				# Normalize type names
 3555: 				$type = 'integer' if $type eq 'int';
 3556: 				$type = 'number' if $type eq 'num' || $type eq 'float';
 3557: 				$type = 'boolean' if $type eq 'bool';
 3558: 				$type = 'arrayref' if $type eq 'array';
 3559: 				$type = 'hashref' if $type eq 'hash';
 3560: 
 3561: 				$params{$name}{type} = $type;
 3562: 
 3563: 				# Parse constraints
 3564: 				if($constraint) {
 3565: 					$self->_parse_constraints($params{$name}, $constraint);
 3566: 				}
 3567: 
 3568: 				# Check for optional/required in description OR constraint.
 3569: 				# Use word boundaries to avoid matching "optionally" as "optional".
 3570: 				my $full_text = ($constraint || '') . ' ' . ($desc || '');
 3571: 				if ($full_text =~ /\boptional\b/i) {
 3572: 					$params{$name}{optional} = 1;
 3573: 					$self->_log("  POD: $name marked as optional");
 3574: 				} elsif ($full_text =~ /required|mandatory/i) {
 3575: 					$params{$name}{optional} = 0;
 3576: 					$self->_log("  POD: $name marked as required");
 3577: 				}
 3578: 
 3579: 				# Detect semantic types:
 3580: 				if ($desc =~ /\b(email|url|uri|path|filename)\b/i) {
 3581: 					# TODO: ensure properties is set to 1 in $config
 3582: 					carp('Manually set config->properties to 1 in ', $self->{'input_file'});

					

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

				
COND_INV_3582_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3583: 					$params{$name}{semantic} = lc($1);
 3584: 				}
 3585: 
 3586: 				# Look for regex patterns
 3587: 				if ($desc && $desc =~ m{matches?\s+(/[^/]+/|qr/.+?/)}i) {
 3588: 					$params{$name}{matches} = $1;

					

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

				
COND_INV_3588_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3589: 				}

					

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

				
COND_INV_3589_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3590: 
 3591: 				$self->_log("  POD: Found parameter '$name' in parameters section, type=$type" .
 3592: 						($constraint ? " ($constraint)" : '') .
 3593: 						($desc ? " - $desc" : ''));
 3594: 			}
 3595: 		}
 3596: 	}

					

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

				
COND_INV_3596_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3597: 
 3598: 	# Pattern 2: Also try the inline format in case Parameters: section wasn't found
●3599 → 3599 → 3647 3599: 	while ($pod =~ /\$(\w+)\s*-\s*(string|integer|int|number|num|float|boolean|bool|arrayref|array|hashref|hash|object|any)(?:\s*\(([^)]+)\))?\s*,?\s*(.*)$/gim) {
 3600: 		my ($name, $type, $constraint, $desc) = ($1, lc($2), $3, $4);
 3601: 
 3602: 		# Only process if we haven't already found this param in the Parameters section
 3603: 		next if exists $params{$name};
 3604: 
 3605: 		# Clean up description - remove leading/trailing whitespace
 3606: 		$desc =~ s/^\s+|\s+$//g if $desc;
 3607: 
 3608: 		# Skip common words that aren't parameters
 3609: 		next if $name =~ /^(self|class|return|returns?)$/i;
 3610: 
 3611: 		$params{$name} ||= { _source => 'pod' };
 3612: 
 3613: 		# Normalize type names
 3614: 		$type = 'integer' if $type eq 'int';
 3615: 		$type = 'number' if $type eq 'num' || $type eq 'float';
 3616: 		$type = 'boolean' if $type eq 'bool';
 3617: 		$type = 'arrayref' if $type eq 'array';
 3618: 		$type = 'hashref' if $type eq 'hash';
 3619: 
 3620: 		$params{$name}{type} = $type;
 3621: 
 3622: 		# Parse constraints
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3623: 		if ($constraint) {
 3624: 			$self->_parse_constraints($params{$name}, $constraint);
 3625: 		}
 3626: 
 3627: 		# Check for optional/required in description.
 3628: 		# Use word boundaries to avoid matching "optionally" as "optional".
 3629: 		if ($desc) {
 3630: 			if ($desc =~ /\boptional\b/i) {
 3631: 				$params{$name}{optional} = 1;
 3632: 			} elsif ($desc =~ /required|mandatory/i) {
 3633: 				$params{$name}{optional} = 0;
 3634: 			}
 3635: 

					

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

				
COND_INV_3635_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3636: 			# Look for regex patterns in description
 3637: 			if ($desc =~ m{matches?\s+(/[^/]+/|qr/.+?/)}i) {
 3638: 				$params{$name}{matches} = $1;
 3639: 			}
 3640: 		}
 3641: 
 3642: 		$self->_log("  POD: Found parameter '$name' in the inline documentation, type=$type" .

					

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

				
COND_INV_3642_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3643: 					($constraint ? " ($constraint)" : ''));
 3644: 	}
 3645: 
 3646: 	# Pattern 3: Parse =over /=item list (supports bullets and C<>)
●3647 → 3647 → 3711 3647: 	while ($pod =~ /=item\s+(?:\*\s*)?(?:C<)?\$(\w+)\b(?:>)?\s*(?:-.*)?\n?(.*?)(?==item|\=back|\=head)/sig) {
 3648: 		my $name = $1;
 3649: 		my $desc = $2;
 3650: 
 3651: 		# Never allow empty or undefined parameter names
 3652: 		next unless defined $name && length $name;
 3653: 
 3654: 		$desc =~ s/^\s+|\s+$//g;
 3655: 

					

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

				
COND_INV_3655_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3656: 		# Skip common non-parameters
 3657: 		next if $name =~ /^(self|class|return|returns?)$/i;
 3658: 
 3659: 		$params{$name} ||= { _source => 'pod' };
 3660: 
 3661: 		# Explicit typed form only:
 3662: 		#	$param - type (constraints)

					

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

				
COND_INV_3662_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3663: 		if ($desc =~ /^\s*(string|integer|int|number|num|float|boolean|bool|array|arrayref|hash|hashref|any)\b(?:\s*\(([^)]+)\))?/i) {
 3664: 			my $type = lc($1);
 3665: 			my $constraint = $2;
 3666: 
 3667: 			# Normalize type names
 3668: 			$type = 'integer' if $type eq 'int';
 3669: 			$type = 'number' if $type eq 'num' || $type eq 'float';
 3670: 			$type = 'boolean' if $type eq 'bool';
 3671: 			$type = 'arrayref' if $type eq 'array';
 3672: 			$type = 'hashref' if $type eq 'hash';

					

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

				
COND_INV_3672_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3673: 
 3674: 			$params{$name}{type} = $type;
 3675: 
 3676: 			if ($constraint) {
 3677: 				$self->_parse_constraints($params{$name}, $constraint);
 3678: 			}
 3679: 
 3680: 			$self->_log("  POD: Explicit type '$type' for $name");
 3681: 		} else {
 3682: 			# Heuristic inference from description text
 3683: 			if ($desc =~ /\bstring\b/i) {
 3684: 				$params{$name}{type} = 'string';
 3685: 			} elsif ($desc =~ /\b(int|integer)\b/i) {
 3686: 				$params{$name}{type} = 'integer';
 3687: 			} elsif ($desc =~ /\b(num|number|float)\b/i) {
 3688: 				$params{$name}{type} = 'number';
 3689: 			} elsif ($desc =~ /\b(bool|boolean)\b/i) {
 3690: 				$params{$name}{type} = 'boolean';
 3691: 			}
 3692: 		}
 3693: 
 3694: 		# Check for optional/required in description.
 3695: 		# Use word boundaries to avoid matching "optionally" as "optional".
 3696: 		if ($desc =~ /\boptional\b/i) {
 3697: 			$params{$name}{optional} = 1;
 3698: 		} elsif ($desc =~ /required|mandatory/i) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3699: 			$params{$name}{optional} = 0;
 3700: 		}
 3701: 
 3702: 		# Look for regex patterns
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3703: 		if ($desc =~ m{matches?\s+(/[^/]+/|qr/.+?/)}i) {
 3704: 			$params{$name}{matches} = $1;
 3705: 		}
 3706: 
 3707: 		$self->_log("  POD: Found parameter '$name' from =item list");
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3708: 	}
 3709: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3710: 	# Extract default values from POD
●3711 → 3712 → 3724 3711: 	my $pod_defaults = $self->_extract_defaults_from_pod($pod);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3712: 	foreach my $param (keys %$pod_defaults) {
 3713: 		if (exists $params{$param}) {
 3714: 			$params{$param}{_default} = $pod_defaults->{$param};
 3715: 			$params{$param}{optional} = 1 unless defined $params{$param}{optional};

					

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

				
COND_INV_3715_6: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3716: 			$self->_log(sprintf("  POD: %s has default value: %s",
 3717: 				$param,
 3718: 				defined($pod_defaults->{$param}) ? $pod_defaults->{$param} : 'undef'
 3719: 			));
 3720: 		}
 3721: 	}
 3722: 
 3723: 	# Default undocumented optionality: documented params are REQUIRED unless stated otherwise
●3724 → 3724 → 3739 3724: 	for my $name (keys %params) {
 3725: 		next if $name =~ /^(self|class)$/i;
 3726: 
 3727: 		# TODO: if optionality was never explicitly set, assume required.
 3728: 		# Currently disabled as it breaks some schemas — revisit in a future pass.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3729: 		# if (!exists $params{$name}{optional}) {
 3730: 			# $params{$name}{optional} = 0;
 3731: 			# $self->_log("  POD: $name assumed required (no optional/default specified)");
 3732: 		# }
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3733: 	}
 3734: 
 3735: 	# Pattern 0: =head3|4 Input formal spec — highest-priority type source.

					

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

				
COND_INV_3735_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3736: 	# Runs last so positional matching can use positions set by earlier patterns.
 3737: 	# Accepts positional array format: [ {type=>'...'}, ... ]
 3738: 	# and named hash format:           { name => {type=>'...'}, ... }
●3739 → 3739 → 3801 3739: 	if ($pod =~ /=head[34]\s+Input\b(.*?)(?==head|\z)/si) {
 3740: 		my $block = $1;
 3741: 		$block =~ s/\A\s+//;
 3742: 
 3743: 		if ($block =~ /\A\[/) {

					

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

				
COND_INV_3743_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3744: 			# Positional format: each {…} maps to the param at that array index.
 3745: 			my $idx = 0;
 3746: 			while ($block =~ /\{([^}]*)\}/g) {

					

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

				
COND_INV_3746_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3747: 				my $spec = $1;
 3748: 				my ($name) = grep { ($params{$_}{position} // -1) == $idx }
 3749: 				             keys %params;

					

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

				
COND_INV_3749_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3750: 				if (defined $name) {
 3751: 					$params{$name}{_from_input_spec} = 1;
 3752: 					if (my $t = $self->_map_formal_input_type($spec)) {
 3753: 						$params{$name}{type} = $t;
 3754: 						$self->_log("  POD: $name type '$t' from =head Input (positional $idx)");
 3755: 					}
 3756: 					if ($spec =~ /\boptional\s*=>\s*(0|1)/i) {
 3757: 						$params{$name}{optional} = $1 + 0;
 3758: 					}
 3759: 				}
 3760: 				$idx++;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3761: 			}
 3762: 		} elsif ($block =~ /\A\{/) {
 3763: 			# Named format: each 'name => {…}' entry maps directly by name.
 3764: 			while ($block =~ /\b(\w+)\s*=>\s*\{([^}]*)\}/g) {
 3765: 				my ($name, $spec) = ($1, $2);
 3766: 				next if $name =~ /^(self|class)$/i;
 3767: 				$params{$name} //= { _source => 'pod' };
 3768: 				$params{$name}{_from_input_spec} = 1;
 3769: 				if (my $t = $self->_map_formal_input_type($spec)) {
 3770: 					$params{$name}{type} = $t;
 3771: 					$self->_log("  POD: $name type '$t' from =head Input (named)");
 3772: 				}
 3773: 				if ($spec =~ /\boptional\s*=>\s*(0|1)/i) {
 3774: 					$params{$name}{optional} = $1 + 0;
 3775: 				}
 3776: 				if ($spec =~ /\bmemberof\s*=>\s*\[([^\]]*)\]/i) {
 3777: 					my $list_str = $1;
 3778: 					my @vals;
 3779: 					while ($list_str =~ /['"]([^'"]*)['"]/g) {
 3780: 						push @vals, $1;
 3781: 					}
 3782: 					$params{$name}{memberof} = \@vals if @vals;
 3783: 				}
 3784: 				if ($spec =~ /\bmin\s*=>\s*(\d+)/i) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3785: 					$params{$name}{min} = $1 + 0;
 3786: 				}
 3787: 				if ($spec =~ /\bmax\s*=>\s*(\d+)/i) {
 3788: 					$params{$name}{max} = $1 + 0;
 3789: 				}
 3790: 				if ($spec =~ /\bisa\s*=>\s*['"]([^'"]+)['"]/i) {
 3791: 					$params{$name}{isa} = $1;
 3792: 				}
 3793: 			}
 3794: 			# A named-format Input spec signals a hash/named API.  Positional
 3795: 			# info from signature analysis is not meaningful here and causes
 3796: 			# "param X missing position" errors when params are mixed.
 3797: 			delete $params{$_}{position} for keys %params;
 3798: 		}
 3799: 	}
 3800: 
 3801: 	return \%params;
 3802: }
 3803: 
 3804: # --------------------------------------------------
 3805: # _map_formal_input_type
 3806: #
 3807: # Purpose:    Extract and normalise the type string
 3808: #             from a parameter spec fragment such as
 3809: #             "type => 'scalar | scalarref'".
 3810: #             Handles union types by returning the
 3811: #             canonical ATG type for the first
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3812: #             recognised alternative.
 3813: #
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3814: # Entry:      $spec - text content of a { } block
 3815: #                     from a =head3|4 Input spec.
 3816: #
 3817: # Exit:       Canonical type string, or undef when
 3818: #             no 'type' key is present or the value
 3819: #             is not a recognised type name.
 3820: # --------------------------------------------------
 3821: sub _map_formal_input_type {
●3822 → 3851 → 3854 3822: 	my ($self, $spec) = @_;
 3823: 	# Accept both quoted  type => 'scalar'  and unquoted Params::Validate
 3824: 	# constants  type => OBJECT  (no quotes around the constant name).
 3825: 	return undef unless $spec =~ /\btype\s*=>\s*(?:['"]([^'"]+)['"]|([A-Z_]+))/i;
 3826: 	my $raw = lc(defined($1) ? $1 : $2);
 3827: 	$raw =~ s/\s+//g;
 3828: 
 3829: 	my %map = (
 3830: 		scalar    => 'string',
 3831: 		scalarref => 'string',
 3832: 		str       => 'string',
 3833: 		string    => 'string',
 3834: 		int       => 'integer',
 3835: 		integer   => 'integer',
 3836: 		num       => 'number',
 3837: 		number    => 'number',
 3838: 		float     => 'number',
 3839: 		bool      => 'boolean',
 3840: 		boolean   => 'boolean',
 3841: 		array     => 'arrayref',
 3842: 		arrayref  => 'arrayref',
 3843: 		hash      => 'hashref',
 3844: 		hashref   => 'hashref',
 3845: 		object    => 'object',
 3846: 		any       => 'any',
 3847: 		undef     => 'undef',
 3848: 		coderef   => 'coderef',
 3849: 	);
 3850: 
 3851: 	for my $t (split /\|/, $raw) {
 3852: 		return $map{$t} if exists $map{$t};
 3853: 	}
 3854: 	return undef;
 3855: }
 3856: 
 3857: # --------------------------------------------------
 3858: # _analyze_output
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3859: #
 3860: # Purpose:    Orchestrate analysis of a method's
 3861: #             return value by combining POD return
 3862: #             section parsing, code return statement
 3863: #             analysis, boolean detection, context
 3864: #             detection, void detection, chaining
 3865: #             detection, and error convention
 3866: #             detection.
 3867: #
 3868: # Entry:      $pod         - POD string for the method.
 3869: #             $code        - method body source string.
 3870: #             $method_name - name of the method being
 3871: #                            analysed, used for
 3872: #                            boolean heuristics.
 3873: #
 3874: # Exit:       Returns a hashref describing the
 3875: #             output type and behaviour, or an empty
 3876: #             hashref if nothing could be determined.
 3877: #             Keys include: type, value, isa, and
 3878: #             various _* metadata keys.
 3879: #
 3880: # Side effects: Logs progress to stdout when
 3881: #               verbose is set.
 3882: # --------------------------------------------------
 3883: sub _analyze_output {
 3884: 	my ($self, $pod, $code, $method_name) = @_;
 3885: 
 3886: 	my %output;
 3887: 
 3888: 	$self->_analyze_output_from_pod(\%output, $pod);
 3889: 	$self->_analyze_output_from_code(\%output, $code, $method_name);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3890: 	$self->_enhance_boolean_detection(\%output, $pod, $code, $method_name);
 3891: 	$self->_detect_list_context(\%output, $code);
 3892: 	$self->_detect_void_context(\%output, $code, $method_name);
 3893: 	$self->_detect_chaining_pattern(\%output, $code);
 3894: 	$self->_detect_error_conventions(\%output, $code);
 3895: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3896: 	$self->_validate_output(\%output) if keys %output;
 3897: 
 3898: 	# Don't return empty output
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3899: 	return (keys %output) ? \%output : {};
 3900: }
 3901: 
 3902: # --------------------------------------------------

					

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

				
COND_INV_3902_5: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

 3903: # _analyze_output_from_pod
 3904: #
 3905: # Purpose:    Parse the POD documentation for a
 3906: #             method's return value and populate
 3907: #             an output hashref with type, value,
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3908: #             and behaviour information.
 3909: #
 3910: # Entry:      $output - hashref to populate
 3911: #                       (modified in place).
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3912: #             $pod    - POD string for the method.
 3913: #
 3914: # Exit:       Returns nothing. Modifies $output
 3915: #             in place.
 3916: #
 3917: # Side effects: Logs detections to stdout when
 3918: #               verbose is set.
 3919: #
 3920: # Notes:      Two patterns are tried: (1) a
 3921: #             'Returns:' section of up to 3 lines,
 3922: #             and (2) an inline 'returns X' phrase.
 3923: #             The section pattern takes precedence.
 3924: # --------------------------------------------------
 3925: sub _analyze_output_from_pod {
●3926 → 3930 → 0 3926: 	my ($self, $output, $pod) = @_;
 3927: 	my %VALID_OUTPUT_TYPES = map { $_ => 1 }
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3928: 		qw(string integer number float boolean arrayref hashref object coderef void undef);
 3929: 
 3930: 	if ($pod) {
 3931: 		# Pattern 0: =head4 Output formal spec (highest priority — explicit over heuristic)
 3932: 		# The outer container shape determines the return type:
 3933: 		#   (...)  — list/array of items
 3934: 		#   [...]  — arrayref  (bare [] = empty/void, skip)
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3935: 		#   {...}  — hashref spec; look for type => inside, or isa => for object
 3936: 		if($pod =~ /=head4\s+Output\b(.*?)(?==head|\z)/si) {
 3937: 			my $block = $1;
 3938: 			$block =~ s/^\s+//;
 3939: 			if($block =~ /^\(/) {
 3940: 				$output->{type} = 'array';
 3941: 				$self->_log("  OUTPUT: type 'array' from =head4 Output list notation");
 3942: 			} elsif($block =~ /^\[/) {
 3943: 				unless($block =~ /^\[\s*\]/) {
 3944: 					$output->{type} = 'arrayref';
 3945: 					$self->_log("  OUTPUT: type 'arrayref' from =head4 Output arrayref notation");
 3946: 				}
 3947: 			} elsif($block =~ /^\{/) {
 3948: 				if($block =~ /type\s*=>\s*['"]?(\w[\w:]*?)['"]?\s*[,}]/i) {
 3949: 					my $type = lc($1);
 3950: 					$type = 'hashref'  if $type eq 'hash';
 3951: 					$type = 'arrayref' if $type eq 'array';
 3952: 					if($VALID_OUTPUT_TYPES{$type}) {
 3953: 						$output->{type} = $type;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3954: 						$self->_log("  OUTPUT: type '$type' from =head4 Output formal spec");
 3955: 					} elsif($block =~ /\bisa\s*=>/) {

					

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

				
COND_INV_3955_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3956: 						$output->{type} = 'object';
 3957: 						$self->_log("  OUTPUT: type 'object' from =head4 Output isa spec");
 3958: 					}
 3959: 				} elsif($block =~ /\bisa\s*=>/) {
 3960: 					$output->{type} = 'object';
 3961: 					$self->_log("  OUTPUT: type 'object' from =head4 Output isa spec");
 3962: 				}
 3963: 			}
 3964: 		}
 3965: 
 3966: 		# Pattern 1: Returns: section
 3967: 		# Up to 3 lines

					

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

				
COND_INV_3967_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3968: 		if ($pod =~ /Returns?:\s+([^\n]+(?:\n[^\n]+){0,2})/si) {
 3969: 			my $returns_desc = $1;
 3970: 			$returns_desc =~ s/^\s+|\s+$//g;

					

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

				
COND_INV_3970_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3971: 
 3972: 			$self->_log("  OUTPUT: Found Returns section: $returns_desc");
 3973: 
 3974: 			# Try to infer type from description (skip if Pattern 0 already set type)
 3975: 			if (!$output->{type} && $returns_desc =~ /\b(string|text)\b/i) {
 3976: 				$output->{type} = 'string';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3977: 			} elsif (!$output->{type} && $returns_desc =~ /\b(integer|int|count)\b/i) {
 3978: 				$output->{type} = 'integer';
 3979: 			} elsif (!$output->{type} && $returns_desc =~ /\b(float|decimal|number)\b/i) {
 3980: 				$output->{type} = 'number';
 3981: 			} elsif (!$output->{type} && $returns_desc =~ /\b(boolean|true|false)\b/i) {
 3982: 				$output->{type} = 'boolean';
 3983: 			} elsif (!$output->{type} && $returns_desc =~ /\b(array|list)\b/i) {
 3984: 				$output->{type} = 'arrayref';
 3985: 			} elsif (!$output->{type} && $returns_desc =~ /\b(hash|hashref|dictionary)\b/i) {
 3986: 				$output->{type} = 'hashref';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3987: 			} elsif (!$output->{type} && $returns_desc =~ /\b(object|instance)\b/i) {

					

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

				
COND_INV_3987_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3988: 				$output->{type} = 'object';
 3989: 			} elsif (!$output->{type} && $returns_desc =~ /\bundef\b/i) {

					

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

				
COND_INV_3989_6: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 3990: 				$output->{type} = 'undef';
 3991: 			}
 3992: 
 3993: 			# Look for specific values
 3994: 			if ($returns_desc =~ /\b1\s+(?:on\s+success|if\s+successful)\b/i) {
 3995: 				$output->{value} = 1;
 3996: 				if(defined($output->{'type'}) && ($output->{type} eq 'scalar')) {
 3997: 					$output->{type} = 'boolean';
 3998: 				} else {
 3999: 					$output->{type} ||= 'boolean';
 4000: 				}
 4001: 				$self->_log("  OUTPUT: Returns 1 on success");
 4002: 			} elsif ($returns_desc =~ /\b0\s+(?:on\s+failure|if\s+fail)\b/i) {
 4003: 				$output->{alt_value} = 0;

					

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

				
COND_INV_4003_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4004: 			} elsif ($returns_desc =~ /dies\s+on\s+(?:error|failure)/i) {
 4005: 				$output->{_STATUS} = 'LIVES';
 4006: 				$self->_log('  OUTPUT: Should not die on success');
 4007: 			}
 4008: 			if ($returns_desc =~ /\b(true|false)\b/i) {
 4009: 				$output->{type} ||= 'boolean';
 4010: 			}
 4011: 			if ($returns_desc =~ /\bundef\b/i) {
 4012: 				$output->{optional} = 1;
 4013: 			}
 4014: 		}
 4015: 
 4016: 		# Pattern 2: Inline "returns X"
 4017: 		if((!$output->{type}) && ($pod =~ /returns?\s+(?:an?\s+)?(\w+)/i)) {
 4018: 			my $type = lc($1);
 4019: 
 4020: 			$type = 'boolean' if $type =~ /^(true|false|bool)$/;
 4021: 			# Skip if it's just a number (like "returns 1")
 4022: 			$type = 'integer' if $type eq 'int';
 4023: 			$type = 'number' if $type =~ /^(num|float)$/;
 4024: 			$type = 'arrayref' if $type eq 'array';
 4025: 			$type = 'hashref' if $type eq 'hash';
 4026: 
 4027: 			if($type =~ /^\d+$/) {
 4028: 				if($type eq '1' || $type eq '0') {
 4029: 					# Try hard to guess if the result is a boolean
 4030: 					if($pod =~ /1 on success.+0 (on|if) /i) {
 4031: 						$type = 'boolean';
 4032: 					} elsif($pod =~ /return 0 .+ 1 on success/) {
 4033: 						$type = 'boolean';
 4034: 					} else {
 4035: 						$type = 'integer';
 4036: 					}
 4037: 				} else {
 4038: 					$type = 'integer';
 4039: 				}
 4040: 			}
 4041: 
 4042: 			$type = 'arrayref' if !$type && $pod =~ /returns?\s+.+\slist\b/i;
 4043: 			# $output->{type} = $type if $type && $type !~ /^\d+$/;
 4044: 			if ($VALID_OUTPUT_TYPES{$type}) {
 4045: 				$output->{type} = $type;
 4046: 				$self->_log("  OUTPUT: Inferred type from POD: $type");
 4047: 			} else {
 4048: 				$self->_log("  OUTPUT: POD return type '$type' is not a valid type, ignoring");
 4049: 			}
 4050: 		}
 4051: 	}
 4052: }
 4053: 
 4054: # --------------------------------------------------
 4055: # _extract_defaults_from_pod
 4056: #
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4057: # Purpose:    Extract default values for parameters
 4058: #             from POD documentation using multiple
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4059: #             pattern strategies.
 4060: #
 4061: # Entry:      $pod - POD string for the method.
 4062: #                    May be undef or empty.
 4063: #
 4064: # Exit:       Returns a hashref of parameter name
 4065: #             to cleaned default value. Returns an
 4066: #             empty hashref if no POD is provided
 4067: #             or no defaults are found.
 4068: #
 4069: # Side effects: None.
 4070: #
 4071: # Notes:      Three strategies are tried: (1) lines
 4072: #             containing 'Default:' or 'Defaults to:',
 4073: #             (2) lines containing 'Optional, default',
 4074: #             (3) inline $name - type, default value
 4075: #             format. Parameter names are inferred
 4076: #             by scanning backwards from the default
 4077: #             phrase to the nearest $variable.
 4078: # --------------------------------------------------
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4079: sub _extract_defaults_from_pod {
●4080 → 4087 → 4111 4080: 	my ($self, $pod) = @_;
 4081: 
 4082: 	return {} unless $pod;
 4083: 
 4084: 	my %defaults;
 4085: 
 4086: 	# Pattern 1: Default: 'value' or Defaults to: 'value'
 4087: 	while ($pod =~ /(?:Default(?:s? to)?|default(?:s? to)?)[:]\s*([^\n\r]+)/gi) {
 4088: 		my $default_text = $1;
 4089: 		my $match_pos = pos($pod);
 4090: 		$default_text =~ s/^\s+|\s+$//g;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4091: 
 4092: 		# Look backwards in the POD to find the parameter name
 4093: 		my $context = substr($pod, 0, $match_pos);
 4094: 		my @param_matches = ($context =~ /\$(\w+)/g);
 4095: 		my $param = $param_matches[-1] if @param_matches;  # Last parameter before default
 4096: 
 4097: 		if ($param) {
 4098: 			# Always clean the default value - let _clean_default_value handle everything
 4099: 			if ($default_text =~ /(\w+)\s*=\s*(.+)$/) {
 4100: 				# Has explicit param = value format in the default text
 4101: 				my ($p, $value) = ($1, $2);
 4102: 				$defaults{$p} = $self->_clean_default_value($value);
 4103: 			} else {
 4104: 				# Just a value, associate with the found param
 4105: 				$defaults{$param} = $self->_clean_default_value($default_text, 0);  # NOT from code
 4106: 			}
 4107: 		}
 4108: 	}
 4109: 
 4110: 	# Pattern 2: Optional, default 'value'
●4111 → 4111 → 4126 4111: 	while ($pod =~ /Optional(?:,)?\s+(?:default|value)\s*[:=]?\s*([^\n\r,;]+)/gi) {
 4112: 		my $default_text = $1;
 4113: 		my $match_pos = pos($pod);
 4114: 		$default_text =~ s/^\s+|\s+$//g;
 4115: 
 4116: 		# Look backwards for parameter name
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4117: 		my $context = substr($pod, 0, $match_pos);
 4118: 		my @param_matches = ($context =~ /\$(\w+)/g);
 4119: 		if (@param_matches) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4120: 			my $param = $param_matches[-1];  # Last parameter before the default
 4121: 			$defaults{$param} = $self->_clean_default_value($default_text, 0);
 4122: 		}
 4123: 	}
 4124: 
 4125: 	# Pattern 3: In parameter descriptions: $param - type, default 'value'
●4126 → 4126 → 4131 4126: 	while ($pod =~ /\$(\w+)\s*-\s*\w+(?:\([^)]*\))?[,\s]+default\s+['"]?([^'",\n]+)['"]?/gi) {
 4127: 		my ($param, $value) = ($1, $2);
 4128: 		$defaults{$param} = $self->_clean_default_value($value, 0);
 4129: 	}
 4130: 
  Mutants (Total: 4, Killed: 4, Survived: 0)
 4131: 	return \%defaults;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4132: }
 4133: 
 4134: # --------------------------------------------------
 4135: # _analyze_output_from_code
 4136: #
 4137: # Purpose:    Analyse return statements in a method
 4138: #             body to infer the output type by
 4139: #             counting and classifying each return
 4140: #             expression.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4141: #
 4142: # Entry:      $output      - hashref to populate
 4143: #                            (modified in place).

					

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

				
COND_INV_4143_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4144: #             $code        - method body source string.
 4145: #             $method_name - method name string.

					

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

				
COND_INV_4145_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4146: #
 4147: # Exit:       Returns nothing. Modifies $output
 4148: #             in place.
 4149: #
 4150: # Side effects: Logs detections to stdout when
 4151: #               verbose is set.
 4152: # --------------------------------------------------
 4153: sub _analyze_output_from_code
 4154: {
●4155 → 4157 → 0 4155: 	my ($self, $output, $code, $method_name) = @_;

					

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

				
COND_INV_4155_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4156: 
 4157: 	if ($code) {
 4158: 		# Early boolean detection - check for consistent 1/0 returns
 4159: 		my @all_returns = $code =~ /return\s+([^;]+);/g;
 4160: 		if (@all_returns) {
 4161: 			my $boolean_count = 0;
 4162: 			my $total_count = scalar(@all_returns);
 4163: 
 4164: 			foreach my $ret (@all_returns) {
 4165: 				$ret =~ s/^\s+|\s+$//g;
 4166: 				# Match 0 or 1, even with conditions
 4167: 				$boolean_count++ if ($ret =~ /^(?:0|1)(?:\s|$)/);
 4168: 			}
 4169: 

					

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

				
COND_INV_4169_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4170: 			# If most returns are 0 or 1, strongly suggest boolean
 4171: 			if ($boolean_count >= 2 && $boolean_count >= $total_count * 0.8) {
 4172: 				unless ($output->{type}) {
 4173: 					$output->{type} = 'boolean';
 4174: 					$self->_log("  OUTPUT: Early detection - $boolean_count/$total_count returns are 0/1, setting boolean");
 4175: 				}
 4176: 			}
 4177: 		}

					

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

				
COND_INV_4177_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4178: 
 4179: 		my @return_statements;
 4180: 
 4181: 		if ($code =~ /return\s+bless\s*\{[^}]*\}\s*,\s*['"]?(\w+)['"]?/s) {
 4182: 			# Detect blessed refs
 4183: 			$output->{type} = 'object';

					

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

				
COND_INV_4183_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4184: 			if($method_name eq 'new') {
 4185: 				# If we found the new() method, the object we're returning should be a sensible one
 4186: 				if($self->{_document} && (my $package_stmt = $self->{_document}->find_first('PPI::Statement::Package'))) {
 4187: 					$output->{isa} = $package_stmt->namespace();
 4188: 					$self->{_package_name} //= $output->{isa};
 4189: 				}
 4190: 			} else {
 4191: 				$output->{isa} = $1;
 4192: 			}
 4193: 			$self->_log("  OUTPUT: Bless found, inferring type from code is $output->{isa}");
 4194: 		} elsif ($code =~ /return\s+bless/s) {
 4195: 			$output->{type} = 'object';
 4196: 			if($method_name eq 'new') {
 4197: 				$output->{isa} = $self->_extract_package_name();
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4198: 				$self->_log("  OUTPUT: Bless found, inferring type from code is $output->{isa}");
 4199: 			} else {
 4200: 				$self->_log('  OUTPUT: Bless found, inferring type from code is object');
 4201: 			}
 4202: 		} elsif ($code =~ /return\s*\(\s*[^)]+\s*,\s*[^)]+\s*\)\s*;/) {
 4203: 			# Detect array context returns - must end with semicolon to be actual return
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4204: 			$output->{type} = 'array';	# Not arrayref - actual array
 4205: 			$self->_log('  OUTPUT: Found array contect return');
 4206: 		} elsif ($code =~ /return\s+bless[^,]+,\s*__PACKAGE__/) {
 4207: 			# Detect: bless {}, __PACKAGE__
 4208: 			$output->{type} = 'object';
 4209: 			# Get package name from the extractor's stored document
 4210: 			if ($self->{_document}) {
 4211: 				my $pkg = $self->{_document}->find_first('PPI::Statement::Package');
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4212: 				$output->{isa} = $pkg ? $pkg->namespace : 'UNKNOWN';
 4213: 				$self->_log('  OUTPUT: Object blessed into __PACKAGE__: ' . ($output->{isa} || 'UNKNOWN'));
 4214: 				$self->{_package_name} //= $output->{isa};
 4215: 			}
 4216: 		} elsif ($code =~ /return\s*\(([^)]+)\)/) {
 4217: 			my $content = $1;
 4218: 			if ($content =~ /,/) {	# Has comma = multiple values
 4219: 				$output->{type} = 'array';
 4220: 			}
 4221: 		} elsif ($code =~ /return\s+\$self\s*;/ && $code =~ /\$self\s*->\s*\{[^}]+\}\s*=/) {
 4222: 			# Returns $self for chaining
 4223: 			$output->{type} = 'object';
 4224: 			if ($self->{_document}) {
 4225: 				my $pkg = $self->{_document}->find_first('PPI::Statement::Package');
 4226: 				$output->{isa} = $pkg ? $pkg->namespace : 'UNKNOWN';
 4227: 				$self->_log('  OUTPUT: Object chained into __PACKAGE__: ' . ($output->{isa} || 'UNKNOWN'));
 4228: 				$self->{_package_name} //= $output->{isa};
 4229: 			}
 4230: 		}
 4231: 
 4232: 		# Find all return statements
 4233: 		while ($code =~ /return\s+([^;]+);/g) {
 4234: 			my $return_expr = $1;
 4235: 			push @return_statements, $return_expr;
 4236: 		}
 4237: 
 4238: 		if (@return_statements) {
 4239: 			$self->_log('  OUTPUT: Found ' . scalar(@return_statements) . ' return statement(s)');
 4240: 
 4241: 			# Analyze return patterns
 4242: 			my %return_types;
 4243: 
 4244: 			if($output->{'type'}) {
 4245: 				$return_types{$output->{'type'}} += 3;	# Add weighting to what's already been found
 4246: 			}
 4247: 			my $min;
 4248: 			foreach my $ret (@return_statements) {
 4249: 				$ret =~ s/^\s+|\s+$//g;
 4250: 
 4251: 				# Literal values
 4252: 				if ($ret eq '1' || $ret eq '0') {
 4253: 					$return_types{boolean}++;
 4254: 				} elsif ($ret =~ /^['"]/) {
 4255: 					$return_types{string}++;
 4256: 				} elsif ($ret =~ /^-?\d+$/) {

					

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

				
COND_INV_4256_6: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4257: 					$return_types{integer}++;
 4258: 				} elsif ($ret =~ /^-?\d+\.\d+$/) {
 4259: 					$return_types{number}++;
 4260: 				} elsif ($ret eq 'undef') {
 4261: 					$return_types{undef}++;
 4262: 				} elsif ($ret =~ /^\[/) {
 4263: 				# Data structures
 4264: 					$return_types{arrayref}++;
 4265: 				} elsif ($ret =~ /^\{/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4266: 					$return_types{hashref}++;
 4267: 				} elsif ($ret =~ m{
 4268: 					# Numeric expressions (heuristic, medium confidence)
 4269: 					# Don't match ->
 4270: 				    (?:
 4271: 					\+ | -\b | \* | / | %
 4272: 				      | \+\+ | --
 4273: 				    )
 4274: 				}x) {
 4275: 					$return_types{number} += 2;
 4276: 				} elsif ($ret =~ /\|\|\s*\d+\b/) {
 4277: 					# Logical-or fallback with numeric literal (e.g. $x || 200)
 4278: 					$return_types{integer} += 2;
 4279: 					$self->_log("  OUTPUT: Numeric fallback expression detected");
 4280: 				} elsif($ret =~ /^length[\s\(]/) {
 4281: 					$return_types{integer}++;
 4282: 					$min = 0;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4283: 				} elsif($ret =~ /^pos[\s\(]/) {
 4284: 					$return_types{integer}++;
 4285: 					$min = 0;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4286: 				} elsif($ret =~ /^index[\s\(]/) {

					

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

				
COND_INV_4286_6: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4287: 					$return_types{integer}++;
 4288: 					$min = -1;
 4289: 				} elsif($ret =~ /^rindex[\s\(]/) {
 4290: 					$return_types{integer}++;

					

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

				
COND_INV_4290_7: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4291: 					$min = -1;
 4292: 				} elsif($ret =~ /^ord[\s\(]/) {
 4293: 					$return_types{integer}++;
 4294: 				} elsif ($ret =~ /=/ && $ret =~ /\$\w+/) {
 4295: 					# Assignment returning a value (e.g. $self->{status} = $status)
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4296: 					# If assignment involves a numeric literal or variable, assume numeric intent
 4297: 					if ($ret =~ /\b\d+\b/) {
 4298: 						$return_types{integer} += 2;
 4299: 						$self->_log("  OUTPUT: Assignment with numeric value detected");

					

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

				
COND_INV_4299_6: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4300: 					} else {
 4301: 						$return_types{scalar}++;

					

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

				
COND_INV_4301_7: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4302: 					}
 4303: 				}
 4304: 				# Variables/expressions
 4305: 				elsif ($ret =~ /\$\w+/) {
 4306: 					if ($ret =~ /\\\@/) {
 4307: 						$return_types{arrayref}++;
 4308: 					} elsif ($ret =~ /\\\%/) {
 4309: 						$return_types{hashref}++;
 4310: 					} elsif ($ret =~ /bless/) {
 4311: 						$return_types{object} += 2;	# Heigher weight

					

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

				
NUM_BOUNDARY_4311_27_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 4312: 					} elsif ($ret =~ /^\{[^}]*\}$/) {
 4313: 						$return_types{hashref}++;
 4314: 					} elsif ($ret =~ /^\[[^\]]*\]$/) {
 4315: 						$return_types{arrayref}++;
 4316: 					} else {
 4317: 						$return_types{scalar}++;
 4318: 					}
 4319: 				}
 4320: 			}
 4321: 
 4322: 			# Determine most common return type
 4323: 			if (keys %return_types) {
 4324: 				my ($most_common) = sort { $return_types{$b} <=> $return_types{$a} } keys %return_types;
 4325: 				# Prefer integer over scalar if numeric returns dominate
 4326: 				if ($return_types{integer} && (!$return_types{string})) {
 4327: 					if (!$output->{type} || $output->{type} eq 'scalar') {
 4328: 						$output->{type} = 'integer';
 4329: 						$self->_log("  OUTPUT: Numeric returns dominate, forcing integer");
 4330: 						$output->{_type_confidence} ||= 'low';
 4331: 						if(defined($min)) {
 4332: 							$output->{min} = $min;
 4333: 						}
 4334: 					}
 4335: 				}
 4336: 				unless ($output->{type}) {
 4337: 					$output->{type} = $most_common;
 4338: 
 4339: 					# Assign confidence for inferred numeric expressions
 4340: 					if ($most_common eq 'number') {
 4341: 						$output->{_type_confidence} ||= 'medium';
 4342: 						if(defined($min)) {
 4343: 							$output->{min} = $min;
 4344: 						}
 4345: 					}
 4346: 
 4347: 					$self->_log("  OUTPUT: Inferred type from code: $most_common");
 4348: 				}
 4349: 			}
 4350: 
 4351: 			# Check for consistent single value returns
 4352: 			if (@return_statements == 1 && $return_statements[0] eq '1') {
 4353: 				$output->{value} = 1;
 4354: 				$output->{type} = 'boolean' if !$output->{type} || $output->{type} eq 'scalar';
 4355: 				$self->_log("  OUTPUT: Type already set to '$output->{type}', overriding with boolean") if($output->{'type'});
 4356: 			}
 4357: 		} else {
 4358: 			# No explicit return - might return nothing or implicit undef

					

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

				
COND_INV_4358_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4359: 			$self->_log("  OUTPUT: No explicit return statement found");
 4360: 		}

					

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

				
COND_INV_4360_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4361: 	}
 4362: }
 4363: 
 4364: # --------------------------------------------------
 4365: # _enhance_boolean_detection
 4366: #

					

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

				
COND_INV_4366_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4367: # Purpose:    Apply additional boolean-specific
 4368: #             detection heuristics using a weighted

					

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

				
COND_INV_4368_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4369: #             scoring system, to override weak
 4370: #             type assignments when there is strong
 4371: #             evidence of a boolean return.
 4372: #
 4373: # Entry:      $output      - output hashref
 4374: #                            (modified in place).
 4375: #             $pod         - POD string.
 4376: #             $code        - method body source string.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4377: #             $method_name - method name string.
 4378: #
 4379: # Exit:       Returns nothing. Modifies $output
 4380: #             in place, setting type to 'boolean'
 4381: #             if the score reaches

					

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

				
NUM_BOUNDARY_4381_38_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_4381_38_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_4381_38_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
COND_INV_4381_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4382: #             $BOOLEAN_SCORE_THRESHOLD.
 4383: #
 4384: # Side effects: Logs scoring details to stdout when
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4385: #               verbose is set.
 4386: #
 4387: # Notes:      Only fires when output type is
 4388: #             not yet set or is 'unknown'. Does not
 4389: #             override explicitly set types.
 4390: # --------------------------------------------------

					

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

				
COND_INV_4390_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4391: sub _enhance_boolean_detection {
●4392 → 4399 → 4417 4392: 	my ($self, $output, $pod, $code, $method_name) = @_;
 4393: 
 4394: 	my $boolean_score = 0;	# Track evidence for boolean return
 4395: 
 4396: 	return unless !$output->{type} || $output->{type} eq 'unknown';

					

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

				
COND_INV_4396_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4397: 
 4398: 	# Look for stronger boolean indicators
 4399: 	if ($pod && !$output->{type}) {
 4400: 		# Common boolean return patterns in POD
 4401: 		if ($pod =~ /returns?\s+(?:true|false|1|0)\s+(?:on|for|upon)\s+(?:success|failure|error|valid|invalid)/i) {
 4402: 			$boolean_score += 30;
 4403: 			$self->_log('  OUTPUT: Strong boolean indicator in POD (+30)');
 4404: 		}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4405: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4406: 		# Check for method names that suggest boolean returns
 4407: 		if ($pod =~ /(?:method|sub)\s+(\w+)/) {
 4408: 			my $inferred_method_name = $1;
 4409: 			if ($inferred_method_name =~ /^(is_|has_|can_|should_|contains_|exists_)/) {

					

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

				
COND_INV_4409_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4410: 				$boolean_score += 20;
 4411: 				$self->_log("  OUTPUT: Inferred method name '$inferred_method_name' suggests boolean return (+20)");
 4412: 			}
 4413: 		}
 4414: 	}
 4415: 
 4416: 	# Analyze code for boolean patterns
●4417 → 4417 → 4445 4417: 	if ($code) {

					

					
Mutants (Total: 4, Killed: 1, Survived: 3)
					

				
NUM_BOUNDARY_4417_20_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_4417_20_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_4417_20_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 4418: 		# Count boolean return idioms
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4419: 		my $true_returns = () = $code =~ /return\s+1\s*;/g;
 4420: 		my $false_returns = () = $code =~ /return\s+0\s*;/g;
 4421: 
 4422: 		if ($true_returns + $false_returns >= 2) {
 4423: 			$boolean_score += 40;
 4424: 			$self->_log('  OUTPUT: Multiple 1/0 returns suggest boolean (+40)');
 4425: 		} elsif ($true_returns + $false_returns == 1) {
 4426: 			$boolean_score += 10;
 4427: 			$self->_log('  OUTPUT: Single 1/0 return (+10)');
 4428: 		}
 4429: 
 4430: 		# Ternary operators that return booleans
 4431: 		if ($code =~ /return\s+(?:\w+\s*[!=]=\s*\w+|\w+\s*>\s*\w+|\w+\s*<\s*\w+)\s*\?\s*(?:1|0)\s*:\s*(?:1|0)/) {
 4432: 			$boolean_score += 25;
 4433: 			$self->_log('  OUTPUT: Ternary with 1/0 suggests boolean (+25)');
 4434: 		}
 4435: 
 4436: 		# Check for common boolean method patterns
 4437: 		if ($code =~ /return\s+[!\$\@\%]/) {
 4438: 			# Returns negation or existence check
 4439: 			$boolean_score += 15;
 4440: 			$self->_log('  OUTPUT: Returns negation/existence check (+15)');
 4441: 		}
 4442: 	}
 4443: 
 4444: 	# Check method name for boolean indicators
●4445 → 4445 → 4458 4445: 	if ($method_name) {
 4446: 		if ($method_name =~ /^(?:is_|has_|can_|should_|contains_|exists_|check_|verify_|validate_)/) {
 4447: 			$boolean_score += 25;
 4448: 			$self->_log("  OUTPUT: Method name '$method_name' suggests boolean return (+25)");
 4449: 		}
 4450: 		if ($method_name =~ /_ok$/) {
 4451: 			$boolean_score += 30;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4452: 			$self->_log("  OUTPUT: Method name '$method_name' ends with '_ok' (+30)");
 4453: 		}
 4454: 	}
 4455: 
 4456: 	# Apply boolean type if we have strong evidence

					

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

				
COND_INV_4456_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4457: 	# Override weak type assignments (like 'array' from false positive)
●4458 → 4458 → 0 4458: 	if($boolean_score >= $BOOLEAN_SCORE_THRESHOLD) {
 4459: 		if (!$output->{type} || $output->{type} eq 'scalar' || $output->{type} eq 'array' || $output->{type} eq 'undef') {
 4460: 			my $old_type = $output->{type} || 'none';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4461: 			$output->{type} = 'boolean';
 4462: 			$self->_log("  OUTPUT: Boolean score $boolean_score >= $BOOLEAN_SCORE_THRESHOLD, setting type to boolean (was: $old_type)");
 4463: 		}
 4464: 	}
 4465: }
 4466: 
 4467: # --------------------------------------------------
 4468: # _detect_list_context
 4469: #
 4470: # Purpose:    Detect methods that return different
 4471: #             values depending on calling context
 4472: #             via wantarray, and methods that
 4473: #             return explicit lists.
 4474: #
 4475: # Entry:      $output - output hashref (modified
 4476: #                       in place).
 4477: #             $code   - method body source string.
 4478: #
 4479: # Exit:       Returns nothing. Modifies $output
 4480: #             in place, setting _context_aware,
 4481: #             _list_context, _scalar_context,
 4482: #             _list_return, and/or type keys.
 4483: #
 4484: # Side effects: Logs detections to stdout when
 4485: #               verbose is set.
 4486: # --------------------------------------------------
 4487: sub _detect_list_context {
●4488 → 4492 → 4530 4488: 	my ($self, $output, $code) = @_;
 4489: 	return unless $code;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4490: 
 4491: 	# Check for wantarray usage
 4492: 	if ($code =~ /wantarray/) {
 4493: 		$output->{_context_aware} = 1;
 4494: 		$self->_log('  OUTPUT: Method uses wantarray - context sensitive');
 4495: 
 4496: 		# Debug: show what we're matching against
 4497: 		if ($code =~ /(wantarray[^;]+;)/s) {
 4498: 			$self->_log("  DEBUG wantarray line: $1");
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4499: 		}
 4500: 
 4501: 		if ($code =~ /wantarray\s*\?\s*\(([^)]+)\)\s*:\s*([^;]+)/s) {
 4502: 			# Pattern 1: wantarray ? (list, items) : scalar_value (with parens)
 4503: 			my ($list_return, $scalar_return) = ($1, $2);
 4504: 			$self->_log("  DEBUG list (with parens): [$list_return], scalar: [$scalar_return]");
 4505: 
 4506: 			$output->{_list_context} = $self->_infer_type_from_expression($list_return);
 4507: 			$output->{_scalar_context} = $self->_infer_type_from_expression($scalar_return);
  Mutants (Total: 4, Killed: 4, Survived: 0)
 4508: 			$self->_log('  OUTPUT: Detected context-dependent returns (parenthesized)');
 4509: 		} elsif ($code =~ /wantarray\s*\?\s*([^:]+?)\s*:\s*([^;]+)/s) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4510: 			# Pattern 2: wantarray ? @array : scalar (no parens around list)
 4511: 			my ($list_return, $scalar_return) = ($1, $2);
 4512: 			# Clean up
 4513: 			$list_return =~ s/^\s+|\s+$//g;
 4514: 			$scalar_return =~ s/^\s+|\s+$//g;
 4515: 
 4516: 			$self->_log("  DEBUG list (no parens): [$list_return], scalar: [$scalar_return]");
 4517: 
 4518: 			$output->{_list_context} = $self->_infer_type_from_expression($list_return);
 4519: 			$output->{_scalar_context} = $self->_infer_type_from_expression($scalar_return);
 4520: 			$self->_log('  OUTPUT: Detected context-dependent returns (non-parenthesized)');
 4521: 		} elsif ($code =~ /return[^;]*unless\s+wantarray.*?return\s*\(([^)]+)\)/s) {
 4522: 			# Pattern 3: return unless wantarray; return (list);
 4523: 			$output->{_list_context} = { type => 'array' };
 4524: 			$self->_log('  OUTPUT: Detected list context return after wantarray check');
 4525: 		}
 4526: 	}
 4527: 
 4528: 	# Detect explicit list returns (multiple values in parentheses)
 4529: 	# Avoid false positives from function calls
●4530 → 4530 → 0 4530: 	if ($code =~ /return\s*\(\s*([^)]+)\s*\)\s*;/) {
 4531: 		my $content = $1;
 4532: 
 4533: 		# Count commas outside of nested structures, jumping over each
 4534: 		# balanced bracketed block in one step via extract_bracketed
 4535: 		require Text::Balanced;
 4536: 		my $comma_count = 0;
 4537: 		my $rest = $content;
 4538: 		while (length $rest) {
 4539: 			if (substr($rest, 0, 1) =~ /[(\[{]/) {
 4540: 				my $extracted = Text::Balanced::extract_bracketed($rest, '(){}[]');
 4541: 				last unless defined $extracted;	# Unbalanced brackets
 4542: 				next;
 4543: 			}
 4544: 			$comma_count++ if substr($rest, 0, 1) eq ',';
 4545: 			$rest = substr($rest, 1);
 4546: 		}
 4547: 
 4548: 		if ($comma_count > 0 && $content !~ /\b(?:bless|new)\b/) {
 4549: 			# Multiple values returned
 4550: 			unless ($output->{type} && $output->{type} eq 'boolean') {
 4551: 				$output->{type} = 'array';
 4552: 				$output->{_list_return} = $comma_count + 1;
 4553: 				$self->_log('  OUTPUT: Returns list of ' . ($comma_count + 1) . ' values');
 4554: 			}
 4555: 		}
 4556: 	}

					

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

				
COND_INV_4556_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4557: }
 4558: 
 4559: # --------------------------------------------------
 4560: # _detect_void_context
 4561: #
 4562: # Purpose:    Detect methods that return nothing
 4563: #             meaningful (void context), methods
 4564: #             that always return 1 as a success
 4565: #             indicator, and methods whose name
 4566: #             suggests void context (setters,
 4567: #             mutators, loggers).
 4568: #
 4569: # Entry:      $output      - output hashref
 4570: #                            (modified in place).
 4571: #             $code        - method body source string.
 4572: #             $method_name - method name string.
 4573: #
 4574: # Exit:       Returns nothing. Modifies $output
 4575: #             in place, setting _void_context,
 4576: #             _success_indicator, and/or type.
 4577: #
 4578: # Side effects: Logs detections to stdout when
 4579: #               verbose is set.
 4580: # --------------------------------------------------
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4581: sub _detect_void_context {
●4582 → 4596 → 4605 4582: 	my ($self, $output, $code, $method_name) = @_;
 4583: 	return unless $code;
 4584: 
 4585: 	$self->_log("  DEBUG _detect_void_context called for $method_name");
 4586: 
 4587: 	# Methods that typically don't return meaningful values
 4588: 	my $void_patterns = {
 4589: 		'setter' => qr/^set_\w+$/,
 4590: 		'mutator' => qr/^(?:add|remove|delete|clear|reset|update)_/,
 4591: 		'logger' => qr/^(?:log|debug|warn|error|info)$/,
 4592: 		'printer' => qr/^(?:print|say|dump)_/,
 4593: 	};
  Mutants (Total: 5, Killed: 5, Survived: 0)
 4594: 
 4595: 	# Check if method name suggests void context
 4596: 	foreach my $type (keys %$void_patterns) {
 4597: 		if ($method_name =~ $void_patterns->{$type}) {
  Mutants (Total: 7, Killed: 7, Survived: 0)
 4598: 			$output->{_void_context_hint} = $type;
 4599: 			$self->_log("  OUTPUT: Method name suggests $type (typically void context)");
 4600: 			last;
 4601: 		}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4602: 	}
 4603: 
 4604: 	# Analyze return statements
●4605 → 4614 → 4629 4605: 	my @returns = $code =~ /return\s*([^;]*);/g;
 4606: 
 4607: 	$self->_log('  DEBUG Found ' . scalar(@returns) . ' return statements');
 4608: 
 4609: 	# Count different return patterns
 4610: 	my $no_value_returns = 0;
 4611: 	my $true_returns = 0;
 4612: 	my $self_returns = 0;
 4613: 
 4614: 	foreach my $ret (@returns) {
 4615: 		$ret =~ s/^\s+|\s+$//g;
 4616: 		$self->_log("  DEBUG return value: [$ret]");
 4617: 		$no_value_returns++ if $ret eq '';
 4618: 		$no_value_returns++ if($ret =~ /^(if|unless)\s/);
 4619: 		$true_returns++ if $ret eq '1';
 4620: 		$self_returns++ if $ret eq '$self';
 4621: 		if ($ret =~ /\?\s*1\s*:\s*0\b/) {
 4622: 			# Strong boolean signal: ternary returning 1/0
 4623: 			$true_returns++;
 4624: 			# $self->_log("  OUTPUT: Ternary 1:0 return detected, treating as boolean (+40)");
 4625: 			$self->_log('  OUTPUT: Ternary 1:0 return detected, treating as boolean');
 4626: 		}
 4627: 	}
 4628: 
●4629 → 4634 → 0 4629: 	my $total_returns = scalar(@returns);
 4630: 
 4631: 	$self->_log("  DEBUG no_value=$no_value_returns, true=$true_returns, self=$self_returns, total=$total_returns");
 4632: 
 4633: 	# Void context indicators
 4634: 	if ($no_value_returns > 0 && $no_value_returns == $total_returns) {
 4635: 		$output->{_void_context} = 1;
 4636: 		$output->{type} = 'void';  # This should override any previous type
 4637: 		$self->_log('  OUTPUT: All returns are empty - void context method');
 4638: 	} elsif ($true_returns > 0 && $true_returns == $total_returns && $total_returns >= 1) {
 4639: 		# Methods that always return true (success indicator)
 4640: 		$output->{_success_indicator} = 1;
 4641: 		# Don't override type if already set to boolean
 4642: 		unless ($output->{type} && $output->{type} eq 'boolean') {
 4643: 			$output->{type} = 'boolean';
 4644: 		}
 4645: 		$self->_log('  OUTPUT: Always returns 1 - success indicator pattern');
  Mutants (Total: 4, Killed: 4, Survived: 0)
 4646: 	}
 4647: }
 4648: 

					

					
Mutants (Total: 4, Killed: 1, Survived: 3)
					

				
NUM_BOUNDARY_4648_14_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_4648_14_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_4648_14_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 4649: # --------------------------------------------------
 4650: # _detect_chaining_pattern
 4651: #
 4652: # Purpose:    Detect methods that return $self for
 4653: #             fluent interface chaining, by counting
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4654: #             the proportion of return statements
 4655: #             that return $self.
 4656: #
 4657: # Entry:      $output - output hashref (modified
 4658: #                       in place).
 4659: #             $code   - method body source string.
 4660: #
 4661: # Exit:       Returns nothing. Modifies $output
 4662: #             in place, setting type to 'object',
 4663: #             _returns_self to 1, and isa to the
 4664: #             current package name when the
 4665: #             proportion of $self returns is >= 0.8.
 4666: #
 4667: # Side effects: Logs detection to stdout when
 4668: #               verbose is set.
 4669: # --------------------------------------------------
 4670: sub _detect_chaining_pattern {
●4671 → 4678 → 4686 4671: 	my ($self, $output, $code) = @_;
 4672: 	return unless $code;
 4673: 
 4674: 	# Count returns of $self
 4675: 	my $self_returns = 0;
 4676: 	my $total_returns = 0;
 4677: 
 4678: 	while ($code =~ /return\s+([^;]+);/g) {
 4679: 		my $ret = $1;
 4680: 		$ret =~ s/^\s+|\s+$//g;
 4681: 		$total_returns++;
 4682: 		$self_returns++ if $ret eq '$self';
 4683: 	}
 4684: 
 4685: 	# If most/all returns are $self, it's a chaining method
●4686 → 4686 → 0 4686: 	if ($self_returns > 0 && $total_returns > 0) {
 4687: 		my $ratio = $self_returns / $total_returns;
 4688: 
 4689: 		if ($ratio >= 0.8) {
 4690: 			$output->{type} = 'object';
 4691: 			$output->{_returns_self} = 1;
 4692: 
 4693: 			# Get the class name
 4694: 			if ($self->{_document}) {
 4695: 				my $pkg = $self->{_document}->find_first('PPI::Statement::Package');
 4696: 				$output->{isa} = $pkg ? $pkg->namespace : 'UNKNOWN';
 4697: 				$self->{_package_name} //= $output->{isa};
 4698: 			}
 4699: 
 4700: 			$self->_log("  OUTPUT: Chainable method - returns \$self ($self_returns/$total_returns returns)");
 4701: 		}
 4702: 	}
 4703: }
 4704: 
 4705: # --------------------------------------------------
 4706: # _detect_error_conventions
 4707: #
 4708: # Purpose:    Analyse how a method signals errors
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4709: #             by detecting patterns such as
 4710: #             'return undef if', implicit bare
 4711: #             returns, empty list returns, 0/1
 4712: #             boolean error patterns, and eval
 4713: #             exception handling.
 4714: #
 4715: # Entry:      $output - output hashref (modified
 4716: #                       in place).
 4717: #             $code   - method body source string.
 4718: #

					

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

				
COND_INV_4718_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4719: # Exit:       Returns nothing. Modifies $output
 4720: #             in place, setting _error_handling,
 4721: #             _error_return, and
 4722: #             _success_failure_pattern keys.
 4723: #
 4724: # Side effects: Logs detections to stdout when
 4725: #               verbose is set.
  Mutants (Total: 4, Killed: 4, Survived: 0)
 4726: # --------------------------------------------------
 4727: sub _detect_error_conventions {
●4728 → 4737 → 4743 4728: 	my ($self, $output, $code) = @_;
 4729: 
 4730: 	return unless $code;
 4731: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4732: 	$self->_log('  DEBUG _detect_error_conventions called');
 4733: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4734: 	my %error_patterns;
 4735: 
 4736: 	# Pattern 1: return undef if/unless condition
 4737: 	while ($code =~ /return\s+undef\s+(?:if|unless)\s+([^;]+);/g) {
 4738: 		push @{$error_patterns{undef_on_error}}, $1;
 4739: 		$self->_log("  DEBUG Found 'return undef' pattern");
 4740: 	}
 4741: 
 4742: 	# Pattern 2: return if/unless (implicit undef)
●4743 → 4743 → 4749 4743: 	while ($code =~ /return\s+(?:if|unless)\s+([^;]+);/g) {
 4744: 		push @{$error_patterns{implicit_undef}}, $1;
  Mutants (Total: 4, Killed: 4, Survived: 0)
 4745: 		$self->_log("  DEBUG Found implicit undef pattern");
 4746: 	}
 4747: 
 4748: 	# Pattern 3: return () - matches with or without conditions
●4749 → 4749 → 4755 4749: 	if ($code =~ /return\s*\(\s*\)\s*(?:if|unless|;)/) {
 4750: 		$error_patterns{empty_list} = 1;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4751: 		$self->_log("  DEBUG Found empty list return");
 4752: 	}
 4753: 
 4754: 	# Pattern 4: return 0/1 pattern (indicates boolean with error handling)
  Mutants (Total: 1, Killed: 1, Survived: 0)
●4755 → 4758 → 4766 4755: 	my $zero_returns = 0;
 4756: 	my $one_returns = 0;
 4757: 	# Match "return 0" or "return 1" followed by anything (condition or semicolon)
 4758: 	while ($code =~ /return\s+(0|1)\s*(?:;|if|unless)/g) {
 4759: 		if ($1 eq '0') {
 4760: 			$zero_returns++;
 4761: 		} else {
 4762: 			$one_returns++;
 4763: 		}
 4764: 	}
 4765: 
●4766 → 4766 → 4772 4766: 	if ($zero_returns > 0 && $one_returns > 0) {
 4767: 		$error_patterns{zero_on_error} = 1;
 4768: 		$self->_log("  DEBUG Found 0/1 return pattern ($zero_returns zeros, $one_returns ones)");

					

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

				
COND_INV_4768_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4769: 	}
 4770: 
 4771: 	# Pattern 5: Exception handling with eval
●4772 → 4772 → 4781 4772: 	if ($code =~ /eval\s*\{/) {
 4773: 		# Check if there's error handling after eval
 4774: 		if ($code =~ /eval\s*\{.*?\}[^}]*(?:if\s*\(\s*\$\@|catch|return\s+undef)/s) {
 4775: 			$error_patterns{exception_handling} = 1;
 4776: 			$self->_log('  DEBUG Found exception handling with eval');
 4777: 		}
 4778: 	}
 4779: 
 4780: 	# Detect success/failure return pattern
●4781 → 4785 → 4791 4781: 	my @all_returns = $code =~ /return\s+([^;]+);/g;
 4782: 	my $has_undef = grep { /^\s*undef\s*(?:if|unless|$)/ } @all_returns;
 4783: 	my $has_value = grep { !/^\s*undef\s*$/ && !/^\s*$/ } @all_returns;
 4784: 
 4785: 	if ($has_undef && $has_value && scalar(@all_returns) >= 2) {
 4786: 		$output->{_success_failure_pattern} = 1;
 4787: 		$self->_log("  OUTPUT: Uses success/failure return pattern");
 4788: 	}
 4789: 
 4790: 	# Store error conventions in output
●4791 → 4791 → 0 4791: 	if(scalar(keys %error_patterns)) {
 4792: 		$output->{_error_handling} = \%error_patterns;
 4793: 
 4794: 		# Determine primary error convention
 4795: 		if ($error_patterns{undef_on_error}) {
 4796: 			$output->{_error_return} = 'undef';
 4797: 			$self->_log("  OUTPUT: Returns undef on error");
 4798: 		} elsif ($error_patterns{implicit_undef}) {
 4799: 			$output->{_error_return} = 'undef';
 4800: 			$self->_log("  OUTPUT: Returns implicit undef on error");
 4801: 		} elsif ($error_patterns{empty_list}) {
 4802: 			$output->{_error_return} = 'empty_list';
 4803: 			$self->_log("  OUTPUT: Returns empty list on error");
 4804: 		} elsif ($error_patterns{zero_on_error}) {
 4805: 			$output->{_error_return} = 'false';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4806: 			$self->_log("  OUTPUT: Returns 0/false on error");
 4807: 		}
 4808: 
 4809: 		if ($error_patterns{exception_handling}) {
 4810: 			$self->_log("  OUTPUT: Has exception handling");
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4811: 		}
 4812: 	} else {
 4813: 		delete $output->{_error_handling};
 4814: 	}
 4815: }
 4816: 
 4817: # --------------------------------------------------
 4818: # _infer_type_from_expression
 4819: #
  Mutants (Total: 4, Killed: 4, Survived: 0)
 4820: # Purpose:    Infer the data type of a return
 4821: #             expression string by matching it
 4822: #             against common Perl literal and
 4823: #             variable patterns.
 4824: #
 4825: # Entry:      $expr - return expression string,
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4826: #                     trimmed of leading and
 4827: #                     trailing whitespace.
 4828: #                     May be undef.
 4829: #
 4830: # Exit:       Returns a type hashref of the form
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4831: #             { type => '...' } and optionally
 4832: #             { min => N }. Defaults to
 4833: #             { type => 'scalar' } when no
 4834: #             pattern matches.
 4835: #
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4836: # Side effects: None.
 4837: # --------------------------------------------------
 4838: sub _infer_type_from_expression {
●4839 → 4846 → 4866 4839: 	my ($self, $expr) = @_;
 4840: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4841: 	return { type => 'scalar' } unless defined $expr;
 4842: 
 4843: 	$expr =~ s/^\s+|\s+$//g;
 4844: 
 4845: 	# Check for multiple comma-separated values (indicates array/list)
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4846: 	if ($expr =~ /,/) {
 4847: 		require Text::Balanced;
 4848: 		my $comma_count = 0;
 4849: 		my $rest = $expr;
 4850: 		while (length $rest) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4851: 			if (substr($rest, 0, 1) =~ /[(\[{]/) {
 4852: 				my $extracted = Text::Balanced::extract_bracketed($rest, '(){}[]');
 4853: 				last unless defined $extracted;	# Unbalanced brackets
 4854: 				next;
 4855: 			}
 4856: 			$comma_count++ if substr($rest, 0, 1) eq ',';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4857: 			$rest = substr($rest, 1);
 4858: 		}
 4859: 
 4860: 		if ($comma_count > 0) {
 4861: 			return { type => 'array' };
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4862: 		}
 4863: 	}
 4864: 
 4865: 	# Check for @ prefix (array)
  Mutants (Total: 1, Killed: 1, Survived: 0)
●4866 → 4866 → 4871 4866: 	if ($expr =~ /^\@\w+/ || $expr =~ /^qw\(/ || $expr =~ /^\@\{/) {
 4867: 		return { type => 'array' };
 4868: 	}
 4869: 
 4870: 	# Check for scalar() function - returns count
  Mutants (Total: 1, Killed: 1, Survived: 0)
●4871 → 4871 → 4876 4871: 	if ($expr =~ /scalar\s*\(/) {
 4872: 		return { type => 'integer', min => 0 };
 4873: 	}
 4874: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4875: 	# Check for array reference
●4876 → 4876 → 4881 4876: 	if ($expr =~ /^\[/ || $expr =~ /^\\\@/) {
 4877: 		return { type => 'arrayref' };
 4878: 	}
 4879: 
 4880: 	# Check for hash reference
●4881 → 4881 → 4886 4881: 	if ($expr =~ /^\{/ || $expr =~ /^\\\%/) {
 4882: 		return { type => 'hashref' };
 4883: 	}
 4884: 
 4885: 	# Check for hash
●4886 → 4886 → 4891 4886: 	if ($expr =~ /^\%\w+/ || $expr =~ /^\%\{/) {
 4887: 		return { type => 'hash' };
 4888: 	}
 4889: 
 4890: 	# Check for strings
●4891 → 4891 → 4897 4891: 	if ($expr =~ /^['"]/ || $expr =~ /['"]$/) {
 4892: 		return { type => 'string' };
 4893: 	}
 4894: 
 4895: 	# Check for booleans first — must come before the integer check
 4896: 	# since /^-?\d+$/ would otherwise match 0 and 1 as integers
●4897 → 4897 → 4902 4897: 	if($expr =~ /^[01]$/) {
 4898: 		return { type => 'boolean' };
 4899: 	}
 4900: 
 4901: 	# Check for integers
●4902 → 4902 → 4906 4902: 	if($expr =~ /^-?\d+$/) {
 4903: 		return { type => 'integer' };
 4904: 	}
 4905: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
●4906 → 4906 → 4911 4906: 	if ($expr =~ /^-?\d+\.\d+$/) {
 4907: 		return { type => 'number' };
 4908: 	}
 4909: 
 4910: 	# Check for objects
●4911 → 4911 → 4915 4911: 	if ($expr =~ /bless/) {
 4912: 		return { type => 'object' };
 4913: 	}
 4914: 
●4915 → 4915 → 4920 4915: 	if($expr =~ /\blength\s*\(/) {
 4916: 		return { type => 'integer', min => 0 };
 4917: 	}
 4918: 
 4919: 	# Default to scalar
 4920: 	return { type => 'scalar' };
 4921: }
 4922: 
 4923: # --------------------------------------------------
 4924: # _detect_chaining_from_pod
 4925: #
 4926: # Purpose:    Check POD documentation for explicit
 4927: #             indications that a method is chainable
 4928: #             or part of a fluent interface.
 4929: #
 4930: # Entry:      $output - output hashref (modified
 4931: #                       in place).
 4932: #             $pod    - POD string for the method.
 4933: #
 4934: # Exit:       Returns nothing. Sets _returns_self
 4935: #             in $output if chaining keywords are
 4936: #             found.
 4937: #

					

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

				
COND_INV_4937_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4938: # Side effects: Logs detection to stdout when
 4939: #               verbose is set.
 4940: # --------------------------------------------------

					

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

				
COND_INV_4940_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4941: sub _detect_chaining_from_pod {
●4942 → 4946 → 0 4942: 	my ($self, $output, $pod) = @_;
 4943: 	return unless $pod;
 4944: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4945: 	# Look for explicit chaining documentation
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4946: 	if ($pod =~ /returns?\s+(?:\$)?self\b/i ||
 4947: 		$pod =~ /chainable/i ||
 4948: 		$pod =~ /fluent\s+interface/i ||
 4949: 		$pod =~ /method\s+chaining/i) {
 4950: 
 4951: 		$output->{_returns_self} = 1;
 4952: 		$self->_log("  OUTPUT: POD indicates chainable/fluent interface");
 4953: 	}
 4954: }
 4955: 
 4956: # --------------------------------------------------
 4957: # _validate_output
 4958: #
 4959: # Purpose:    Apply basic sanity checks to the
 4960: #             assembled output hashref and warn
 4961: #             about suspicious type combinations,
 4962: #             normalising clearly invalid types to
 4963: #             'string'.
 4964: #
 4965: # Entry:      $output - output hashref (modified
 4966: #                       in place).
 4967: #
 4968: # Exit:       Returns nothing. May modify type key
 4969: #             in $output. Logs warnings to stdout
 4970: #             when verbose is set.
 4971: #
 4972: # Side effects: None.
 4973: # --------------------------------------------------
 4974: sub _validate_output {
●4975 → 4978 → 4981 4975: 	my ($self, $output) = @_;
 4976: 
 4977: 	# Warn about suspicious combinations
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4978: 	if (defined $output->{type} && $output->{type} eq 'boolean' && !defined($output->{value})) {
 4979: 		$self->_log('  WARNING Boolean type without value - may want to set value: 1');
 4980: 	}
●4981 → 4981 → 4984 4981: 	if ($output->{value} && defined $output->{type} && $output->{type} ne 'boolean') {
 4982: 		$self->_log("  WARNING Value set but type is not boolean: $output->{type}");
 4983: 	}
●4984 → 4985 → 0 4984: 	my %valid_types = map { $_ => 1 } qw(string integer number boolean array arrayref hashref object void);
 4985: 	if(exists $output->{type}) {
 4986: 		if(!$valid_types{$output->{type}}) {
 4987: 			$self->_log("  WARNING Output value type is unknown: '$output->{type}', setting to string");
 4988: 			$output->{type} = 'string';
 4989: 		}
 4990: 	}
 4991: }
 4992: 
 4993: # --------------------------------------------------
 4994: # _parse_constraints
 4995: #
 4996: # Purpose:    Parse a constraint string extracted
 4997: #             from POD documentation and populate
 4998: #             min, max, or other constraint fields
 4999: #             in a parameter hashref.
 5000: #
 5001: # Entry:      $param      - hashref for the parameter
 5002: #                           being annotated (modified
 5003: #                           in place).
 5004: #             $constraint - the constraint string,

					

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

				
COND_INV_5004_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 5005: #                           e.g. '3-50', 'positive',

					

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

				
COND_INV_5005_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 5006: #                           '>= 0', 'min 3'.
 5007: #
 5008: # Exit:       Returns nothing. Modifies $param in
 5009: #             place by setting min and/or max keys.
 5010: #
 5011: # Side effects: Logs min/max values to stdout when
 5012: #               verbose is set.
 5013: # --------------------------------------------------
 5014: sub _parse_constraints {
●5015 → 5018 → 5058 5015: 	my ($self, $param, $constraint) = @_;
 5016: 
 5017: 	# Range: "3-50" or "1-100 chars"

					

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

				
COND_INV_5017_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 5018: 	if ($constraint =~ /(\d+)\s*-\s*(\d+)/) {
 5019: 		$param->{min} = $1;
 5020: 		$param->{max} = $2;

					

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

				
COND_INV_5020_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 5021: 	}
 5022: 	elsif ($constraint =~ /(\d+)\s*\.\.\s*(\d+)/) {
 5023: 		# Range: 0..19
 5024: 		$param->{min} = $1;
 5025: 		$param->{max} = $2;
 5026: 	}
 5027: 	# Minimum: "min 3" or "at least 5"
 5028: 	elsif ($constraint =~ /(?:min|minimum|at least)\s*(\d+)/i) {
 5029: 		$param->{min} = $1;
 5030: 	}
 5031: 	# Maximum: "max 50" or "up to 100"
 5032: 	elsif ($constraint =~ /(?:max|maximum|up to)\s*(\d+)/i) {
 5033: 		$param->{max} = $1;
 5034: 	}
 5035: 	# Positive
 5036: 	elsif ($constraint =~ /positive/i) {
 5037: 		$param->{min} = 1 if $param->{type} && $param->{type} eq 'integer';
 5038: 		$param->{min} = 0.01 if $param->{type} && $param->{type} eq 'number';
 5039: 	}
 5040: 	# Non-negative
 5041: 	elsif ($constraint =~ /non-negative/i) {
 5042: 		$param->{min} = 0;
 5043: 	} elsif($constraint =~ /^(\S+)\s+(.+)$/) {
 5044: 		my ($op, $val) = ($1, $2);
 5045: 		if(looks_like_number($val)) {
 5046: 			if ($op eq '<') {
 5047: 				$param->{max} = $val - 1;
 5048: 			} elsif ($op eq '<=') {
 5049: 				$param->{max} = $val;
 5050: 			} elsif ($op eq '>') {
 5051: 				$param->{min} = $val + 1;
 5052: 			} elsif ($op eq '>=') {
 5053: 				$param->{min} = $val;
 5054: 			}
 5055: 		}
 5056: 	}
 5057: 
●5058 → 5058 → 5061 5058: 	if(defined($param->{max})) {
 5059: 		$self->_log("  Set max to $param->{max}");
 5060: 	}
●5061 → 5061 → 0 5061: 	if(defined($param->{min})) {
 5062: 		$self->_log("  Set min to $param->{min}");
 5063: 	}
 5064: }
 5065: 
 5066: # --------------------------------------------------
 5067: # _analyze_code
 5068: #

					

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

				
COND_INV_5068_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 5069: # Purpose:    Analyse a method's source code using
 5070: #             pattern matching to infer parameter
 5071: #             names, types, constraints, defaults,
 5072: #             and optionality. Orchestrates all
 5073: #             per-parameter code analysis helpers.
 5074: #
 5075: # Entry:      $code   - method body source string.
 5076: #             $method - method hashref (used for
 5077: #                       constructor-specific logic
 5078: #                       when extracting parameters
 5079: #                       from @_ patterns).
 5080: #
 5081: # Exit:       Returns a hashref of parameter name
 5082: #             to parameter spec hashref, with as

					

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

				
COND_INV_5082_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 5083: #             much type and constraint information
 5084: #             as could be inferred from the code.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5085: #
 5086: # Side effects: Logs progress and warnings to stdout
 5087: #               when verbose is set.
 5088: #
 5089: # Notes:      Analysis is capped at max_parameters
 5090: #             to prevent runaway processing on
 5091: #             pathological methods. Falls back to
 5092: #             classic @_ extraction if signature
 5093: #             extraction found no parameters.
 5094: # --------------------------------------------------
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5095: sub _analyze_code {
●5096 → 5109 → 5119 5096: 	my ($self, $code, $method) = @_;
 5097: 
 5098: 	my %params;
 5099: 
 5100: 	# Safety check - limit parameter analysis to prevent runaway processing
 5101: 	my $param_count = 0;
 5102: 
 5103: 	# Extract parameter names from various signature styles
 5104: 	$self->_extract_parameters_from_signature(\%params, $code);
 5105: 
 5106: 	# Params::Get: get_params('key', \@_) passes the param name as a string,
 5107: 	# not as a $var in the signature, so run this unconditionally as a second
 5108: 	# pass after the early-returning signature parsers have finished.
 5109: 	if($code =~ /Params::Get/) {
 5110: 		my $pos = scalar keys %params;
  Mutants (Total: 4, Killed: 4, Survived: 0)
 5111: 		while($code =~ /get_params\s*\(\s*['"](\w+)['"]/g) {
 5112: 			my $name = $1;
 5113: 			next if $name =~ /^(self|class)$/i;
 5114: 			$params{$name} //= { _source => 'code', position => $pos++ };
 5115: 			$self->_log("  CODE: Found Params::Get parameter '$name'");
 5116: 		}
 5117: 	}
 5118: 
●5119 → 5122 → 5135 5119: 	$self->_extract_defaults_from_code(\%params, $code, $method);
 5120: 
 5121: 	# Infer types from defaults
 5122: 	foreach my $param (keys %params) {
 5123: 		if ($params{$param}{_default} && !$params{$param}{type}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5124: 			my $default = $params{$param}{_default};
 5125: 			if (ref($default) eq 'HASH') {
 5126: 				$params{$param}{type} = 'hashref';
 5127: 				$self->_log("  CODE: $param type inferred as hashref from default");
 5128: 			} elsif (ref($default) eq 'ARRAY') {
 5129: 				$params{$param}{type} = 'arrayref';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5130: 				$self->_log("  CODE: $param type inferred as arrayref from default");
 5131: 			}
 5132: 		}
 5133: 	}
 5134: 
●5135 → 5135 → 5150 5135: 	if($code =~ /(?:croak|die)\(.*\)\s+if\s*\(\s*scalar\(\@_\)\s*<\s*(\d+)\s*\)/s) {
 5136: 		my $required_count = $1;
 5137: 		my @param_names = sort { $params{$a}{position} <=> $params{$b}{position} } keys %params;
 5138: 		for my $i (0 .. $required_count-1) {
 5139: 			$params{$param_names[$i]}{optional} = 0;
 5140: 			$self->_log("  CODE: $param_names[$i] marked required due to croak scalar check");
 5141: 		}
 5142: 	} elsif ($code =~ /(?:croak|die)\(.*\)\s+if\s*\(\s*scalar\(\@_\)\s*==\s*0\s*\)/s) {
 5143: 		foreach my $param (keys %params) {
 5144: 			$params{$param}{optional} = 0;
 5145: 			$self->_log("  CODE: $param: all parameters are required due to 'scalar(@_) == 0' check");
 5146: 		}
 5147: 	}
 5148: 
 5149: 	# Analyze each parameter (with safety limit)
  Mutants (Total: 1, Killed: 1, Survived: 0)
●5150 → 5150 → 5219 5150: 	foreach my $param (keys %params) {
 5151: 		if ($param_count++ > $self->{max_parameters}) {

					

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

				
COND_INV_5151_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 5152: 			$self->_log("  WARNING: Max parameters ($self->{max_parameters}) exceeded, skipping remaining");
 5153: 			last;
 5154: 		}
 5155: 
 5156: 		my $p = \$params{$param};
 5157: 
 5158: 		$self->_analyze_parameter_type($p, $param, $code);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5159: 		$self->_analyze_parameter_constraints($p, $param, $code);
 5160: 		$self->_analyze_parameter_validation($p, $param, $code);
 5161: 		$self->_analyze_advanced_types($p, $param, $code);
 5162: 
 5163: 		# Defined checks
 5164: 		if ($code =~ /defined\s*\(\s*\$$param\s*\)/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5165: 			$$p->{optional} = 0;
 5166: 			$self->_log("  CODE: $param is required (defined check)");
 5167: 		}
 5168: 
 5169: 		# Determine optional/required and numeric type from code
 5170: 		if ($code =~ /\s*\$$param\s*(?:\/\/|\|\|)=/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5171: 			# e.g. $var //= 5; or $var ||= 5;
 5172: 			$$p->{optional} = 1;
 5173: 			$self->_log("  CODE: $param is optional (default value assigned in code)");
 5174: 		} elsif ($code =~ /\s*\$$param\s*(?:[\+\-\*\%]|\/(?!\/)|(?:\+\+)|(?:--)|(?:[\+\-\*\%]=|\/(?!\/)=)|\+\$|\$[+-])/ ) {
 5175: 			# Covers arithmetic usage:
 5176: 			# $x + $param, $param++, $param--, $x += $param, $x -= $param, etc.
 5177: 			$$p->{optional} = 0;
 5178: 			$$p->{type} //= 'number';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 5179: 			$self->_log("  CODE: $param is required (used in arithmetic context)");
 5180: 		} elsif ($code =~ /\$\b$param\b\s*(?:\+0|\*1)/) {
 5181: 			# Forces numeric context, e.g., "$param + 0" or "$param * 1"
 5182: 			$$p->{optional} = 0;
 5183: 			$$p->{type} //= 'number';
 5184: 			$self->_log("  CODE: $param is required (numeric context)");
 5185: 		}
 5186: 
 5187: 		# Required parameter checks (undef causes error)
 5188: 
 5189: 		# Style 1: block form
 5190: 		if ($code =~ /if\s*\(\s*!\s*defined\s*\(\s*\$$param\s*\)\s*\)\s*\{([^}]+)\}/s) {
 5191: 			my $block = $1;
 5192: 			if ($block =~ /\b(croak|die|confess)\b/) {
 5193: 				$$p->{optional} = 0;
 5194: 				$self->_log("  CODE: $param is required (undef causes error)");
 5195: 			}
 5196: 		}
 5197: 
 5198: 		# Style 2: postfix unless
 5199: 		if ($code =~ /\b(croak|die|confess)\b[^;]*\bunless\s+defined\s*\(\s*\$$param\s*\)/) {
 5200: 			$$p->{optional} = 0;
 5201: 			$self->_log("  CODE: $param is required (postfix undef check)");
 5202: 		}
 5203: 
 5204: 		# Exists checks for hash keys
 5205: 		if ($code =~ /exists\s*\(\s*\$$param\s*\)/) {
 5206: 			$$p->{type} = 'hashkey';
 5207: 			$self->_log("  CODE: $param is a hash key");
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5208: 		}
 5209: 
 5210: 		# Scalar context for arrays
 5211: 		if ($code =~ /scalar\s*\(\s*\@?\$$param\s*\)/) {
 5212: 			$$p->{type} = 'array';
 5213: 			$self->_log("  CODE: $param used in scalar context (array)");
 5214: 		}
 5215: 
 5216: 		$self->_extract_error_constraints($p, $param, $code);
 5217: 	}
 5218: 
 5219: 	return \%params;
 5220: }
 5221: 
 5222: # --------------------------------------------------
 5223: # _analyze_parameter_type
 5224: #
 5225: # Purpose:    Infer the type of a single parameter
 5226: #             from ref() checks, isa() calls,

					

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

				
COND_INV_5226_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 5227: #             bless patterns, array/hash operations,
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5228: #             and numeric operator usage in the
 5229: #             method body.
 5230: #
 5231: # Entry:      $p_ref - reference to the parameter
 5232: #                      hashref (modified in place
 5233: #                      via the referenced hash).
 5234: #             $param - parameter name string.
 5235: #             $code  - method body source string.

					

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

				
COND_INV_5235_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 5236: #
 5237: # Exit:       Returns nothing. Modifies the
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5238: #             referenced parameter hashref.
 5239: #
 5240: # Side effects: Logs detections to stdout when
 5241: #               verbose is set.
 5242: # --------------------------------------------------
 5243: sub _analyze_parameter_type {
●5244 → 5248 → 5267 5244: 	my ($self, $p_ref, $param, $code) = @_;
 5245: 	my $p = $$p_ref;
 5246: 
 5247: 	# Type inference from ref() checks
 5248: 	if ($code =~ /ref\s*\(\s*\$$param\s*\)\s*eq\s*['"](ARRAY|HASH|SCALAR)['"]/gi) {
 5249: 		my $reftype = lc($1);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5250: 		$p->{type} = $reftype eq 'array' ? 'arrayref' :
 5251: 					 $reftype eq 'hash' ? 'hashref' :
 5252: 					 'scalar';
 5253: 		$self->_log("  CODE: $param is $p->{type} (ref check)");
 5254: 	}
 5255: 	# ISA checks for objects
 5256: 	elsif ($code =~ /\$$param\s*->\s*isa\s*\(\s*['"]([^'"]+)['"]\s*\)/i) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5257: 		$p->{type} = 'object';
 5258: 		$p->{isa} = $1;
 5259: 		$self->_log("  CODE: $param is object of class $1");
 5260: 	}
 5261: 	# Blessed references
 5262: 	elsif ($code =~ /bless\s+.*\$$param/) {
 5263: 		$p->{type} = 'object';
 5264: 		$self->_log("  CODE: $param is blessed object");
 5265: 	}
 5266: 	# Array/hash operations
●5267 → 5267 → 5276 5267: 	if (!$p->{type}) {
 5268: 		if ($code =~ /\@\{\s*\$$param\s*\}/ || $code =~ /push\s*\(\s*\@?\$$param/) {
 5269: 			$p->{type} = 'arrayref';
 5270: 		} elsif ($code =~ /\%\{\s*\$$param\s*\}/ || $code =~ /\$$param\s*->\s*\{/) {
 5271: 			$p->{type} = 'hashref';
 5272: 		}
 5273: 	}
 5274: 
 5275: 	# Infer type from the default value if type is unknown
●5276 → 5276 → 5290 5276: 	if (!$p->{type} && exists $p->{_default}) {
 5277: 		my $default = $p->{_default};
 5278: 		if (ref($default) eq 'HASH') {
 5279: 			$p->{type} = 'hashref';
 5280: 			$self->_log("  CODE: $param type inferred as hashref from default");
 5281: 		} elsif (ref($default) eq 'ARRAY') {
 5282: 			$p->{type} = 'arrayref';
 5283: 			$self->_log("  CODE: $param type inferred as arrayref from default");
 5284: 		}
 5285: 	}
 5286: 
 5287: 	# ------------------------------------------------------------
 5288: 	# Heuristic numeric inference (low confidence)
 5289: 	# ------------------------------------------------------------
●5290 → 5290 → 0 5290: 	if (!$p->{type}) {
 5291: 		# An explicit looks_like_number($param) check is a direct
 5292: 		# numeric-type assertion by the author, stronger evidence than
 5293: 		# incidental arithmetic adjacency (e.g. $param is only ever
 5294: 		# used inside a defined-or default before the arithmetic, so
 5295: 		# the arithmetic-operator check below never sees $param itself
 5296: 		# next to an operator).
 5297: 		if ($code =~ /\blooks_like_number\s*\(\s*\$$param\s*\)/) {
 5298: 			$p->{type} = 'number';
 5299: 			$p->{_type_confidence} = 'heuristic';
 5300: 			$self->_log("  CODE: $param inferred as number (looks_like_number check)");
 5301: 		}
 5302: 		# Numeric operators: + - * / % **
 5303: 		# Use \/(?!\/) to exclude // (defined-or) from matching as division.
 5304: 		elsif (
 5305: 			$code =~ /\$$param\s*(?:[\+\-\*\%]|\/(?!\/))/ ||
 5306: 			$code =~ /(?:[\+\-\*\%]|\/(?!\/))\s*\$$param/ ||
 5307: 			$code =~ /\bint\s*\(\s*\$$param\s*\)/ ||
 5308: 			$code =~ /\babs\s*\(\s*\$$param\s*\)/
 5309: 		) {
 5310: 			$p->{type} = 'number';
 5311: 			$p->{_type_confidence} = 'heuristic';
 5312: 			$self->_log("  CODE: $param inferred as number (numeric operator)");
 5313: 		}
 5314: 		# Numeric comparison
 5315: 		elsif (
 5316: 			$code =~ /\$$param\s*(?:==|!=|<=|>=|<|>)/ ||
 5317: 			$code =~ /(?:==|!=|<=|>=|<|>)\s*\$$param/
 5318: 		) {
 5319: 			$p->{type} = 'number';
 5320: 			$p->{_type_confidence} = 'heuristic';
 5321: 			$self->_log("  CODE: $param inferred as number (numeric comparison)");
 5322: 		}
 5323: 	}
 5324: }
 5325: 
 5326: # --------------------------------------------------
 5327: # _analyze_advanced_types
 5328: #
 5329: # Purpose:    Apply enhanced type detection to a
 5330: #             single parameter, checking for
 5331: #             DateTime objects, file handles,
 5332: #             coderefs, and enum-like constraints
 5333: #             beyond what basic type inference
 5334: #             can determine.
 5335: #
 5336: # Entry:      $p_ref - reference to the parameter
 5337: #                      hashref (modified in place
 5338: #                      via the referenced hash).
 5339: #             $param - the parameter name string.
 5340: #             $code  - method body source string.
 5341: #
 5342: # Exit:       Returns nothing. Modifies the
 5343: #             referenced parameter hashref in place.
 5344: #
 5345: # Side effects: Logs detections to stdout when
 5346: #               verbose is set.
 5347: #
 5348: # Notes:      Delegates to four specialised
 5349: #             detectors: _detect_datetime_type,
 5350: #             _detect_filehandle_type,
 5351: #             _detect_coderef_type, and
 5352: #             _detect_enum_type. Each detector
 5353: #             returns early on first match so
 5354: #             detectors are implicitly prioritised
 5355: #             in that order.
 5356: # --------------------------------------------------
 5357: sub _analyze_advanced_types {
 5358: 	my ($self, $p_ref, $param, $code) = @_;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5359: 
 5360: 	# Dereference once to get the hash reference
 5361: 	my $p = $$p_ref;
 5362: 
 5363: 	# Now pass the dereferenced hash to the detection methods
 5364: 	$self->_detect_datetime_type($p, $param, $code);
 5365: 	$self->_detect_filehandle_type($p, $param, $code);
 5366: 	$self->_detect_coderef_type($p, $param, $code);
 5367: 	$self->_detect_enum_type($p, $param, $code);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5368: }
 5369: 
 5370: # --------------------------------------------------
 5371: # _detect_datetime_type
 5372: #
 5373: # Purpose:    Detect DateTime objects, Time::Piece
 5374: #             objects, date strings, ISO 8601
 5375: #             strings, and UNIX timestamps by
 5376: #             analysing code patterns involving
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5377: #             the parameter.
 5378: #
 5379: # Entry:      $p     - parameter hashref (modified
 5380: #                      in place).
 5381: #             $param - parameter name string.
 5382: #             $code  - method body source string.
 5383: #
 5384: # Exit:       Returns nothing. Modifies $p in place,
 5385: #             setting type, isa, semantic, min,
 5386: #             matches, and/or format keys.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5387: #             Returns immediately on first match.
 5388: #
 5389: # Side effects: Logs detections to stdout when
 5390: #               verbose is set.
 5391: # --------------------------------------------------
 5392: sub _detect_datetime_type {
●5393 → 5399 → 5408 5393: 	my ($self, $p, $param, $code) = @_;
 5394: 
 5395: 	# Validate param is just a simple word
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5396: 	return unless defined $param && $param =~ /^\w+$/;
 5397: 
 5398: 	# DateTime object detection via isa/UNIVERSAL checks
 5399: 	if ($code =~ /\$$param\s*->\s*isa\s*\(\s*['"]DateTime['"]\s*\)/i) {
 5400: 		$p->{type} = 'object';
 5401: 		$p->{isa} = 'DateTime';
 5402: 		$p->{semantic} = 'datetime_object';
 5403: 		$self->_log("  ADVANCED: $param is DateTime object");
 5404: 		return;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5405: 	}
 5406: 
 5407: 	# Check for DateTime method calls
●5408 → 5408 → 5417 5408: 	if ($code =~ /\$$param\s*->\s*(ymd|dmy|mdy|hms|iso8601|epoch|strftime)/) {
 5409: 		$p->{type} = 'object';
 5410: 		$p->{isa} = 'DateTime';
 5411: 		$p->{semantic} = 'datetime_object';
 5412: 		$self->_log("  ADVANCED: $param uses DateTime methods");
 5413: 		return;
 5414: 	}
 5415: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5416: 	# Time::Piece detection
●5417 → 5417 → 5427 5417: 	if ($code =~ /\$$param\s*->\s*isa\s*\(\s*['"]Time::Piece['"]\s*\)/i ||
 5418: 	    $code =~ /\$$param\s*->\s*(strftime|epoch|year|mon|mday)/) {
 5419: 		$p->{type} = 'object';
 5420: 		$p->{isa} = 'Time::Piece';
 5421: 		$p->{semantic} = 'timepiece_object';
 5422: 		$self->_log("  ADVANCED: $param is Time::Piece object");
 5423: 		return;
 5424: 	}
 5425: 
 5426: 	# String date/time patterns via regex matching
●5427 → 5427 → 5436 5427: 	if ($code =~ /\$$param\s*=~\s*\/.*?\\d\{4\}.*?\\d\{2\}.*?\\d\{2\}/) {
 5428: 		$p->{type} = 'string';
 5429: 		$p->{semantic} = 'date_string';
 5430: 		$p->{format} = 'YYYY-MM-DD or similar';
 5431: 		$self->_log("  ADVANCED: $param validated as date string pattern");
 5432: 		return;
 5433: 	}
 5434: 
 5435: 	# ISO 8601 date pattern
●5436 → 5436 → 5445 5436: 	if ($code =~ /\$$param\s*=~\s*\/.*?[Tt].*?[Zz].*?\//) {
 5437: 		$p->{type} = 'string';
 5438: 		$p->{semantic} = 'iso8601_string';
 5439: 		$p->{matches} = '/^\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}Z?$/';
 5440: 		$self->_log("  ADVANCED: $param validated as ISO 8601 datetime");
 5441: 		return;
 5442: 	}
 5443: 
 5444: 	# UNIX timestamp detection (numeric with specific range)
●5445 → 5445 → 5456 5445: 	if ($code =~ /\$$param\s*>\s*\d{9,}/ || # UNIX timestamps are 10+ digits
 5446: 	    $code =~ /time\(\s*\)\s*-\s*\$$param/ ||
 5447: 	    $code =~ /\$$param\s*-\s*time\(\s*\)/) {
 5448: 		$p->{type} = 'integer';
 5449: 		$p->{semantic} = 'unix_timestamp';
 5450: 		$p->{min} = 0;
 5451: 		$self->_log("  ADVANCED: $param appears to be UNIX timestamp");
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5452: 		return;
 5453: 	}
 5454: 
 5455: 	# Date parsing with strptime or similar
●5456 → 5456 → 0 5456: 	if ($code =~ /strptime\s*\(\s*\$$param/ ||
 5457: 	    $code =~ /DateTime::Format::\w+\s*->\s*parse_datetime\s*\(\s*\$$param/) {
 5458: 		$p->{type} = 'string';
 5459: 		$p->{semantic} = 'datetime_parseable';
 5460: 		$self->_log("  ADVANCED: $param is parsed as datetime");
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5461: 		return;
 5462: 	}
 5463: }
 5464: 
 5465: # --------------------------------------------------
 5466: # _detect_filehandle_type
 5467: #
 5468: # Purpose:    Detect file handle parameters and
 5469: #             file path string parameters by
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5470: #             analysing I/O operations, file test
 5471: #             operators, and path manipulation
 5472: #             patterns involving the parameter.
 5473: #
 5474: # Entry:      $p     - parameter hashref (modified
 5475: #                      in place).
 5476: #             $param - parameter name string.
 5477: #             $code  - method body source string.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5478: #
 5479: # Exit:       Returns nothing. Modifies $p in place,
 5480: #             setting type, isa, and semantic keys.
 5481: #             Returns immediately on first match.
 5482: #
 5483: # Side effects: Logs detections to stdout when
 5484: #               verbose is set.
 5485: # --------------------------------------------------
 5486: sub _detect_filehandle_type {
●5487 → 5492 → 5501 5487: 	my ($self, $p, $param, $code) = @_;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5488: 
 5489: 	return unless defined $param && $param =~ /^\w+$/;
 5490: 
 5491: 	# File handle operations
 5492: 	if ($code =~ /(?:open|close|read|print|say|sysread|syswrite)\s*\(?\s*\$$param/) {
 5493: 		$p->{type} = 'object';
 5494: 		$p->{isa} = 'IO::Handle';
 5495: 		$p->{semantic} = 'filehandle';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5496: 		$self->_log("  ADVANCED: $param is a file handle");
 5497: 		return;
 5498: 	}
 5499: 
 5500: 	# Filehandle-specific operations
●5501 → 5501 → 5510 5501: 	if ($code =~ /\$$param\s*->\s*(readline|getline|print|say|close|flush|autoflush)/) {
 5502: 		$p->{type} = 'object';
 5503: 		$p->{isa} = 'IO::Handle';
 5504: 		$p->{semantic} = 'filehandle';
 5505: 		$self->_log("  ADVANCED: $param uses filehandle methods");
 5506: 		return;
 5507: 	}
 5508: 
 5509: 	# File test operators
●5510 → 5510 → 5518 5510: 	if ($code =~ /(?:-[frwxoOeszlpSbctugkTBMAC])\s+\$$param/) {
 5511: 		$p->{type} = 'string';
 5512: 		$p->{semantic} = 'filepath';
 5513: 		$self->_log("  ADVANCED: $param is tested as file path");
 5514: 		return;
 5515: 	}
 5516: 
 5517: 	# File::Spec operations or path manipulation
●5518 → 5518 → 5528 5518: 	if ($code =~ /File::(?:Spec|Basename)::\w+\s*\(\s*\$$param/ ||
 5519: 	    $code =~ /(?:basename|dirname|fileparse)\s*\(\s*\$$param/) {
 5520: 		$p->{type} = 'string';
 5521: 		$p->{semantic} = 'filepath';
 5522: 		$self->_log("  ADVANCED: $param manipulated as file path");
 5523: 		return;
 5524: 	}
 5525: 
 5526: 	# Path validation patterns
 5527: 	# Only match a literal path assigned or defaulted to this variable
●5528 → 5528 → 5536 5528: 	if(defined $p->{_default} && $p->{_default} =~ m{^([A-Za-z]:\\|/|\./|\.\./)}) {
 5529: 		$p->{type} = 'string';
 5530: 		$p->{semantic} = 'filepath';
 5531: 		$self->_log("  ADVANCED: $param default looks like a path");
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5532: 		return;
 5533: 	}
 5534: 
 5535: 	# IO::File detection
●5536 → 5536 → 0 5536: 	if ($code =~ /\$$param\s*->\s*isa\s*\(\s*['"]IO::File['"]\s*\)/ ||
 5537: 	    $code =~ /IO::File\s*->\s*new\s*\(\s*\$$param/) {
 5538: 		$p->{type} = 'object';
 5539: 		$p->{isa} = 'IO::File';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5540: 		$p->{semantic} = 'filehandle';
 5541: 		$self->_log("  ADVANCED: $param is IO::File object");
 5542: 		return;
 5543: 	}
 5544: }
 5545: 
 5546: # --------------------------------------------------
 5547: # _detect_coderef_type
 5548: #
 5549: # Purpose:    Detect coderef and callback parameters
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5550: #             by analysing ref() checks, invocation
 5551: #             patterns, and parameter naming
 5552: #             conventions.
 5553: #
 5554: # Entry:      $p     - parameter hashref (modified
 5555: #                      in place).
 5556: #             $param - parameter name string.
 5557: #             $code  - method body source string.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5558: #
 5559: # Exit:       Returns nothing. Modifies $p in place,
 5560: #             setting type and semantic keys.
 5561: #             Returns immediately on first match.
 5562: #
 5563: # Side effects: Logs detections to stdout when
 5564: #               verbose is set.
 5565: # --------------------------------------------------
 5566: sub _detect_coderef_type {
●5567 → 5572 → 5580 5567: 	my ($self, $p, $param, $code) = @_;
 5568: 
 5569: 	return unless defined $param && $param =~ /^\w+$/;
 5570: 
 5571: 	# ref() check for CODE
 5572: 	if ($code =~ /ref\s*\(\s*\$$param\s*\)\s*eq\s*['"]CODE['"]/i) {
 5573: 		$p->{type} = 'coderef';
 5574: 		$p->{semantic} = 'callback';
 5575: 		$self->_log("  ADVANCED: $param is coderef (ref check)");
 5576: 		return;
 5577: 	}
 5578: 
 5579: 	# Invocation as coderef - note the escaped @ in \@_
●5580 → 5580 → 5590 5580: 	if ($code =~ /\$$param\s*->\s*\(/ ||
 5581: 	    $code =~ /\$$param\s*->\s*\(\s*\@_\s*\)/ ||
 5582: 	    $code =~ /&\s*\{\s*\$$param\s*\}/) {
 5583: 		$p->{type} = 'coderef';
 5584: 		$p->{semantic} = 'callback';
 5585: 		$self->_log("  ADVANCED: $param invoked as coderef");
 5586: 		return;
 5587: 	}
 5588: 
 5589: 	# Parameter name suggests callback
●5590 → 5590 → 5598 5590: 	if ($param =~ /^(?:callback|cb|handler|sub|code|fn|func|on_\w+)$/i) {
 5591: 		$p->{type} = 'coderef';
 5592: 		$p->{semantic} = 'callback';
 5593: 		$self->_log("  ADVANCED: $param name suggests coderef");
 5594: 		return;
 5595: 	}
 5596: 
 5597: 	# Blessed coderef (unusual but valid)
●5598 → 5598 → 0 5598: 	if ($code =~ /blessed\s*\(\s*\$$param\s*\)/ &&
 5599: 	    $code =~ /ref\s*\(\s*\$$param\s*\)\s*eq\s*['"]CODE['"]/i) {
 5600: 		$p->{type} = 'object';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5601: 		$p->{isa} = 'blessed_coderef';
 5602: 		$p->{semantic} = 'callback';
 5603: 		$self->_log("  ADVANCED: $param is blessed coderef");
 5604: 		return;
 5605: 	}
 5606: }
 5607: 
 5608: # --------------------------------------------------
 5609: # _detect_enum_type
 5610: #
 5611: # Purpose:    Detect enum-like parameters whose
 5612: #             valid values are a fixed set, by
 5613: #             analysing validation patterns
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5614: #             including regex alternations, hash
 5615: #             lookups, grep checks, given/when,
 5616: #             if/elsif chains, and smart match.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5617: #
 5618: # Entry:      $p     - parameter hashref (modified
 5619: #                      in place).
 5620: #             $param - parameter name string.
 5621: #             $code  - method body source string.
 5622: #
 5623: # Exit:       Returns nothing. Modifies $p in place,
 5624: #             setting type, enum, and semantic keys.
 5625: #             Returns immediately on first match.
 5626: #
 5627: # Side effects: Logs detections to stdout when
 5628: #               verbose is set.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5629: #
 5630: # Notes:      Requires at least 3 if/elsif branches
 5631: #             for pattern 5 to avoid false positives
 5632: #             from ordinary conditional code.
 5633: # --------------------------------------------------
 5634: sub _detect_enum_type {
●5635 → 5641 → 5654 5635: 	my ($self, $p, $param, $code) = @_;
 5636: 
 5637: 	return unless defined $param && $param =~ /^\w+$/;
 5638: 
 5639: 	# Pattern 1: die/croak unless value is in list
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5640: 	# die 'Invalid status' unless $status =~ /^(active|inactive|pending)$/;
 5641: 	if ($code =~ /unless\s+\$$param\s*=~\s*\/\^?\(([^)]+)\)/) {
 5642: 		my $values = $1;
 5643: 		my @enum_values = split(/\|/, $values);
 5644: 		$p->{type} = 'string' unless $p->{type};
  Mutants (Total: 4, Killed: 4, Survived: 0)
 5645: 		$p->{enum} = \@enum_values;
 5646: 		$p->{semantic} = 'enum';
 5647: 		$self->_log("  ADVANCED: $param is enum with values: " . join(', ', @enum_values));
 5648: 		return;
 5649: 	}
 5650: 
 5651: 	# Pattern 2: Hash lookup for validation
 5652: 	# my %valid = map { $_ => 1 } qw(red green blue);
 5653: 	# die unless $valid{$param};
●5654 → 5654 → 5669 5654: 	if ($code =~ /\%(\w+)\s*=.*?qw\s*[\(\[<{]([^)\]>}]+)[\)\]>}]/) {
 5655: 		my $hash_name = $1;
 5656: 		my $values_str = $2;
 5657: 		if (defined $values_str && $code =~ /\$$hash_name\s*\{\s*\$$param\s*\}/) {
 5658: 			my @enum_values = split(/\s+/, $values_str);
 5659: 			$p->{type} = 'string' unless $p->{type};
 5660: 			$p->{enum} = \@enum_values;
 5661: 			$p->{semantic} = 'enum';
 5662: 			$self->_log("  ADVANCED: $param validated via hash lookup: " . join(', ', @enum_values));

					

					
Mutants (Total: 4, Killed: 1, Survived: 3)
					

				
NUM_BOUNDARY_5662_17_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_5662_17_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_5662_17_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 5663: 			return;
 5664: 		}
 5665: 	}
 5666: 
 5667: 	# Pattern 3: Array grep validation
 5668: 	# die unless grep { $_ eq $param } qw(foo bar baz);
●5669 → 5669 → 5680 5669: 	if ($code =~ /grep\s*\{[^}]*\$$param[^}]*\}\s*qw\s*[\(\[<{]([^)\]>}]+)[\)\]>}]/) {
 5670: 		my $values_str = $1;
 5671: 		my @enum_values = split(/\s+/, $values_str);
 5672: 		$p->{type} = 'string' unless $p->{type};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5673: 		$p->{enum} = \@enum_values;
 5674: 		$p->{semantic} = 'enum';
 5675: 		$self->_log("  ADVANCED: $param validated via grep: " . join(', ', @enum_values));
 5676: 		return;

					

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

				
COND_INV_5676_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 5677: 	}
 5678: 
 5679: 	# Pattern 4: Given/when (Perl 5.10+)
●5680 → 5680 → 5696 5680: 	if ($code =~ /given\s*\(\s*\$$param\s*\)/) {
 5681: 		my @enum_values;

					

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

				
COND_INV_5681_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 5682: 		while ($code =~ /when\s*\(\s*['"]([^'"]+)['"]\s*\)/g) {
 5683: 			push @enum_values, $1;
 5684: 		}
 5685: 		if (@enum_values >= 2) {
 5686: 			$p->{type} = 'string' unless $p->{type};
 5687: 			$p->{enum} = \@enum_values;
 5688: 			$p->{semantic} = 'enum';
 5689: 			$self->_log("  ADVANCED: $param has enum values from given/when: " .
 5690: 			           join(', ', @enum_values));
 5691: 			return;
 5692: 		}
 5693: 	}
 5694: 
 5695: 	# Pattern 5: Multiple if/elsif checking specific values
●5696 → 5697 → 5700 5696: 	my @if_values;
 5697: 	while ($code =~ /if\s*\(\s*\$$param\s*eq\s*['"]([^'"]+)['"]\s*\)/g) {
 5698: 		push @if_values, $1;
 5699: 	}
●5700 → 5700 → 5703 5700: 	while ($code =~ /elsif\s*\(\s*\$$param\s*eq\s*['"]([^'"]+)['"]\s*\)/g) {
 5701: 		push @if_values, $1;
 5702: 	}
●5703 → 5703 → 5713 5703: 	if (@if_values >= 3) {
 5704: 		$p->{type} = 'string' unless $p->{type};
 5705: 		$p->{enum} = \@if_values;
 5706: 		$p->{semantic} = 'enum';
 5707: 		$self->_log("  ADVANCED: $param appears to be enum from if/elsif: " .
 5708: 		           join(', ', @if_values));
 5709: 		return;
 5710: 	}
 5711: 
 5712: 	# Pattern 6: Smart match (~~) with array
●5713 → 5713 → 0 5713: 	if ($code =~ /\$$param\s*~~\s*\[([^\]]+)\]/ ||
 5714: 	    $code =~ /\$$param\s*~~\s*qw\s*[\(\[<{]([^)\]>}]+)[\)\]>}]/) {
 5715: 		my $values_str = $1;
 5716: 		my @enum_values;
 5717: 		if ($values_str =~ /['"]/) {
 5718: 			@enum_values = $values_str =~ /['"](.*?)['"]/g;
 5719: 		} else {
 5720: 			@enum_values = split(/\s+/, $values_str);
 5721: 		}
 5722: 		if (@enum_values) {
 5723: 			$p->{type} = 'string' unless $p->{type};
 5724: 			$p->{enum} = \@enum_values;
 5725: 			$p->{semantic} = 'enum';
 5726: 			$self->_log("  ADVANCED: $param validated with smart match: " .
 5727: 				   join(', ', @enum_values));
 5728: 			return;
 5729: 		}
 5730: 	}
 5731: }
 5732: 
 5733: # --------------------------------------------------
 5734: # _extract_error_constraints
 5735: #
 5736: # Purpose:    Extract invalid-value constraints and
 5737: #             error messages from die/croak patterns
 5738: #             referencing a specific parameter, and
 5739: #             infer numeric bounds from comparisons
 5740: #             with literals.
 5741: #
 5742: # Entry:      $p_ref - reference to the parameter
 5743: #                      hashref (modified in place).
 5744: #             $param - parameter name string.
 5745: #             $code  - method body source string.
 5746: #
 5747: # Exit:       Returns nothing. May add _invalid,
 5748: #             _errors, min, and/or max to the
 5749: #             referenced parameter hashref.
 5750: #
 5751: # Side effects: Logs detections to stdout when
 5752: #               verbose is set.

					

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

				
COND_INV_5752_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 5753: # --------------------------------------------------
 5754: sub _extract_error_constraints {
●5755 → 5758 → 5814 5755: 	my ($self, $p, $param, $code) = @_;
 5756: 
 5757: 	# Look for die/croak/confess with a condition involving this param
 5758: 	while ($code =~ /
 5759: 		(?:die|croak|confess)       # error call
 5760: 		\s*
 5761: 		(?:
 5762: 			["']([^"']+)["']        # captured error message
 5763: 		|
 5764: 			q[qw]?\s*[\(\[]([^)\]]+)[\)\]]  # q(), qq(), qw()
 5765: 		)?
 5766: 		\s*
 5767: 		if\s+
 5768: 		(.+?)                      # condition
 5769: 		\s*;
 5770: 	/gsx) {
 5771: 
 5772: 		my $message = $1 || $2;
 5773: 		my $condition = $3;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5774: 
 5775: 		# Only keep conditions that reference this parameter
 5776: 		next unless $condition =~ /\$$param\b/;
 5777: 
 5778: 		# Initialize storage
 5779: 		$$p->{_invalid} ||= [];
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5780: 		$$p->{_errors}  ||= [];
 5781: 
 5782: 		# Normalize condition (strip surrounding parens)
 5783: 		$condition =~ s/^\(|\)$//g;
 5784: 		$condition =~ s/\s+/ /g;
 5785: 
 5786: 		# Try to extract a meaningful invalid constraint
 5787: 		my $constraint;
 5788: 
 5789: 		# Examples:
 5790: 		#   $age <= 0
 5791: 		#   $x eq ''
 5792: 		#   length($s) < 3
 5793: 		if ($condition =~ /\$$param\s*([!<>=]=?|eq|ne|lt|gt|le|ge)\s*(.+)/) {
 5794: 			$constraint = "$1 $2";
 5795: 		}
 5796: 		elsif ($condition =~ /length\s*\(\s*\$$param\s*\)\s*([<>=!]+)\s*(\d+)/) {
 5797: 			$constraint = "length $1 $2";
 5798: 		}
 5799: 		elsif ($condition =~ /\$$param\s*==\s*0/) {
 5800: 			$constraint = '== 0';
 5801: 		}
 5802: 
 5803: 		# Store results
 5804: 		push @{ $$p->{_invalid} }, $constraint if $constraint;
 5805: 		push @{ $$p->{_errors}  }, $message if defined $message;
 5806: 
 5807: 		$self->_log(
 5808: 			"  ERROR: $param invalid when [$condition]" .
 5809: 			(defined $message ? " => '$message'" : '')
 5810: 		);
 5811: 	}
 5812: 
 5813: 	# Numeric comparison with literal
●5814 → 5814 → 0 5814: 	if ($code =~ /\b\Q$param\E\s*(<=|<|>=|>)\s*(-?\d+)/) {
 5815: 		my ($op, $num) = ($1, $2);
 5816: 
 5817: 		# Mark required
 5818: 		$$p->{optional} = 0;
 5819: 
 5820: 		if ($op eq '<=') {
 5821: 			$$p->{min} = $num + 1;
 5822: 		} elsif ($op eq '<') {
 5823: 			$$p->{min} = $num;
 5824: 		} elsif ($op eq '>=') {
 5825: 			$$p->{max} = $num - 1;
 5826: 		} elsif ($op eq '>') {
 5827: 			$$p->{max} = $num;
 5828: 		}
 5829: 
 5830: 		$self->_log("  ERROR: $param normalized constraint from '$op $num'");
 5831: 	}
 5832: }
 5833: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5834: # --------------------------------------------------
 5835: # _extract_parameters_from_signature
 5836: #
 5837: # Purpose:    Extract parameter names and positions
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5838: #             from a method's signature, trying
 5839: #             modern Perl subroutine signatures
 5840: #             first and falling back to traditional
 5841: #             @_ extraction styles.
 5842: #
 5843: # Entry:      $params - hashref to populate with
 5844: #                       parameter specs (modified
 5845: #                       in place).
 5846: #             $code   - method body source string.
 5847: #
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5848: # Exit:       Returns nothing. Populates $params.
 5849: #
 5850: # Side effects: Logs detections to stdout when
 5851: #               verbose is set.
 5852: #
 5853: # Notes:      Three traditional styles are
 5854: #             supported: (1) my ($self, ...) = @_,
 5855: #             (2) my $self = shift; my $x = shift,
 5856: #             (3) my $x = $_[N]. $self and $class
 5857: #             are always excluded from the returned
 5858: #             parameters.
 5859: # --------------------------------------------------
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5860: sub _extract_parameters_from_signature {
●5861 → 5874 → 5888 5861: 	my ($self, $params, $code) = @_;
 5862: 
 5863: 	# Modern Style: Subroutine signatures with attributes
 5864: 	# Handle multi-line signatures
 5865: 	# sub foo :attr1 :attr2(val) (
 5866: 	#     $self,
 5867: 	#     $x :Type,
 5868: 	#     $y = default
 5869: 	# ) { }
 5870: 
 5871: 	# Try to match signature after attributes
 5872: 	# Look for the parameter list - it's the last (...) before the opening brace
 5873: 	# that contains sigils ($, %, @)
 5874: 	if ($code =~ /sub\s+\w+\s*(?::\w+(?:\([^)]*\))?\s*)*\(((?:[^()]|\([^)]*\))*)\)\s*\{/s) {
 5875: 		my $potential_sig = $1;
 5876: 
 5877: 		# Check if this looks like parameters (has sigils)
 5878: 		if ($potential_sig =~ /[\$\%\@]/) {
 5879: 			$self->_log("  SIG: Found modern signature: ($potential_sig)");
 5880: 			$self->_parse_modern_signature($params, $potential_sig);
 5881: 			return;
 5882: 		}
 5883: 	}
 5884: 
 5885: 	# Direct-index style: my $self = $_[0];  my $arg = $_[1]; ...
 5886: 	# Must be checked before Style 1 to avoid matching @_ inside closures
 5887: 	# defined in the body of a method that uses this style.
●5888 → 5888 → 5900 5888: 	if($code =~ /my\s+\$(?:self|class)\s*=\s*\$_\[0\]/) {
 5889: 		my $pos = 0;
 5890: 		while($code =~ /my\s+\$(\w+)\s*=\s*\$_\[(\d+)\]/g) {
 5891: 			my $name = $1;
 5892: 			next if $name =~ /^(self|class)$/i;
 5893: 			$params->{$name} //= { _source => 'code', optional => 1, position => $pos++ };

					

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

				
COND_INV_5893_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 5894: 			$self->_log("  CODE: Found direct-index parameter '\$$name' at \$_[$2]");
 5895: 		}
 5896: 		return;
 5897: 	}
 5898: 
 5899: 	# Traditional Style 1: my ($self, $arg1, $arg2) = @_;
●5900 → 5900 → 5934 5900: 	if ($code =~ /my\s*\(\s*([^)]+)\)\s*=\s*\@_/s) {
 5901: 		my $sig = $1;
 5902: 		my $pos = 0;
 5903: 
 5904: 		while ($sig =~ /\$(\w+)/g) {
 5905: 			my $name = $1;
 5906: 

					

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

				
COND_INV_5906_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 5907: 			next if $name =~ /^(self|class)$/i;
 5908: 
 5909: 			$params->{$name} //= {
 5910: 				_source => 'code',
 5911: 				optional => 1,
 5912: 			};
 5913: 
 5914: 			$params->{$name}{position} = $pos unless exists $params->{$name}{position};
 5915: 
 5916: 			$pos++;
 5917: 		}
 5918: 		return;
 5919: 	} elsif ($code =~ /my\s+\$self\s*=\s*shift/) {
 5920: 		# Traditional Style 2: my $self = shift; my $arg1 = shift;
 5921: 		my @shifts;
 5922: 		while ($code =~ /my\s+\$(\w+)\s*=\s*shift/g) {
 5923: 			push @shifts, $1;
 5924: 		}
 5925: 		shift @shifts if @shifts && $shifts[0] =~ /^(self|class)$/i;
 5926: 		my $pos = 0;
 5927: 		foreach my $param (@shifts) {
 5928: 			$params->{$param} ||= { _source => 'code', optional => 1, position => $pos++ };
 5929: 		}
 5930: 		return;
 5931: 	}
 5932: 
 5933: 	# Traditional Style 3: Function parameters (no $self)
●5934 → 5934 → 5945 5934: 	if ($code =~ /my\s*\(\s*([^)]+)\)\s*=\s*\@_/s) {
 5935: 		my $sig = $1;
 5936: 		my @param_names = $sig =~ /\$(\w+)/g;
 5937: 		my $pos = 0;
 5938: 		foreach my $param (@param_names) {
 5939: 			next if $param =~ /^(self|class)$/i;
 5940: 			$params->{$param} ||= { _source => 'code', optional => 1, position => $pos++ };
 5941: 		}
 5942: 	}
 5943: 
 5944: 	# De-duplicate
  Mutants (Total: 1, Killed: 1, Survived: 0)
●5945 → 5946 → 0 5945: 	my %seen;
 5946: 	foreach my $param (keys %$params) {
 5947: 		if ($seen{$param}++) {
 5948: 			$self->_log("  WARNING: Duplicate parameter '$param' found");
 5949: 		}
 5950: 	}
 5951: }
 5952: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5953: # --------------------------------------------------
 5954: # _parse_modern_signature
 5955: #
 5956: # Purpose:    Parse a Perl 5.20+ subroutine
 5957: #             signature string into individual
 5958: #             parameter specs, respecting nested
 5959: #             structures when splitting on commas.
 5960: #
 5961: # Entry:      $params - hashref to populate
 5962: #                       (modified in place).
 5963: #             $sig    - signature string with outer
 5964: #                       parentheses already removed.
 5965: #
 5966: # Exit:       Returns nothing. Populates $params
 5967: #             via _parse_signature_parameter.
 5968: #
 5969: # Side effects: Logs parsing details to stdout when
 5970: #               verbose is set.
 5971: # --------------------------------------------------
 5972: sub _parse_modern_signature {
●5973 → 5984 → 6002 5973: 	my ($self, $params, $sig) = @_;
 5974: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5975: 	$self->_log("  DEBUG: Parsing signature: [$sig]");
 5976: 
 5977: 	# Split signature by commas, but respect nested structures (e.g. a
 5978: 	# default value containing a hashref/arrayref literal)
  Mutants (Total: 1, Killed: 1, Survived: 0)
 5979: 	require Text::Balanced;
 5980: 	my @parts;
 5981: 	my $current = '';
 5982: 	my $rest = $sig;
 5983: 
 5984: 	while (length $rest) {
 5985: 		if (substr($rest, 0, 1) =~ /[(\[{]/) {
 5986: 			# extract_bracketed advances $rest past the extracted block
 5987: 			# in place, so $rest must not be re-truncated afterwards
 5988: 			my $extracted = Text::Balanced::extract_bracketed($rest, '(){}[]');
 5989: 			last unless defined $extracted;	# Unbalanced brackets
 5990: 			$current .= $extracted;
 5991: 			next;
 5992: 		}
 5993: 		if (substr($rest, 0, 1) eq ',') {
 5994: 			push @parts, $current;
 5995: 			$current = '';
 5996: 			$rest = substr($rest, 1);
 5997: 			next;
 5998: 		}
 5999: 		$current .= substr($rest, 0, 1);
 6000: 		$rest = substr($rest, 1);
 6001: 	}
●6002 → 6006 → 0 6002: 	push @parts, $current if $current =~ /\S/;
 6003: 
 6004: 	my $position = 0;
 6005: 
 6006: 	foreach my $part (@parts) {
 6007: 		$part =~ s/^\s+|\s+$//g;
 6008: 
 6009: 		# Skip empty parts
 6010: 		next unless $part;
 6011: 
 6012: 		# Parse different parameter types
 6013: 		my $param_info = $self->_parse_signature_parameter($part, $position);
 6014: 
 6015: 		if ($param_info) {
 6016: 			my $name = $param_info->{name};
 6017: 
 6018: 			# Skip self/class
 6019: 			if ($name =~ /^(self|class)$/i) {
 6020: 				next;
 6021: 			}
 6022: 
 6023: 			$params->{$name} = $param_info;
 6024: 			$self->_log("  SIG: $name has position $position" .
 6025: 				($param_info->{optional} ? ' (optional)' : '') .
 6026: 				($param_info->{_default} ? ", default: $param_info->{_default}" : ''));
 6027: 			$position++;
 6028: 		}
 6029: 	}
 6030: }
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6031: 
 6032: # --------------------------------------------------
 6033: # _parse_signature_parameter
 6034: #
 6035: # Purpose:    Parse a single parameter declaration
 6036: #             from a modern Perl signature, handling
 6037: #             type constraints, default values,
 6038: #             plain scalars, and slurpy array/hash
 6039: #             parameters.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6040: #
 6041: # Entry:      $part     - a single parameter string
 6042: #                         (one comma-separated
 6043: #                         element from the signature).
 6044: #             $position - zero-based position index
 6045: #                         of this parameter.
 6046: #
 6047: # Exit:       Returns a parameter info hashref on
 6048: #             success, or undef if the string does
 6049: #             not match any known pattern.
 6050: #
 6051: # Side effects: None.
 6052: #
 6053: # Notes:      Six patterns are tried in order:
 6054: #             (1) :Type with default,
 6055: #             (2) :Type without default,
 6056: #             (3) default without type,
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6057: #             (4) plain $name,
 6058: #             (5) slurpy @name,
 6059: #             (6) slurpy %name.
 6060: # --------------------------------------------------
 6061: sub _parse_signature_parameter {
●6062 → 6071 → 6161 6062: 	my ($self, $part, $position) = @_;
 6063: 
 6064: 	my %info = (
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6065: 		_source => 'signature',
 6066: 		position => $position,
 6067: 		optional => 0,
 6068: 	);
 6069: 
 6070: 	# Pattern 1: Type constraint WITH default: $name :Type = default
 6071: 	if ($part =~ /^\$(\w+)\s*:\s*(\w+)\s*=\s*(.+)$/s) {
 6072: 		my ($name, $constraint, $default) = ($1, $2, $3);
 6073: 		$default =~ s/^\s+|\s+$//g;
 6074: 
 6075: 		$info{name} = $name;
 6076: 		$info{optional} = 1;
 6077: 		$info{_default} = $self->_clean_default_value($default, 1);
 6078: 
 6079: 		# Apply type constraint
 6080: 		if ($constraint =~ /^(Int|Integer)$/i) {
 6081: 			$info{type} = 'integer';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6082: 		} elsif ($constraint =~ /^(Num|Number)$/i) {
 6083: 			$info{type} = 'number';
 6084: 		} elsif ($constraint =~ /^(Str|String)$/i) {
 6085: 			$info{type} = 'string';
 6086: 		} elsif ($constraint =~ /^(Bool|Boolean)$/i) {
 6087: 			$info{type} = 'boolean';
 6088: 		} elsif ($constraint =~ /^(Array|ArrayRef)$/i) {
 6089: 			$info{type} = 'arrayref';
 6090: 		} elsif ($constraint =~ /^(Hash|HashRef)$/i) {
 6091: 			$info{type} = 'hashref';
 6092: 		} else {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6093: 			$info{type} = 'object';
 6094: 			$info{isa} = $constraint;
 6095: 		}
 6096: 
 6097: 		return \%info;
 6098: 	} elsif ($part =~ /^\$(\w+)\s*:\s*(\w+)\s*$/s) {
 6099: 		# Pattern 2: Type constraint WITHOUT default: $name :Type
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6100: 		my ($name, $constraint) = ($1, $2);
 6101: 		$info{name} = $name;
 6102: 		$info{optional} = 0;
 6103: 
 6104: 		# Apply type constraint (same as above)
 6105: 		if ($constraint =~ /^(Int|Integer)$/i) {
 6106: 			$info{type} = 'integer';
 6107: 		} elsif ($constraint =~ /^(Num|Number)$/i) {
 6108: 			$info{type} = 'number';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6109: 		} elsif ($constraint =~ /^(Str|String)$/i) {
 6110: 			$info{type} = 'string';
 6111: 		} elsif ($constraint =~ /^(Bool|Boolean)$/i) {
 6112: 			$info{type} = 'boolean';
 6113: 		} elsif ($constraint =~ /^(Array|ArrayRef)$/i) {
 6114: 			$info{type} = 'arrayref';
 6115: 		} elsif ($constraint =~ /^(Hash|HashRef)$/i) {
 6116: 			$info{type} = 'hashref';
 6117: 		} else {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6118: 			$info{type} = 'object';
 6119: 			$info{isa} = $constraint;
 6120: 		}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6121: 
 6122: 		return \%info;
 6123: 	} elsif ($part =~ /^\$(\w+)\s*=\s*(.+)$/s) {
 6124: 		# Pattern 3: Default WITHOUT type: $name = default
 6125: 		my ($name, $default) = ($1, $2);
 6126: 		$default =~ s/^\s+|\s+$//g;
 6127: 
 6128: 	$info{name} = $name;
 6129: 	$info{optional} = 1;
 6130: 	$info{_default} = $self->_clean_default_value($default, 1);
 6131: 	$info{type} = $self->_infer_type_from_default($info{_default}) if $self->can('_infer_type_from_default');
 6132: 
 6133: 	return \%info;
 6134: 	}
 6135: 
 6136:     # Pattern 4: Plain parameter: $name
 6137:     elsif ($part =~ /^\$(\w+)$/s) {
 6138:         $info{name} = $1;
 6139:         $info{optional} = 0;
 6140:         return \%info;
 6141:     }
 6142: 
 6143:     # Pattern 5: Array parameter: @name
 6144:     elsif ($part =~ /^\@(\w+)$/s) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6145:         $info{name} = $1;
 6146:         $info{type} = 'array';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6147:         $info{slurpy} = 1;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6148:         $info{optional} = 1;
 6149:         return \%info;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6150:     }
 6151: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6152:     # Pattern 6: Hash parameter: %name
 6153:     elsif ($part =~ /^\%(\w+)$/s) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6154:         $info{name} = $1;
 6155:         $info{type} = 'hash';

					

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

				
BOOL_NEGATE_6155_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_6155_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 6156:         $info{slurpy} = 1;
 6157:         $info{optional} = 1;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6158:         return \%info;
 6159:     }
 6160: 
 6161: 	return undef;
 6162: }
 6163: 
 6164: # --------------------------------------------------
 6165: # _infer_type_from_default
 6166: #
 6167: # Purpose:    Infer a parameter type from its
 6168: #             default value when no explicit type
 6169: #             annotation is available.
 6170: #
 6171: # Entry:      $default - the cleaned default value
 6172: #                        scalar, hashref, or
 6173: #                        arrayref. May be undef.
 6174: #
 6175: # Exit:       Returns a type string ('hashref',
 6176: #             'arrayref', 'integer', 'number',
 6177: #             'boolean', 'string'), or undef if
 6178: #             $default is undef.
 6179: #
 6180: # Side effects: None.
 6181: # --------------------------------------------------
 6182: sub _infer_type_from_default {
●6183 → 6187 → 0 6183: 	my ($self, $default) = @_;
 6184: 
 6185: 	return undef unless defined $default;
 6186: 
 6187: 	if (ref($default) eq 'HASH') {
 6188: 		return 'hashref';
 6189: 	} elsif (ref($default) eq 'ARRAY') {
 6190: 		return 'arrayref';
 6191: 	} elsif ($default =~ /^-?\d+$/) {
 6192: 		return 'integer';
 6193: 	} elsif ($default =~ /^-?\d+\.\d+$/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6194: 		return 'number';
 6195: 	} elsif ($default eq '1' || $default eq '0') {
 6196: 		return 'boolean';
 6197: 	} else {
 6198: 		return 'string';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6199: 	}
 6200: }
 6201: 
 6202: # --------------------------------------------------
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6203: # _extract_subroutine_attributes
 6204: #
 6205: # Purpose:    Extract Perl subroutine attributes
 6206: #             (e.g. :lvalue, :method, :Returns(Int))
 6207: #             from a method's source string.
 6208: #
 6209: # Entry:      $code - method body source string.
 6210: #
 6211: # Exit:       Returns a hashref of attribute name
 6212: #             to value (1 for flag-only attributes,
 6213: #             the attribute argument string for
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6214: #             attributes with values).
 6215: #             Returns an empty hashref if no

					

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

				
COND_INV_6215_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 6216: #             attributes are found.
 6217: #
 6218: # Side effects: Logs detections to stdout when
 6219: #               verbose is set.
 6220: # --------------------------------------------------

					

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

				
COND_INV_6220_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 6221: sub _extract_subroutine_attributes {
●6222 → 6234 → 6239 6222: 	my ($self, $code) = @_;
 6223: 
 6224: 	my %attributes;

					

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

				
COND_INV_6224_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 6225: 
 6226: 	# Extract all attributes from the sub declaration
 6227: 	# Attributes are :name or :name(value) between sub name and either ( or {
 6228: 	# Pattern: sub name ATTRIBUTES ( params ) { }
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6229: 	# or:      sub name ATTRIBUTES { }
 6230: 
 6231: 	# First, find the attributes section (everything between sub name and ( or { )
 6232: 	my $attr_section = '';
 6233: 
 6234: 	if($code =~ /sub\s+\w+\s+((?::\w+(?:\([^)]*\))?\s*)+)/s) {
 6235: 		$attr_section = $1;
 6236: 	}
 6237: 
 6238: 	# Parse individual attributes from the section
●6239 → 6239 → 6254 6239: 	if($attr_section) {
 6240: 		while($attr_section =~ /:(\w+)(?:\(([^)]*)\))?/g) {
 6241: 			my ($name, $value) = ($1, $2);
 6242: 
 6243: 			if (defined $value && $value ne '') {
 6244: 				$attributes{$name} = $value;
 6245: 				$self->_log("  ATTR: Found attribute :$name($value)");
 6246: 			} else {
 6247: 				$attributes{$name} = 1;
 6248: 				$self->_log("  ATTR: Found attribute :$name");
 6249: 			}
 6250: 		}
 6251: 	}
 6252: 
 6253: 	# Process common attributes
●6254 → 6254 → 6261 6254: 	if ($attributes{Returns}) {
 6255: 		my $return_type = $attributes{Returns};
 6256: 		if ($return_type ne '1') {  # Only log if it's an actual type, not just the flag
 6257: 			$self->_log("  ATTR: Method declares return type: $return_type");
 6258: 		}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6259: 	}
 6260: 
●6261 → 6261 → 6265 6261: 	if ($attributes{lvalue}) {
 6262: 		$self->_log("  ATTR: Method is lvalue (can be assigned to)");
 6263: 	}
 6264: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
●6265 → 6265 → 6269 6265: 	if ($attributes{method}) {
 6266: 		$self->_log('  ATTR: Method explicitly marked as :method');
 6267: 	}
 6268: 
 6269: 	return \%attributes;
 6270: }
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6271: 
 6272: # --------------------------------------------------
 6273: # _analyze_postfix_dereferencing
 6274: #
 6275: # Purpose:    Detect usage of Perl 5.20+ postfix
 6276: #             dereferencing syntax in a method body
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6277: #             and record which dereference forms
 6278: #             are used.
 6279: #
 6280: # Entry:      $code - method body source string.
 6281: #
 6282: # Exit:       Returns a hashref whose keys are
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6283: #             dereference form names (array_deref,
 6284: #             hash_deref, scalar_deref, code_deref,
 6285: #             array_slice, hash_slice) with value 1
 6286: #             when detected.
 6287: #             Returns an empty hashref if no
 6288: #             postfix dereferencing is found.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6289: #
 6290: # Side effects: Logs detections to stdout when
 6291: #               verbose is set.
 6292: # --------------------------------------------------
 6293: sub _analyze_postfix_dereferencing {
  Mutants (Total: 2, Killed: 2, Survived: 0)
●6294 → 6299 → 6305 6294: 	my ($self, $code) = @_;
 6295: 
 6296: 	my %derefs;
 6297: 
 6298: 	# Array dereference: $ref->@*
 6299: 	if ($code =~ /\$\w+\s*->\s*\@\*/) {
 6300: 		$derefs{array_deref} = 1;
 6301: 		$self->_log("  MODERN: Uses postfix array dereferencing (->@*)");
 6302: 	}
 6303: 
 6304: 	# Hash dereference: $ref->%*
●6305 → 6305 → 6311 6305: 	if ($code =~ /\$\w+\s*->\s*\%\*/) {
 6306: 		$derefs{hash_deref} = 1;
 6307: 		$self->_log("  MODERN: Uses postfix hash dereferencing (->%*)");
 6308: 	}
 6309: 
 6310: 	# Scalar dereference: $ref->$*
●6311 → 6311 → 6317 6311: 	if ($code =~ /\$\w+\s*->\s*\$\*/) {
 6312: 		$derefs{scalar_deref} = 1;
 6313: 		$self->_log('  MODERN: Uses postfix scalar dereferencing (->$*)');
 6314: 	}
 6315: 
 6316: 	# Code dereference: $ref->&*
●6317 → 6317 → 6323 6317: 	if ($code =~ /\$\w+\s*->\s*\&\*/) {
 6318: 		$derefs{code_deref} = 1;
 6319: 		$self->_log("  MODERN: Uses postfix code dereferencing (->&*)");
 6320: 	}
 6321: 
 6322: 	# Array element: $ref->@[0,2,4]
●6323 → 6323 → 6329 6323: 	if ($code =~ /\$\w+\s*->\s*\@\[/) {
 6324: 		$derefs{array_slice} = 1;
 6325: 		$self->_log("  MODERN: Uses postfix array slice (->@[...])");
 6326: 	}
 6327: 
 6328: 	# Hash element: $ref->%{key1,key2}
●6329 → 6329 → 6334 6329: 	if ($code =~ /\$\w+\s*->\s*\%\{/) {
 6330: 		$derefs{hash_slice} = 1;
 6331: 		$self->_log("  MODERN: Uses postfix hash slice (->%{...})");
 6332: 	}
 6333: 
 6334: 	return \%derefs;
 6335: }
 6336: 
 6337: # --------------------------------------------------
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6338: # _extract_field_declarations
 6339: #
 6340: # Purpose:    Extract Perl 5.38 field declarations
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6341: #             from a class body or method source
 6342: #             string, capturing field names,
 6343: #             :param attributes, default values,
 6344: #             and :isa type constraints.
 6345: #
 6346: # Entry:      $code - source string potentially
 6347: #                     containing 'field $name ...'
 6348: #                     declarations.
 6349: #
 6350: # Exit:       Returns a hashref of field name to
 6351: #             field_info hashref. Returns an empty
 6352: #             hashref if no field declarations
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6353: #             are found.
 6354: #
 6355: # Side effects: Logs detections to stdout when
 6356: #               verbose is set.
 6357: # --------------------------------------------------
 6358: sub _extract_field_declarations {
●6359 → 6367 → 6411 6359: 	my ($self, $code) = @_;
 6360: 
 6361: 	my %fields;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6362: 
 6363: 	# Pattern: field $name :param;
 6364: 	# Pattern: field $name :param(name);
 6365: 	# Pattern: field $name = default;
 6366: 	# More lenient pattern to catch various formats
 6367: 	while ($code =~ /^\s*field\s+\$(\w+)\s*([^;]*);/gm) {
 6368: 		my ($name, $modifiers) = ($1, $2);
 6369: 
 6370: 		$self->_log("  FIELD: Found field \$$name with modifiers: [$modifiers]");
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6371: 
 6372: 		my %field_info = (
 6373: 			name => $name,
 6374: 			_source => 'field'
 6375: 		);
 6376: 
 6377: 		# Check for :param attribute
 6378: 		if ($modifiers =~ /:param(?:\(([^)]+)\))?/) {
 6379: 			$field_info{is_param} = 1;
 6380: 
 6381: 			if (defined $1) {
 6382: 				# Explicit parameter name
 6383: 				$field_info{param_name} = $1;
 6384: 			} else {
 6385: 				# Implicit - field name is param name
 6386: 				$field_info{param_name} = $name;
 6387: 			}
 6388: 
 6389: 			$self->_log("  FIELD: $name maps to parameter: $field_info{param_name}");
 6390: 		}
 6391: 
 6392:         # Check for default value - must come before type constraint check
 6393: 	if ($modifiers =~ /=\s*([^:;]+)(?::|;|$)/) {
 6394: 		my $default = $1;
 6395: 		$default =~ s/\s+$//;
 6396: 		$field_info{_default} = $self->_clean_default_value($default, 1);
 6397: 		$field_info{optional} = 1;
 6398: 		$self->_log("  FIELD: $name has default: " . (defined $field_info{_default} ? $field_info{_default} : 'undef'));
 6399: 	}
 6400: 
 6401: 	# Check for type constraints
 6402: 	if ($modifiers =~ /:isa\(([^)]+)\)/) {
 6403: 	    $field_info{isa} = $1;
 6404: 	    $field_info{type} = 'object';
 6405: 	    $self->_log("  FIELD: $name has type constraint: $1");
 6406: 	}
 6407: 
 6408: 		$fields{$name} = \%field_info;
 6409: 	}
 6410: 
 6411: 	return \%fields;
 6412: }
 6413: 
 6414: # --------------------------------------------------
 6415: # _merge_field_declarations
 6416: #
 6417: # Purpose:    Integrate Perl 5.38 field declarations
 6418: #             that carry the :param attribute into
 6419: #             the code parameter hashref, so they
 6420: #             appear as constructor parameters in
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6421: #             the generated schema.
 6422: #
 6423: # Entry:      $params - hashref of parameters
 6424: #                       extracted from code analysis
 6425: #                       (modified in place).
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6426: #             $fields - hashref of field declarations
 6427: #                       as returned by
 6428: #                       _extract_field_declarations.
 6429: #
 6430: # Exit:       Returns nothing. Modifies $params
 6431: #             in place.
 6432: #
 6433: # Side effects: Logs merges to stdout when verbose
 6434: #               is set.
 6435: #
 6436: # Notes:      Only fields with is_param => 1 are
 6437: #             merged. The param_name key in the
 6438: #             field (which may differ from the
 6439: #             field name if :param(name) was used)
 6440: #             determines the parameter key.
 6441: # --------------------------------------------------
 6442: sub _merge_field_declarations {
●6443 → 6445 → 0 6443: 	my ($self, $params, $fields) = @_;
 6444: 
 6445: 	foreach my $field_name (keys %$fields) {
 6446: 		my $field = $fields->{$field_name};
 6447: 
 6448: 		# Only process fields that are parameters
 6449: 		next unless $field->{is_param};
 6450: 
 6451: 		my $param_name = $field->{param_name};
 6452: 
 6453: 		# Create or update parameter info
 6454: 		$params->{$param_name} ||= {};
 6455: 		my $p = $params->{$param_name};
 6456: 
 6457: 		# Merge field information into parameter
 6458: 		$p->{_source} = 'field' unless $p->{_source};
 6459: 		$p->{field_name} = $field_name if $field_name ne $param_name;
 6460: 
 6461: 		if ($field->{_default}) {
 6462: 			$p->{_default} = $field->{_default};
 6463: 			$p->{optional} = 1;
 6464: 		}
 6465: 
 6466: 		if ($field->{isa}) {
 6467: 			$p->{isa} = $field->{isa};
 6468: 			$p->{type} = 'object';
 6469: 		}
 6470: 
 6471: 		$self->_log("  MERGED: Field $field_name -> parameter $param_name");
 6472: 	}
 6473: }
 6474: 
 6475: # --------------------------------------------------
 6476: # _extract_defaults_from_code
 6477: #
 6478: # Purpose:    Scan a method body for default value
 6479: #             assignment patterns and populate the
 6480: #             optional and _default fields of
 6481: #             known parameters.
 6482: #
 6483: # Entry:      $params - hashref of parameters
 6484: #                       (modified in place).
 6485: #             $code   - method body source string.
 6486: #             $method - method hashref, used for
 6487: #                       constructor-specific
 6488: #                       exclusions of $class and
 6489: #                       $self.
 6490: #
 6491: # Exit:       Returns nothing. Modifies $params
 6492: #             in place.
 6493: #
 6494: # Side effects: Logs detections to stdout when
 6495: #               verbose is set.
 6496: #
 6497: # Notes:      Eight default patterns are tried.
 6498: #             Only parameters already present in
 6499: #             $params are updated — this method
 6500: #             does not add new parameters.
 6501: #             Falls back to extracting all @_
 6502: #             assignments if $params is empty
 6503: #             after the main pass.
 6504: # --------------------------------------------------
 6505: sub _extract_defaults_from_code {
●6506 → 6509 → 6520 6506: 	my ($self, $params, $code, $method) = @_;
 6507: 
 6508: 	# Pattern 1: my $param = value;
 6509: 	while ($code =~ /my\s+\$(\w+)\s*=\s*([^;]+);/g) {
 6510: 		my ($param, $value) = ($1, $2);
 6511: 		next unless exists $params->{$param};
 6512: 		next if $value =~ /->/;	# deref/method call, not a default value
 6513: 
 6514: 		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
 6515: 		$params->{$param}{optional} = 1;
 6516: 		$self->_log("  CODE: $param has default: " . $self->_format_default($params->{$param}{_default}));
 6517: 	}
 6518: 
 6519: 	# Pattern 2: $param = value unless defined $param;
●6520 → 6520 → 6530 6520: 	while ($code =~ /\$(\w+)\s*=\s*([^;]+?)\s+unless\s+(?:defined\s+)?\$\1/g) {
 6521: 		my ($param, $value) = ($1, $2);
 6522: 		next unless exists $params->{$param};
 6523: 
 6524: 		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
 6525: 		$params->{$param}{optional} = 1;
 6526: 		$self->_log("  CODE: $param has default (unless): " . $self->_format_default($params->{$param}{_default}));
 6527: 	}
 6528: 
 6529: 	# Pattern 3: $param = value unless $param;
●6530 → 6530 → 6540 6530: 	while ($code =~ /\$(\w+)\s*=\s*([^;]+?)\s+unless\s+\$\1/g) {
 6531: 		my ($param, $value) = ($1, $2);
 6532: 		next unless exists $params->{$param};
 6533: 
 6534: 		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
 6535: 		$params->{$param}{optional} = 1;
 6536: 		$self->_log("  CODE: $param has default (unless): " . $self->_format_default($params->{$param}{_default}));
 6537: 	}
 6538: 
 6539: 	# Pattern 4: $param = $param || 'default';
●6540 → 6540 → 6550 6540: 	while ($code =~ /\$(\w+)\s*=\s*\$\1\s*\|\|\s*([^;]+);/g) {
 6541: 		my ($param, $value) = ($1, $2);
 6542: 		next unless exists $params->{$param};
 6543: 
 6544: 		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
 6545: 		$params->{$param}{optional} = 1;
 6546: 		$self->_log("  CODE: $param has default (||): " . $self->_format_default($params->{$param}{_default}));
 6547: 	}
 6548: 
 6549: 	# Pattern 5: $param ||= 'default';
●6550 → 6550 → 6560 6550: 	while ($code =~ /\$(\w+)\s*\|\|=\s*([^;]+);/g) {
 6551: 		my ($param, $value) = ($1, $2);
 6552: 		next unless exists $params->{$param};
 6553: 
 6554: 		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
 6555: 		$params->{$param}{optional} = 1;
 6556: 		$self->_log("  CODE: $param has default (||=): " . $self->_format_default($params->{$param}{_default}));
 6557: 	}
 6558: 
 6559: 	# Pattern 6: $param //= 'default';
●6560 → 6560 → 6571 6560: 	while ($code =~ /\$(\w+)\s*\/\/=\s*([^;]+);/g) {
 6561: 		my ($param, $value) = ($1, $2);
 6562: 		next unless exists $params->{$param};  # Using -> because $params is a reference
 6563: 
 6564: 		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
 6565: 
 6566: 		$params->{$param}{optional} = 1;
 6567: 		$self->_log("  CODE: $param has default (//=): " . $self->_format_default($params->{$param}{_default}));
 6568: 	}
 6569: 
 6570: 	# Pattern 7: $param = defined $param ? $param : 'default';
  Mutants (Total: 1, Killed: 1, Survived: 0)
●6571 → 6571 → 6585 6571: 	while ($code =~ /\$(\w+)\s*=\s*defined\s+\$\1\s*\?\s*\$\1\s*:\s*([^;]+);/g) {
 6572: 		my ($param, $value) = ($1, $2);
 6573: 
 6574: 		# Create param entry if it doesn't exist
 6575: 		$params->{$param} ||= {};
 6576: 
 6577: 		my $cleaned = $self->_clean_default_value($value, 1);

					

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

				
NUM_BOUNDARY_6577_40_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
COND_INV_6577_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 6578: 
 6579: 		$params->{$param}{_default} = $cleaned;
 6580: 		$params->{$param}{optional} = 1;

					

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

				
NUM_BOUNDARY_6580_44_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 6581: 		$self->_log("  CODE: $param has default (ternary): " . $self->_format_default($params->{$param}{_default}));
 6582: 	}
 6583: 
 6584: 	# Pattern 8: $param = $args{param} || 'default';
●6585 → 6585 → 6595 6585: 	while ($code =~ /\$(\w+)\s*=\s*\$args\{['"]?\w+['"]?\}\s*\|\|\s*([^;]+);/g) {
 6586: 		my ($param, $value) = ($1, $2);
 6587: 		next unless exists $params->{$param};
 6588: 
 6589: 		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
 6590: 		$params->{$param}{optional} = 1;
 6591: 		$self->_log("  CODE: $param has default (from args): " . $self->_format_default($params->{$param}{_default}));
 6592: 	}
 6593: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6594: 	# Pattern for non-empty hashref
●6595 → 6595 → 6611 6595: 	while ($code =~ /\$(\w+)\s*\|\|=\s*\{[^}]+\}/gs) {
 6596: 		my $param = $1;

					

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

				
NUM_BOUNDARY_6596_43_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 6597: 		next unless exists $params->{$param};
 6598: 
 6599: 		# Return empty hashref as placeholder (can't evaluate complex hashrefs)
 6600: 		$params->{$param}{_default} = {};
 6601: 		$params->{$param}{optional} = 1;
 6602: 		$self->_log("  CODE: $param has hashref default (||=)");
 6603: 	}
 6604: 
 6605: 	# Fallback: extract parameters from classic Perl body styles
 6606: 	# Only run if signature extraction found nothing AND the code does not use
 6607: 	# the direct-index ($_[0]) style — that style is used for no-param methods
 6608: 	# whose empty %params would otherwise trigger this fallback and pick up

					

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

				
NUM_BOUNDARY_6608_39_<: Numeric boundary flip > to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_6608_39_>=: Numeric boundary flip > to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_6608_39_<=: Numeric boundary flip > to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
COND_INV_6608_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 6609: 	# my (...) = @_ from inner closures as if they were method params.
 6610: 	# TODO:  On constructors, use $class to help to determine the output type
●6611 → 6611 → 0 6611: 	if (!keys %{$params} && $code !~ /my\s+\$(?:self|class)\s*=\s*\$_\[0\]/) {
 6612: 		my $position = 0;
 6613: 
 6614: 		# Style 1: my ($a, $b) = @_;
 6615: 		while ($code =~ /my\s*\(\s*([^)]+)\s*\)\s*=\s*\@_/g) {
 6616: 			my @vars = $1 =~ /\$(\w+)/g;
 6617: 			foreach my $var (@vars) {
 6618: 				if(($var eq 'class') && ($position == 0) && ($method->{name} eq 'new')) {
 6619: 					# Don't include "class" in the variable names of the constructor
 6620: 					delete $params->{'class'};
 6621: 				} elsif(($var eq 'self') && ($position == 0) && ($method->{name} ne 'new')) {
 6622: 					# Don't include "self" in the variable names
 6623: 					delete $params->{'self'};
 6624: 				} else {
 6625: 					$params->{$var} ||= { position => $position++ };
 6626: 					$self->_log("  CODE: $var extracted from \@_ list assignment");
 6627: 				}
 6628: 			}
 6629: 		}
 6630: 
 6631: 		# Style 2: my $x = shift;
 6632: 		while ($code =~ /my\s+\$(\w+)\s*=\s*shift\b/g) {
 6633: 			my $var = $1;
 6634: 			if(($var eq 'class') && ($position == 0) && ($method->{name} eq 'new')) {
 6635: 				# Don't include "class" in the variable names of the constructor
 6636: 				delete $params->{'class'};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6637: 			} elsif(($var eq 'self') && ($position == 0) && ($method->{name} ne 'new')) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6638: 				# Don't include "self" in the variable names
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6639: 				delete $params->{'self'};
 6640: 			} else {
 6641: 				$params->{$var} ||= { position => $position++ };
 6642: 				$self->_log("  CODE: $var is extracted from shift");
 6643: 			}
 6644: 		}
 6645: 
 6646: 		# Style 3: my $x = $_[0];
 6647: 		while ($code =~ /my\s+\$(\w+)\s*=\s*\$_\[(\d+)\]/g) {
 6648: 			my ($var, $index) = ($1, $2);
 6649: 			if(($var ne 'class') || ($position > 0) || ($method->{name} ne 'new')) {
 6650: 				$params->{$var} ||= { position => $index };
 6651: 				$self->_log("  CODE: $var is extracted from \$_\[$index\]");
 6652: 			}
 6653: 		}
 6654: 	}
 6655: }
 6656: 
 6657: # --------------------------------------------------
 6658: # _format_default
 6659: #
 6660: # Purpose:    Format a default value for display
 6661: #             in verbose log output.
 6662: #
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6663: # Entry:      $default - the default value to
 6664: #                        format. May be undef,
 6665: #                        a scalar, a hashref, or
 6666: #                        an arrayref.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6667: #
 6668: # Exit:       Returns a display string: 'undef'

					

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

				
BOOL_NEGATE_6668_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_6668_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 6669: #             for undef, 'HASH ref' / 'ARRAY ref'
 6670: #             for references, or the value itself
 6671: #             for scalars.
 6672: #
 6673: # Side effects: None.
 6674: # --------------------------------------------------
 6675: sub _format_default {
 6676: 	my ($self, $default) = @_;
 6677: 	return 'undef' unless defined $default;
 6678: 	return ref($default) . ' ref' if ref($default);
 6679: 	return $default;
 6680: }
 6681: 
 6682: # --------------------------------------------------
 6683: # _module_constants
 6684: #
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6685: # Purpose:    Build and cache a hash of numeric
 6686: #             constant values declared in the target
 6687: #             module source, covering both Readonly
 6688: #             lexicals and 'use constant' barewords.
 6689: #             Used by _analyze_parameter_constraints
 6690: #             to resolve right-hand sides like
 6691: #             $MIN_NAME_LEN that are not literals.
 6692: #
 6693: # Entry:      None (uses $self->{_document}).
 6694: #
 6695: # Exit:       Returns a hashref { NAME => value }.
 6696: #             Returns {} if the PPI document is not
 6697: #             yet loaded.
 6698: #
 6699: # Side effects: Caches result in $self->{_constants}.
 6700: # --------------------------------------------------
 6701: sub _module_constants {
●6702 → 6707 → 6712 6702: 	my ($self) = @_;
 6703: 	return $self->{_constants} if exists $self->{_constants};
 6704: 
 6705: 	my %c;
 6706: 	my $doc = $self->{_document};
 6707: 	unless ($doc) {
 6708: 		$self->{_constants} = \%c;
 6709: 		return \%c;
 6710: 	}
 6711: 
●6712 → 6715 → 6720 6712: 	my $src = $doc->serialize();
 6713: 
 6714: 	# Readonly my $CONST => numeric_value;
 6715: 	while ($src =~ /Readonly\s+(?:my|our)\s+\$(\w+)\s*=>\s*([+-]?\d+(?:\.\d+)?)/g) {
 6716: 		$c{$1} = $2;
 6717: 	}
 6718: 
 6719: 	# use constant CONST => numeric_value;
  Mutants (Total: 1, Killed: 1, Survived: 0)
●6720 → 6720 → 6724 6720: 	while ($src =~ /use\s+constant\s+(\w+)\s*=>\s*([+-]?\d+(?:\.\d+)?)/g) {
 6721: 		$c{$1} = $2;
 6722: 	}
 6723: 
 6724: 	$self->{_constants} = \%c;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6725: 	return \%c;
 6726: }
 6727: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6728: # --------------------------------------------------
 6729: # _analyze_parameter_constraints
 6730: #
 6731: # Purpose:    Infer min, max, and regex match
 6732: #             constraints for a single parameter
 6733: #             from length checks, numeric
 6734: #             comparisons, and regex match
 6735: #             patterns in the method body.
 6736: #
 6737: # Entry:      $p_ref - reference to the parameter
 6738: #                      hashref (modified in place).
 6739: #             $param - parameter name string.
 6740: #             $code  - method body source string.
 6741: #
 6742: # Exit:       Returns nothing. Modifies the
 6743: #             referenced parameter hashref.
 6744: #
 6745: # Side effects: Logs detections to stdout when
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6746: #               verbose is set.
 6747: #
 6748: # Notes:      Numeric comparisons that appear
 6749: #             inside die/croak guard conditions
 6750: #             are excluded to avoid inferring
 6751: #             invalid-input ranges as valid
 6752: #             constraints.
 6753: # --------------------------------------------------
 6754: sub _analyze_parameter_constraints {
●6755 → 6760 → 6765 6755: 	my ($self, $p_ref, $param, $code) = @_;
 6756: 	my $p = $$p_ref;
 6757: 
 6758: 	# Do not treat comparisons inside die/croak/confess as valid constraints
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6759: 	my $guarded = 0;
 6760: 		if ($code =~ /(die|croak|confess)\b[^{;]*\bif\b[^{;]*\$$param\b/s) {
 6761: 		$guarded = 1;
 6762: 	}
 6763: 
 6764: 	# Length checks for strings — literal numeric RHS
●6765 → 6765 → 6781 6765: 	if ($code =~ /length\s*\(\s*\$$param\s*\)\s*([<>]=?)\s*(\d+)/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6766: 		my ($op, $val) = ($1, $2);
 6767: 		$p->{type} ||= 'string';
 6768: 		if ($op eq '<') {

					

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

				
NUM_BOUNDARY_6768_52_>: Numeric boundary flip < to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_6768_52_<=: Numeric boundary flip < to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_6768_52_>=: Numeric boundary flip < to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 6769: 			$p->{max} = $val - 1;
 6770: 		} elsif ($op eq '<=') {
 6771: 			$p->{max} = $val;

					

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

				
NUM_BOUNDARY_6771_52_<: Numeric boundary flip > to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_6771_52_>=: Numeric boundary flip > to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_6771_52_<=: Numeric boundary flip > to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 6772: 		} elsif ($op eq '>') {
 6773: 			$p->{min} = $val + 1;
 6774: 		} elsif ($op eq '>=') {
 6775: 			$p->{min} = $val;
 6776: 		}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6777: 		$self->_log("  CODE: $param length constraint $op $val");
 6778: 	}
 6779: 
 6780: 	# Length checks for strings — Readonly / use-constant RHS ($CONST_NAME)
●6781 → 6781 → 6799 6781: 	while ($code =~ /length\s*\(\s*\$$param\s*\)\s*([<>]=?)\s*\$(\w+)/g) {

					

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

				
COND_INV_6781_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 6782: 		my ($op, $const) = ($1, $2);
 6783: 		my $val = $self->_module_constants()->{$const};
 6784: 		next unless defined $val;
 6785: 		$p->{type} ||= 'string';
 6786: 		if ($op eq '<') {
 6787: 			$p->{max} = $val - 1;
 6788: 		} elsif ($op eq '<=') {
 6789: 			$p->{max} = $val;
 6790: 		} elsif ($op eq '>') {
 6791: 			$p->{min} = $val + 1;
 6792: 		} elsif ($op eq '>=') {
 6793: 			$p->{min} = $val;
 6794: 		}
 6795: 		$self->_log("  CODE: $param length constraint $op \$$const ($val)");
 6796: 	}
 6797: 
 6798: 	# Numeric range checks (only if NOT part of error guard)
●6799 → 6799 → 6817 6799: 	if (
 6800: 		!$guarded
 6801: 		&& $code =~ /\$$param\s*([<>]=?)\s*([+-]?(?:\d+\.?\d*|\.\d+))/
 6802: 	) {
 6803: 		my ($op, $val) = ($1, $2);
 6804: 		$p->{type} ||= looks_like_number($val) ? 'number' : 'integer';
 6805: 
 6806: 		if ($op eq '<' || $op eq '<=') {
 6807: 			# Only set max if it tightens the range
 6808: 			my $max = ($op eq '<') ? $val - 1 : $val;
 6809: 			$p->{max} = $max if !defined($p->{max}) || $max < $p->{max};
 6810: 		} elsif ($op eq '>' || $op eq '>=') {
 6811: 			my $min = ($op eq '>') ? $val + 1 : $val;
 6812: 			$p->{min} = $min if !defined($p->{min}) || $min > $p->{min};
 6813: 		}
 6814: 	}
 6815: 
 6816: 	# Regex pattern matching with better capture
●6817 → 6817 → 0 6817: 	if ($code =~ /\$$param\s*=~\s*((?:qr?\/[^\/]+\/|\$[\w:]+|\$\{\w+\}))/) {
 6818: 		my $pattern = $1;
 6819: 		$p->{type} ||= 'string';
 6820: 
 6821: 		# Clean up the pattern if it's a straightforward regex
 6822: 		if ($pattern =~ /^qr?\/([^\/]+)\/$/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6823: 			$p->{matches} = "/$1/";
 6824: 		} else {
 6825: 			$p->{matches} = $pattern;
 6826: 		}
 6827: 		$self->_log("  CODE: $param matches pattern: $p->{matches}");
 6828: 	}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6829: }
 6830: 
 6831: # --------------------------------------------------
 6832: # _analyze_parameter_validation
 6833: #

					

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

				
COND_INV_6833_3: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

 6834: # Purpose:    Determine optionality and extract

					

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

				
COND_INV_6834_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 6835: #             default values for a single parameter
 6836: #             by analysing explicit required checks
 6837: #             (die/croak unless defined) and default
 6838: #             assignment patterns in the method body.
 6839: #
 6840: # Entry:      $p_ref - reference to the parameter
 6841: #                      hashref (modified in place).
 6842: #             $param - parameter name string.
 6843: #             $code  - method body source string.
 6844: #
 6845: # Exit:       Returns nothing. Modifies the
 6846: #             referenced parameter hashref.
 6847: #
 6848: # Side effects: Logs detections to stdout when
 6849: #               verbose is set.
 6850: #
 6851: # Notes:      Explicit required checks take highest
 6852: #             priority and override any default
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6853: #             value detected earlier.
 6854: # --------------------------------------------------
 6855: sub _analyze_parameter_validation {

					

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

				
COND_INV_6855_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

●6856 → 6863 → 6868 6856: 	my ($self, $p_ref, $param, $code) = @_;
 6857: 	my $p = $$p_ref;
 6858: 
 6859: 	# Required/optional checks

					

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

				
COND_INV_6859_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 6860: 	my $is_required = 0;
 6861: 
 6862: 	# Die/croak if not defined
 6863: 	if ($code =~ /(?:die|croak|confess)\s+[^;]*unless\s+(?:defined\s+)?\$$param/s) {
 6864: 		$is_required = 1;
 6865: 	}
 6866: 
 6867: 	# Extract default values with the new method
●6868 → 6869 → 6893 6868: 	my $default_value = $self->_extract_default_value($param, $code);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6869: 	if (defined $default_value && !exists $p->{_default}) {
 6870: 		$p->{optional} = 1;
 6871: 		$p->{_default} = $default_value;
 6872: 
 6873: 		# Try to infer type from default value if not already set
 6874: 		unless ($p->{type}) {
 6875: 			if (looks_like_number($default_value)) {
 6876: 				$p->{type} = $default_value =~ /\./ ? 'number' : 'integer';
 6877: 			} elsif (ref($default_value) eq 'ARRAY') {
 6878: 				$p->{type} = 'arrayref';
 6879: 			} elsif (ref($default_value) eq 'HASH') {
 6880: 				$p->{type} = 'hashref';
 6881: 			} elsif ($default_value eq 'undef') {
 6882: 				$p->{type} = 'scalar';	# undef can be any scalar
 6883: 			} elsif (defined $default_value && !ref($default_value)) {
 6884: 				$p->{type} = 'string';
 6885: 			}
 6886: 		}
 6887: 
 6888: 		$self->_log("  CODE: $param has default value: " . (ref($default_value) ? ref($default_value) . ' ref' : $default_value));
 6889: 	}
 6890: 
 6891: 	# Also check for simple default assignment without condition
 6892: 	# Pattern: $param = 'value';
●6893 → 6893 → 6909 6893: 	if (!$default_value && !exists $p->{_default} && $code =~ /\$$param\s*=\s*([^;{}]+?)(?:\s*[;}])/s) {
 6894: 		my $assignment = $1;
 6895: 		# Make sure it's not part of a larger expression
 6896: 		if ($assignment !~ /\$$param/ && $assignment !~ /^shift/) {
 6897: 			my $possible_default = $assignment;
 6898: 			$possible_default =~ s/\s*;\s*$//;
 6899: 			$possible_default = $self->_clean_default_value($possible_default);
 6900: 			if (defined $possible_default) {
 6901: 				$p->{_default} = $possible_default;
 6902: 				$p->{optional} = 1;
 6903: 				$self->_log("  CODE: $param has unconditional default: $possible_default");
 6904: 			}
 6905: 		}
 6906: 	}
 6907: 
 6908: 	# Explicit required check overrides default detection
●6909 → 6909 → 0 6909: 	if ($is_required) {
 6910: 		$p->{optional} = 0;
 6911: 		delete $p->{_default} if exists $p->{_default};
 6912: 		$self->_log("  CODE: $param is required (validation check)");
 6913: 	}
 6914: }
 6915: 
 6916: # --------------------------------------------------
 6917: # _merge_parameter_analyses
 6918: #
 6919: # Purpose:    Merge parameter information from POD,
 6920: #             code, and signature analysis into a
 6921: #             single authoritative parameter hashref
 6922: #             for each parameter.
 6923: #
 6924: # Entry:      $pod - hashref of parameters from POD
 6925: #                    analysis.
 6926: #             $code - hashref of parameters from
 6927: #                     code analysis.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6928: #             $sig  - hashref of parameters from
 6929: #                     signature analysis (optional,
 6930: #                     defaults to empty hashref).
 6931: #
 6932: # Exit:       Returns a merged hashref of parameter
 6933: #             name to spec hashref. Each spec has
 6934: #             all available information combined,
 6935: #             with POD taking highest priority,
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6936: #             code second, and signature filling
 6937: #             remaining gaps.
 6938: #
 6939: # Side effects: Logs merged parameter details to
 6940: #               stdout when verbose is set.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6941: #
 6942: # Notes:      Position is determined by majority
 6943: #             vote across all sources, with the
 6944: #             lowest position winning ties. Optional
 6945: #             status is determined by
 6946: #             _determine_optional_status. Internal
 6947: #             _source keys are stripped from the
 6948: #             merged result.
 6949: # --------------------------------------------------
 6950: sub _merge_parameter_analyses {
●6951 → 6958 → 7017 6951: 	my ($self, $pod, $code, $sig) = @_;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 6952: 
 6953: 	my %merged;
 6954: 
 6955: 	# Start with all parameters from all sources
 6956: 	my %all_params = map { $_ => 1 } (keys %$pod, keys %$code, keys %$sig);
 6957: 
 6958: 	foreach my $param (keys %all_params) {
 6959: 		my $p = $merged{$param} = {};
 6960: 

					

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

				
COND_INV_6960_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 6961: 		# Collect position from all sources
 6962: 		my @positions;
 6963: 		push @positions, $pod->{$param}{position} if $pod->{$param} && defined $pod->{$param}{position};
 6964: 		push @positions, $sig->{$param}{position} if $sig->{$param} && defined $sig->{$param}{position};
 6965: 		push @positions, $code->{$param}{position} if $code->{$param} && defined $code->{$param}{position};
 6966: 
 6967: 		# Use the most common position, or lowest if tie
 6968: 		if (@positions) {
 6969: 			my %pos_count;
 6970: 			$pos_count{$_}++ for @positions;
 6971: 			my ($best_pos) = sort { $pos_count{$b} <=> $pos_count{$a} || $a <=> $b } keys %pos_count;
 6972: 			$p->{position} = $best_pos unless(exists($p->{position}));
 6973: 		}
 6974: 
 6975: 		# POD has highest priority for type info and explicit declarations
 6976: 		if ($pod->{$param}) {

					

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

				
COND_INV_6976_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 6977: 			%$p = (%$p, %{$pod->{$param}});
 6978: 		}
 6979: 
 6980: 		# Code analysis adds concrete evidence (but doesn't override POD explicit types)
 6981: 		if ($code->{$param}) {
 6982: 			foreach my $key (keys %{$code->{$param}}) {
 6983: 				next if $key eq '_source';
 6984: 				next if $key eq 'position';
 6985: 				# Formal input-spec declared this param without a type — author
 6986: 				# intentionally left it unconstrained; don't let code heuristics
  Mutants (Total: 2, Killed: 2, Survived: 0)
 6987: 				# silently fill in a type that would cause wrong-type die tests.
 6988: 				next if $key eq 'type' && $pod->{$param} && $pod->{$param}{_from_input_spec} && !defined $pod->{$param}{type};
 6989: 
 6990: 				# Only override if POD didn't provide this info or it's a stronger signal
 6991: 				my $from_pod = exists $pod->{$param};
 6992: 				if (!exists $p->{$key} ||
 6993: 				   ($key eq 'type' && $from_pod && $p->{type} eq 'string' &&
 6994: 				   $code->{$param}{$key} ne 'string')) {
 6995: 					$p->{$key} = $code->{$param}{$key};
 6996: 				}
 6997: 			}
 6998: 		}
 6999: 
 7000: 		# Signature fills in remaining gaps
 7001: 		if ($sig->{$param}) {
 7002: 			foreach my $key (keys %{$sig->{$param}}) {
 7003: 				next if $key eq '_source';
 7004: 				next if $key eq 'position';
 7005: 				$p->{$key} //= $sig->{$param}{$key};
 7006: 			}
 7007: 		}
 7008: 
 7009: 		# Handle optional field with better logic
 7010: 		$self->_determine_optional_status($p, $pod->{$param}, $code->{$param});
 7011: 
 7012: 		# Clean up internal fields
 7013: 		delete $p->{_source};
 7014: 	}
 7015: 
 7016: 	# Debug logging
●7017 → 7017 → 7027 7017: 	if ($self->{verbose}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7018: 		foreach my $param (sort { ($merged{$a}{position} || 999) <=> ($merged{$b}{position} || 999) } keys %merged) {
 7019: 			my $p = $merged{$param};
 7020: 			$self->_log("  MERGED $param: " .
 7021: 					'pos=' . ($p->{position} || 'none') .
 7022: 					", type=" . ($p->{type} || 'none') .
 7023: 					", optional=" . (defined($p->{optional}) ? $p->{optional} : 'undef'));
 7024: 		}
 7025: 	}
  Mutants (Total: 3, Killed: 3, Survived: 0)
 7026: 
 7027: 	return \%merged;
 7028: }
 7029: 
 7030: # --------------------------------------------------
 7031: # _determine_optional_status
 7032: #
 7033: # Purpose:    Set the optional field on a merged
 7034: #             parameter spec based on evidence from
 7035: #             POD and code analysis, with POD taking
 7036: #             highest priority.
 7037: #
 7038: # Entry:      $merged_param - the merged parameter
 7039: #                             hashref (modified in
 7040: #                             place).
 7041: #             $pod_param    - parameter spec from
 7042: #                             POD analysis, or undef.
 7043: #             $code_param   - parameter spec from
 7044: #                             code analysis, or undef.
 7045: #
 7046: # Exit:       Returns nothing. Sets or leaves
 7047: #             $merged_param->{optional}.
 7048: #
 7049: # Side effects: None.
 7050: # --------------------------------------------------
 7051: sub _determine_optional_status {
●7052 → 7058 → 0 7052: 	my ($self, $merged_param, $pod_param, $code_param) = @_;
 7053: 
 7054: 	my $pod_optional = $pod_param ? $pod_param->{optional} : undef;
 7055: 	my $code_optional = $code_param ? $code_param->{optional} : undef;
 7056: 
 7057: 	# Explicit POD declaration wins
 7058: 	if (defined $pod_optional) {
 7059: 		$merged_param->{optional} = $pod_optional;
 7060: 	}
 7061: 	# Code validation evidence
 7062: 	elsif (defined $code_optional) {
 7063: 		$merged_param->{optional} = $code_optional;
 7064: 	}
 7065: 	# Default: if we have any info about the param, assume required
 7066: 	elsif (keys %$merged_param > 0) {
 7067: 		$merged_param->{optional} = 0;
 7068: 	}
 7069: 	# Otherwise leave undef (unknown)
 7070: }
 7071: 
 7072: 
 7073: # --------------------------------------------------
 7074: # _calculate_input_confidence
 7075: #
 7076: # Purpose:    Calculate a confidence score and level
 7077: #             for the input parameter analysis,
 7078: #             based on how much type, constraint,
 7079: #             and semantic information was inferred
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7080: #             for each parameter.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7081: #
 7082: # Entry:      $params - hashref of merged parameter
 7083: #                       specs as produced by
 7084: #                       _merge_parameter_analyses.
 7085: #
 7086: # Exit:       Returns a hashref with keys:
 7087: #               level         - one of: none,
 7088: #                               very_low, low,
 7089: #                               medium, high
 7090: #               score         - numeric average
 7091: #                               across all params
 7092: #               factors       - arrayref of
 7093: #                               human-readable
 7094: #                               factor strings
 7095: #               per_parameter - hashref of per-
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7096: #                               parameter score
 7097: #                               and factor detail
 7098: #             Returns { level => 'none', ... } if
 7099: #             no parameters were found.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7100: #
 7101: # Side effects: None.
 7102: # --------------------------------------------------
 7103: sub _calculate_input_confidence {
  Mutants (Total: 1, Killed: 1, Survived: 0)
●7104 → 7114 → 7184 7104: 	my ($self, $params) = @_;
 7105: 
 7106: 	my @factors;  # Track all confidence factors
 7107: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7108: 	return { level => 'none', factors => ['No parameters found'] } unless keys %$params;
 7109: 
 7110: 	my $total_score = 0;
 7111: 	my $count = 0;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7112: 	my %param_details;	# Store per-parameter analysis
 7113: 
 7114: 	foreach my $param (keys %$params) {
 7115: 		my $p = $params->{$param};
 7116: 		my $score = 0;
 7117: 		my @param_factors;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7118: 
 7119: 		# Type information
 7120: 		if ($p->{type}) {
 7121: 			if ($p->{type} eq 'string' && ($p->{min} || $p->{max} || $p->{matches})) {
 7122: 				$score += 25;
 7123: 				push @param_factors, "Type: constrained string (+25)";
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7124: 			} elsif ($p->{type} eq 'string') {
 7125: 				$score += 10;
 7126: 				push @param_factors, "Type: plain string (+10)";
 7127: 			} else {
 7128: 				$score += 30;
 7129: 				push @param_factors, "Type: $p->{type} (+30)";
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7130: 			}
 7131: 		} else {
 7132: 			push @param_factors, "No type information (-0)";
 7133: 		}
 7134: 
 7135: 		# Constraints
 7136: 		if (defined $p->{min}) {
 7137: 			$score += 15;
 7138: 			push @param_factors, 'Has min constraint (+15)';
 7139: 		}
 7140: 		if (defined $p->{max}) {
 7141: 			$score += 15;
 7142: 			push @param_factors, "Has max constraint (+15)";
 7143: 		}
 7144: 		if (defined $p->{optional}) {
 7145: 			$score += 20;
 7146: 			push @param_factors, "Optional/required explicitly defined (+20)";
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7147: 		}
 7148: 		if ($p->{matches}) {
 7149: 			$score += 20;
 7150: 			push @param_factors, 'Has regex pattern constraint (+20)';
 7151: 		}
 7152: 		if ($p->{isa}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7153: 			$score += 25;
 7154: 			push @param_factors, "Specific class constraint: $p->{isa} (+25)";
 7155: 		}
 7156: 
 7157: 		# Position information
  Mutants (Total: 4, Killed: 4, Survived: 0)
 7158: 		if (defined $p->{position}) {
 7159: 			$score += 10;
 7160: 			push @param_factors, "Position defined: $p->{position} (+10)";
 7161: 		}
 7162: 
 7163: 		# Default value
 7164: 		if (exists $p->{_default}) {
 7165: 			$score += 10;
 7166: 			push @param_factors, "Has default value (+10)";

					

					
Mutants (Total: 4, Killed: 1, Survived: 3)
					

				
NUM_BOUNDARY_7166_11_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_7166_11_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_7166_11_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 7167: 		}
 7168: 
 7169: 		# Semantic information

					

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

				
NUM_BOUNDARY_7169_16_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_7169_16_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_7169_16_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 7170: 		if ($p->{semantic}) {
 7171: 			$score += 15;
 7172: 			push @param_factors, "Semantic type: $p->{semantic} (+15)";

					

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

				
NUM_BOUNDARY_7172_16_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_7172_16_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_7172_16_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 7173: 		}
 7174: 
 7175: 		$param_details{$param} = {
 7176: 			score => $score,
 7177: 			factors => \@param_factors
 7178: 		};
 7179: 
 7180: 		$total_score += $score;
 7181: 		$count++;
 7182: 	}
 7183: 
●7184 → 7193 → 7206 7184: 	my $avg = $count ? ($total_score / $count) : 0;
 7185: 
 7186: 	# Build summary factors
 7187: 	push @factors, sprintf("Analyzed %d parameter%s", $count, $count == 1 ? '' : 's');
 7188: 	push @factors, sprintf("Average confidence score: %.1f", $avg);
 7189: 
 7190: 	# Add top contributing factors
 7191: 	my @sorted_params = sort { $param_details{$b}{score} <=> $param_details{$a}{score} } keys %param_details;
 7192: 
 7193: 	if (@sorted_params) {
 7194: 		my $highest = $sorted_params[0];
 7195: 		my $highest_score = $param_details{$highest}{score};
 7196: 		push @factors, sprintf("Highest scoring parameter: \$$highest (score: %d)", $highest_score);
 7197: 
 7198: 		if (@sorted_params > 1) {
 7199: 			my $lowest = $sorted_params[-1];
 7200: 			my $lowest_score = $param_details{$lowest}{score};
 7201: 			push @factors, sprintf("Lowest scoring parameter: \$$lowest (score: %d)", $lowest_score);
 7202: 		}
 7203: 	}
 7204: 
 7205: 	# Determine confidence level
●7206 → 7207 → 7221 7206: 	my $level;
 7207: 	if ($avg >= $CONFIDENCE_HIGH_THRESHOLD) {
 7208: 		$level = $LEVEL_HIGH;
 7209: 		push @factors, "High confidence: comprehensive type and constraint information";
 7210: 	} elsif ($avg >= $CONFIDENCE_MEDIUM_THRESHOLD) {
 7211: 		$level = $LEVEL_MEDIUM;
 7212: 		push @factors, "Medium confidence: some type or constraint information present";
 7213: 	} elsif ($avg >= $CONFIDENCE_LOW_THRESHOLD) {
 7214: 		$level = $LEVEL_LOW;
 7215: 		push @factors, "Low confidence: minimal type information";
 7216: 	} else {
 7217: 		$level = $LEVEL_VERY_LOW;
 7218: 		push @factors, "Very low confidence: little to no type information";
 7219: 	}
 7220: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7221: 	return {
 7222: 		level => $level,
 7223: 		score => $avg,
 7224: 		factors => \@factors,
 7225: 		per_parameter => \%param_details
 7226: 	};
 7227: }
 7228: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7229: # --------------------------------------------------
 7230: # _calculate_output_confidence
 7231: #
 7232: # Purpose:    Calculate a confidence score and level
 7233: #             for the output analysis based on how
 7234: #             much return type, value, class,
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7235: #             context, and error convention
 7236: #             information was determined.
 7237: #
 7238: # Entry:      $output - the output hashref as built
 7239: #                       by _analyze_output.
 7240: #
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7241: # Exit:       Returns a hashref with keys:
 7242: #               level   - one of: none, very_low,
 7243: #                         low, medium, high
 7244: #               score   - numeric confidence score

					

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

				
COND_INV_7244_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 7245: #               factors - arrayref of factor strings
 7246: #             Returns { level => 'none', ... } if
 7247: #             output is empty.

					

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

				
COND_INV_7247_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 7248: #
 7249: # Side effects: None.
 7250: # --------------------------------------------------
 7251: sub _calculate_output_confidence {
●7252 → 7261 → 7269 7252: 	my ($self, $output) = @_;
 7253: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7254: 	my @factors;
 7255: 
 7256: 	return { level => 'none', factors => ['No return information found'] } unless keys %$output;
 7257: 
 7258: 	my $score = 0;
 7259: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7260: 	# Type information
 7261: 	if ($output->{type}) {
 7262: 		$score += 30;
 7263: 		push @factors, "Return type defined: $output->{type} (+30)";
 7264: 	} else {
 7265: 		push @factors, 'No return type information (-0)';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7266: 	}
 7267: 
 7268: 	# Specific value known
●7269 → 7269 → 7275 7269: 	if (defined $output->{value}) {
 7270: 		$score += 30;
 7271: 		push @factors, "Specific return value: $output->{value} (+30)";
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7272: 	}
 7273: 
 7274: 	# Class information for objects
●7275 → 7275 → 7281 7275: 	if ($output->{isa}) {
 7276: 		$score += 30;
 7277: 		push @factors, "Returns specific class: $output->{isa} (+30)";
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7278: 	}
 7279: 
 7280: 	# Context-aware returns
●7281 → 7281 → 7294 7281: 	if ($output->{_context_aware}) {
 7282: 		$score += 20;
 7283: 		push @factors, "Context-aware return (wantarray) (+20)";
 7284: 
 7285: 		if ($output->{_list_context}) {
 7286: 			push @factors, "  List context: $output->{_list_context}{type}";
  Mutants (Total: 4, Killed: 4, Survived: 0)
 7287: 		}
 7288: 		if ($output->{_scalar_context}) {
 7289: 			push @factors, "  Scalar context: $output->{_scalar_context}{type}";

					

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

				
NUM_BOUNDARY_7289_18_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_7289_18_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_7289_18_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 7290: 		}
 7291: 	}
 7292: 
  Mutants (Total: 3, Killed: 3, Survived: 0)
 7293: 	# Error handling information
●7294 → 7294 → 7300 7294: 	if ($output->{_error_return}) {
 7295: 		$score += 15;
 7296: 		push @factors, "Error return convention documented: $output->{_error_return} (+15)";
 7297: 	}
 7298: 
 7299: 	# Success/failure pattern
●7300 → 7300 → 7306 7300: 	if ($output->{_success_failure_pattern}) {
 7301: 		$score += 10;
 7302: 		push @factors, 'Success/failure pattern detected (+10)';
 7303: 	}
 7304: 
 7305: 	# Chainable methods
●7306 → 7306 → 7312 7306: 	if ($output->{_returns_self}) {
 7307: 		$score += 15;
 7308: 		push @factors, "Chainable method (fluent interface) (+15)";
 7309: 	}
 7310: 
 7311: 	# Void context
●7312 → 7312 → 7318 7312: 	if ($output->{_void_context}) {
 7313: 		$score += 20;
 7314: 		push @factors, "Void context method (no meaningful return) (+20)";
 7315: 	}
 7316: 
 7317: 	# Exception handling
●7318 → 7318 → 7323 7318: 	if ($output->{_error_handling} && $output->{_error_handling}{exception_handling}) {
 7319: 		$score += 10;
 7320: 		push @factors, 'Exception handling present (+10)';
 7321: 	}
 7322: 
●7323 → 7327 → 7341 7323: 	push @factors, sprintf("Total output confidence score: %d", $score);
 7324: 
 7325: 	# Determine confidence level
 7326: 	my $level;
 7327: 	if ($score >= $CONFIDENCE_HIGH_THRESHOLD) {
 7328: 		$level = $LEVEL_HIGH;
 7329: 		push @factors, "High confidence: detailed return type and behavior";
 7330: 	} elsif ($score >= $CONFIDENCE_MEDIUM_THRESHOLD) {
 7331: 		$level = $LEVEL_MEDIUM;
 7332: 		push @factors, "Medium confidence: return type defined";
 7333: 	} elsif ($score >= $CONFIDENCE_LOW_THRESHOLD) {
 7334: 		$level = $LEVEL_LOW;
 7335: 		push @factors, "Low confidence: minimal return information";
 7336: 	} else {
 7337: 		$level = $LEVEL_VERY_LOW;
 7338: 		push @factors, 'Very low confidence: little return information';
 7339: 	}
 7340: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7341: 	return {
 7342: 		level => $level,
 7343: 		score => $score,
 7344: 		factors => \@factors
 7345: 	};
 7346: }
 7347: 
 7348: # --------------------------------------------------
 7349: # _generate_confidence_report
 7350: #
 7351: # Purpose:    Generate a human-readable text report
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7352: #             of all confidence factors for a
 7353: #             schema, for debugging and review
 7354: #             purposes.
 7355: #
 7356: # Entry:      $schema - schema hashref containing
 7357: #                       a populated _analysis key.
 7358: #
 7359: # Exit:       Returns a multi-line string report,
 7360: #             or nothing if $schema->{_analysis}

					

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

				
COND_INV_7360_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 7361: #             is absent.
 7362: #
 7363: # Side effects: None.
 7364: # --------------------------------------------------
 7365: sub _generate_confidence_report
 7366: {
●7367 → 7381 → 7392 7367: 	my ($self, $schema) = @_;
 7368: 
 7369: 	return unless $schema->{_analysis};
 7370: 
 7371: 	my $analysis = $schema->{_analysis};
 7372: 	my @report;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 7373: 
 7374: 	push @report, "Confidence Analysis for " . ($schema->{method_name} || 'method');
 7375: 	push @report, '=' x 60;
 7376: 	push @report, '';
 7377: 
 7378: 	push @report, "Overall Confidence: " . uc($analysis->{overall_confidence});
 7379: 	push @report, '';
 7380: 
 7381: 	if ($analysis->{confidence_factors}{input}) {
 7382: 		push @report, (
 7383: 			"Input Parameters:",
 7384: 			 "  Confidence Level: " . uc($analysis->{input_confidence})
 7385: 		);
 7386: 		foreach my $factor (@{$analysis->{confidence_factors}{input}}) {
 7387: 			push @report, "  - $factor";
 7388: 		}
 7389: 		push @report, '';
 7390: 	}
 7391: 
●7392 → 7392 → 7401 7392: 	if ($analysis->{confidence_factors}{output}) {
 7393: 		push @report, 'Return Value:',
 7394: 			"  Confidence Level: " . uc($analysis->{output_confidence});
 7395: 		foreach my $factor (@{$analysis->{confidence_factors}{output}}) {
 7396: 			push @report, "  - $factor";
 7397: 		}
 7398: 		push @report, '';
 7399: 	}
 7400: 
●7401 → 7401 → 7413 7401: 	if ($analysis->{per_parameter_scores}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7402: 		push @report, 'Per-Parameter Analysis:';
 7403: 		foreach my $param (sort keys %{$analysis->{per_parameter_scores}}) {
 7404: 			my $details = $analysis->{per_parameter_scores}{$param};
 7405: 			push @report, "  \$$param (score: $details->{score}):";

					

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

				
COND_INV_7405_3: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

 7406: 			foreach my $factor (@{$details->{factors}}) {
 7407: 				push @report, "    - $factor";
 7408: 			}
 7409: 		}
 7410: 		push @report, '';
 7411: 	}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 7412: 
 7413: 	return join("\n", @report);
 7414: }
 7415: 
 7416: # --------------------------------------------------
 7417: # _generate_notes
 7418: #
 7419: # Purpose:    Generate human-readable advisory notes
 7420: #             about parameters whose type or
 7421: #             optionality could not be determined,
 7422: #             to guide manual schema review.
 7423: #
 7424: # Entry:      $params - hashref of merged parameter
 7425: #                       specs.
 7426: #
 7427: # Exit:       Returns an arrayref of note strings.
 7428: #             Returns an empty arrayref if all
 7429: #             parameters have known types and
 7430: #             optionality.
 7431: #
 7432: # Side effects: None.
 7433: # --------------------------------------------------
 7434: sub _generate_notes {
●7435 → 7439 → 7452 7435: 	my ($self, $params) = @_;
 7436: 
 7437: 	my @notes;
 7438: 
 7439: 	foreach my $param (keys %$params) {
 7440: 		my $p = $params->{$param};
 7441: 
 7442: 		unless ($p->{type}) {
 7443: 			push @notes, "$param: type unknown - please review - will set to 'string' as a default";
 7444: 		}
 7445: 
 7446: 		unless (defined $p->{optional}) {
 7447: 			push @notes, "$param: optional status unknown";
 7448: 			# Don't automatically set - let it be undef if we don't know
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7449: 		}
 7450: 	}
 7451: 
 7452: 	return \@notes;
 7453: }
 7454: 
 7455: # --------------------------------------------------
 7456: # _set_defaults
 7457: #
 7458: # Purpose:    Apply default type values to any
 7459: #             parameters in a schema mode (input
 7460: #             or output) whose type was not set
 7461: #             during analysis, setting them to
 7462: #             'string' as a conservative fallback.
 7463: #
 7464: # Entry:      $schema - the schema hashref being
 7465: #                       built by _analyze_method.
 7466: #             $mode   - either 'input' or 'output'.
 7467: #
 7468: # Exit:       Returns nothing. Modifies $schema in
 7469: #             place by setting type => 'string' on
 7470: #             any parameter that lacks a type, and
 7471: #             downgrading input confidence to 'low'.
 7472: #
 7473: # Side effects: Logs type defaulting to stdout when
 7474: #               verbose is set.
 7475: #
 7476: # Notes:      Called after all analysis is complete
 7477: #             so that genuine type unknowns can be
 7478: #             distinguished from analysis gaps.
 7479: # --------------------------------------------------
 7480: sub _set_defaults {
●7481 → 7485 → 0 7481: 	my ($self, $schema, $mode) = @_;
 7482: 
 7483: 	my $params = $schema->{$mode};
 7484: 
 7485: 	foreach my $param (keys %$params) {
 7486: 		my $p = $params->{$param};
 7487: 
 7488: 		next unless(ref($p) eq 'HASH');
 7489: 		unless ($p->{type}) {
 7490: 			$self->_log("  DEBUG {$mode}{$param}: Setting to 'string' as a default");
 7491: 			$p->{'type'} = 'string';
 7492: 			$schema->{_confidence}{$mode}->{level} = 'low';	# Setting a default means it's a guess
 7493: 		}
 7494: 	}
 7495: }
 7496: 
 7497: # --------------------------------------------------
 7498: # _analyze_relationships
 7499: #
 7500: # Purpose:    Detect inter-parameter relationships
 7501: #             in a method's source code, including
 7502: #             mutually exclusive parameters, required
 7503: #             groups, conditional requirements,
 7504: #             dependencies, and value-based
 7505: #             constraints.
 7506: #
 7507: # Entry:      $method - method hashref containing
 7508: #                       at minimum a 'body' key
 7509: #                       with the source string.
 7510: #
 7511: # Exit:       Returns an arrayref of relationship
 7512: #             hashrefs. Returns an empty arrayref
 7513: #             if no parameters or no relationships
 7514: #             are found.
 7515: #
 7516: # Side effects: Logs detections to stdout when
 7517: #               verbose is set.
 7518: #
 7519: # Notes:      Parameter names are extracted via
  Mutants (Total: 2, Killed: 2, Survived: 0)
 7520: #             _extract_parameters_from_signature, so
 7521: #             every style it supports -- my (...) =
 7522: #             @_, shift-style (my $x = shift), direct-
 7523: #             index ($_[N]), and modern signatures --
 7524: #             is analysed for relationships, not just
 7525: #             the my (...) = @_ list-assignment form.
 7526: # --------------------------------------------------
 7527: sub _analyze_relationships {
 7528: 	my ($self, $method) = @_;
 7529: 
 7530: 	my $code = $method->{body};
 7531: 	my @relationships;
 7532: 
 7533: 	# Extract all parameter names from the method, using the same
 7534: 	# multi-style detection used for schema population so shift-style
 7535: 	# and modern-signature methods get relationship analysis too
 7536: 	my %params;
 7537: 	$self->_extract_parameters_from_signature(\%params, $code);
 7538: 	my @param_names = sort { $params{$a}{position} <=> $params{$b}{position} } keys %params;
 7539: 
 7540: 	return [] unless @param_names;
 7541: 
 7542: 	# Detect mutually exclusive parameters
 7543: 	push @relationships, @{$self->_detect_mutually_exclusive($code, \@param_names)};
 7544: 
 7545: 	# Detect required groups (OR logic)
 7546: 	push @relationships, @{$self->_detect_required_groups($code, \@param_names)};
 7547: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7548: 	# Detect conditional requirements (IF-THEN)
 7549: 	push @relationships, @{$self->_detect_conditional_requirements($code, \@param_names)};
 7550: 
 7551: 	# Detect dependencies
 7552: 	push @relationships, @{$self->_detect_dependencies($code, \@param_names)};
 7553: 
 7554: 	# Detect value-based constraints
 7555: 	push @relationships, @{$self->_detect_value_constraints($code, \@param_names)};
 7556: 
 7557: 	# Deduplicate relationships
 7558: 	my @unique = $self->_deduplicate_relationships(\@relationships);
 7559: 
 7560: 	return \@unique;
 7561: }
 7562: 
 7563: # --------------------------------------------------
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7564: # _deduplicate_relationships
 7565: #
 7566: # Purpose:    Remove duplicate relationship entries
 7567: #             from the relationships list by
 7568: #             computing a canonical signature for
  Mutants (Total: 2, Killed: 2, Survived: 0)
 7569: #             each relationship type.
 7570: #
 7571: # Entry:      $relationships - arrayref of
 7572: #                              relationship hashrefs.
 7573: #
 7574: # Exit:       Returns a deduplicated list of
 7575: #             relationship hashrefs.
 7576: #
 7577: # Side effects: None.
 7578: # --------------------------------------------------
 7579: sub _deduplicate_relationships {
●7580 → 7585 → 7609 7580: 	my ($self, $relationships) = @_;
 7581: 
 7582: 	my @unique;
 7583: 	my %seen;
 7584: 
 7585: 	foreach my $rel (@$relationships) {
 7586: 		# Create a signature for this relationship
 7587: 		my $sig;
 7588: 		if ($rel->{type} eq 'mutually_exclusive') {
 7589: 			$sig = join(':', 'mutex', sort @{$rel->{params}});
 7590: 		} elsif ($rel->{type} eq 'required_group') {
 7591: 			$sig = join(':', 'reqgroup', sort @{$rel->{params}});
 7592: 		} elsif ($rel->{type} eq 'conditional_requirement') {
 7593: 			$sig = join(':', 'condreq', $rel->{if}, $rel->{then_required});
 7594: 		} elsif ($rel->{type} eq 'dependency') {
 7595: 			$sig = join(':', 'dep', $rel->{param}, $rel->{requires});
 7596: 		} elsif ($rel->{type} eq 'value_constraint') {
 7597: 			$sig = join(':', 'valcon', $rel->{if}, $rel->{then}, $rel->{operator}, $rel->{value});
 7598: 		} elsif ($rel->{type} eq 'value_conditional') {
 7599: 			$sig = join(':', 'valcond', $rel->{if}, $rel->{equals}, $rel->{then_required});
 7600: 		} else {
 7601: 			$sig = join(':', $rel->{type}, %$rel);
 7602: 		}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7603: 
 7604: 		unless ($seen{$sig}++) {
 7605: 			push @unique, $rel;
 7606: 		}
 7607: 	}
 7608: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7609: 	return @unique;
 7610: }
 7611: 
 7612: # --------------------------------------------------
 7613: # _detect_mutually_exclusive
 7614: #
 7615: # Purpose:    Detect pairs of parameters that cannot
 7616: #             be specified together, by searching
 7617: #             for die/croak/confess patterns
 7618: #             that fire when both are truthy.
 7619: #
 7620: # Entry:      $code        - method body source string.
 7621: #             $param_names - arrayref of parameter
 7622: #                            name strings.
 7623: #
 7624: # Exit:       Returns an arrayref of relationship
 7625: #             hashrefs of type 'mutually_exclusive'.
 7626: #             Returns an empty arrayref if none found.
 7627: #
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7628: # Side effects: Logs detections to stdout when
 7629: #               verbose is set.
 7630: # --------------------------------------------------
 7631: sub _detect_mutually_exclusive {
●7632 → 7638 → 7693 7632: 	my ($self, $code, $param_names) = @_;

					

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

				
COND_INV_7632_6: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 7633: 
 7634: 	my @relationships;
 7635: 
 7636: 	# Pattern 1: die/croak if $x && $y
 7637: 	# Look for: die/croak ... if $param1 && $param2
 7638: 	foreach my $param1 (@$param_names) {
 7639: 		foreach my $param2 (@$param_names) {
 7640: 			next if $param1 eq $param2;
 7641: 
 7642: 			# Check various patterns
 7643: 			if ($code =~ /(?:die|croak|confess)[^;]*if\s+\$$param1\s+&&\s+\$$param2/ ||
 7644: 			    $code =~ /(?:die|croak|confess)[^;]*if\s+\$$param2\s+&&\s+\$$param1/) {
 7645: 
 7646: 				# Avoid duplicates (param1,param2 vs param2,param1)
 7647: 				my $found_reverse = 0;
 7648: 				foreach my $rel (@relationships) {
 7649: 					if ($rel->{type} eq 'mutually_exclusive' &&
 7650: 					    (($rel->{params}[0] eq $param2 && $rel->{params}[1] eq $param1))) {
 7651: 						$found_reverse = 1;
 7652: 						last;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 7653: 					}
 7654: 				}
 7655: 
 7656: 				next if $found_reverse;
 7657: 
 7658: 				push @relationships, {
 7659: 					type => 'mutually_exclusive',
 7660: 					params => [$param1, $param2],
 7661: 					description => "Cannot specify both $param1 and $param2"
 7662: 				};
 7663: 
 7664: 				$self->_log("  RELATIONSHIP: $param1 and $param2 are mutually exclusive");
 7665: 			}
 7666: 
 7667: 			# Pattern 2: die "Cannot specify both X and Y"
 7668: 			if ($code =~ /(?:die|croak|confess)\s+['"](Cannot|Can't)[^'"]*both[^'"]*$param1[^'"]*$param2/i ||
 7669: 			    $code =~ /(?:die|croak|confess)\s+['"](Cannot|Can't)[^'"]*both[^'"]*$param2[^'"]*$param1/i) {
 7670: 
 7671: 				my $found_reverse = 0;
 7672: 				foreach my $rel (@relationships) {
 7673: 					if ($rel->{type} eq 'mutually_exclusive' &&
 7674: 					    (($rel->{params}[0] eq $param2 && $rel->{params}[1] eq $param1))) {
 7675: 						$found_reverse = 1;
 7676: 						last;
 7677: 					}
 7678: 				}
 7679: 
 7680: 				next if $found_reverse;
 7681: 
 7682: 				push @relationships, {
 7683: 					type => 'mutually_exclusive',
 7684: 					params => [$param1, $param2],
 7685: 					description => "Cannot specify both $param1 and $param2"
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7686: 				};
 7687: 
 7688: 				$self->_log("  RELATIONSHIP: $param1 and $param2 are mutually exclusive (from error message)");
 7689: 			}
 7690: 		}
 7691: 	}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7692: 
 7693: 	return \@relationships;
 7694: }
 7695: 
 7696: # --------------------------------------------------
 7697: # _detect_required_groups
 7698: #
 7699: # Purpose:    Detect parameter groups where at least
 7700: #             one parameter must be specified (OR
 7701: #             logic), by searching for die/croak
 7702: #             patterns that fire unless any of the
 7703: #             group is truthy.
 7704: #
 7705: # Entry:      $code        - method body source string.
 7706: #             $param_names - arrayref of parameter
 7707: #                            name strings.
 7708: #
 7709: # Exit:       Returns an arrayref of relationship
 7710: #             hashrefs of type 'required_group'.
 7711: #             Returns an empty arrayref if none found.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7712: #
 7713: # Side effects: Logs detections to stdout when
 7714: #               verbose is set.
 7715: # --------------------------------------------------
 7716: sub _detect_required_groups {

					

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

				
COND_INV_7716_6: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

●7717 → 7722 → 7778 7717: 	my ($self, $code, $param_names) = @_;
 7718: 
 7719: 	my @relationships;
 7720: 
 7721: 	# Pattern 1: die/croak unless $x || $y
 7722: 	foreach my $param1 (@$param_names) {
 7723: 		foreach my $param2 (@$param_names) {
 7724: 			next if $param1 eq $param2;
 7725: 
 7726: 			if ($code =~ /(?:die|croak|confess)[^;]*unless\s+\$$param1\s+\|\|\s+\$$param2/ ||
 7727: 			    $code =~ /(?:die|croak|confess)[^;]*unless\s+\$$param2\s+\|\|\s+\$$param1/) {
 7728: 
 7729: 				# Avoid duplicates
 7730: 				my $found_reverse = 0;
 7731: 				foreach my $rel (@relationships) {
 7732: 					if ($rel->{type} eq 'required_group' &&
 7733: 					    (($rel->{params}[0] eq $param2 && $rel->{params}[1] eq $param1))) {
 7734: 						$found_reverse = 1;
 7735: 						last;
 7736: 					}
 7737: 				}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 7738: 
 7739: 				next if $found_reverse;
 7740: 
 7741: 				push @relationships, {
 7742: 					type => 'required_group',
 7743: 					params => [$param1, $param2],
 7744: 					logic => 'or',
 7745: 					description => "Must specify either $param1 or $param2"
 7746: 				};
 7747: 
 7748: 				$self->_log("  RELATIONSHIP: Must specify either $param1 or $param2");
 7749: 			}
 7750: 
 7751: 			# Pattern 2: die "Must specify either X or Y"
 7752: 			if ($code =~ /(?:die|croak|confess)\s+['"]Must\s+specify\s+either[^'"]*$param1[^'"]*or[^'"]*$param2/i ||
 7753: 			    $code =~ /(?:die|croak|confess)\s+['"]Must\s+specify\s+either[^'"]*$param2[^'"]*or[^'"]*$param1/i) {
 7754: 
 7755: 				my $found_reverse = 0;
 7756: 				foreach my $rel (@relationships) {
 7757: 					if ($rel->{type} eq 'required_group' &&
 7758: 					    (($rel->{params}[0] eq $param2 && $rel->{params}[1] eq $param1))) {
 7759: 						$found_reverse = 1;
 7760: 						last;
 7761: 					}
 7762: 				}
 7763: 
 7764: 				next if $found_reverse;
 7765: 
 7766: 				push @relationships, {
 7767: 					type => 'required_group',
 7768: 					params => [$param1, $param2],
 7769: 					logic => 'or',
 7770: 					description => "Must specify either $param1 or $param2"
 7771: 				};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7772: 
 7773: 				$self->_log("  RELATIONSHIP: Must specify either $param1 or $param2 (from error message)");
 7774: 			}
 7775: 		}
 7776: 	}
 7777: 
 7778: 	return \@relationships;
 7779: }
 7780: 
 7781: # --------------------------------------------------
 7782: # _detect_conditional_requirements
 7783: #
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7784: # Purpose:    Detect IF-THEN parameter relationships
 7785: #             where one parameter being present
 7786: #             makes another required, by searching
 7787: #             for die/croak patterns of the form
 7788: #             'die if $x && !$y'.
 7789: #
 7790: # Entry:      $code        - method body source string.
 7791: #             $param_names - arrayref of parameter
 7792: #                            name strings.
 7793: #
 7794: # Exit:       Returns an arrayref of relationship
 7795: #             hashrefs of type
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7796: #             'conditional_requirement'.
 7797: #             Returns an empty arrayref if none found.
 7798: #
 7799: # Side effects: Logs detections to stdout when
 7800: #               verbose is set.
 7801: # --------------------------------------------------
 7802: sub _detect_conditional_requirements {
●7803 → 7807 → 7849 7803: 	my ($self, $code, $param_names) = @_;
 7804: 
 7805: 	my @relationships;
 7806: 
 7807: 	foreach my $param1 (@$param_names) {
 7808: 		foreach my $param2 (@$param_names) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 7809: 			next if $param1 eq $param2;
 7810: 
 7811: 			# Pattern 1: die if $x && !$y  (if x then y required)
 7812: 			if ($code =~ /(?:die|croak|confess)[^;]*if\s+\$$param1\s+&&\s+!\$$param2/) {
 7813: 				push @relationships, {
 7814: 					type => 'conditional_requirement',
 7815: 					if => $param1,
 7816: 					then_required => $param2,
 7817: 					description => "When $param1 is specified, $param2 is required"
 7818: 				};
 7819: 
 7820: 				$self->_log("  RELATIONSHIP: $param1 requires $param2");
 7821: 			}
 7822: 
 7823: 			# Pattern 2: die if $x && !defined($y)
 7824: 			if ($code =~ /(?:die|croak|confess)[^;]*if\s+\$$param1\s+&&\s+!defined\s*\(\s*\$$param2\s*\)/) {
 7825: 				push @relationships, {
 7826: 					type => 'conditional_requirement',
 7827: 					if => $param1,
 7828: 					then_required => $param2,
 7829: 					description => "When $param1 is specified, $param2 is required"
 7830: 				};
 7831: 
 7832: 				$self->_log("  RELATIONSHIP: $param1 requires $param2 (defined check)");
 7833: 			}
 7834: 
 7835: 			# Pattern 3: Error message "X requires Y"
 7836: 			if ($code =~ /(?:die|croak|confess)\s+['"]\w*$param1[^'"]*requires[^'"]*$param2/i) {
 7837: 				push @relationships, {
 7838: 					type => 'conditional_requirement',
 7839: 					if => $param1,
 7840: 					then_required => $param2,
 7841: 					description => "When $param1 is specified, $param2 is required"
 7842: 				};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7843: 
 7844: 				$self->_log("  RELATIONSHIP: $param1 requires $param2 (from error message)");
 7845: 			}
 7846: 		}
 7847: 	}
 7848: 
 7849: 	return \@relationships;
 7850: }
 7851: 
 7852: # --------------------------------------------------
 7853: # _detect_dependencies
 7854: #
 7855: # Purpose:    Detect simple parameter dependencies
 7856: #             where one parameter requires another
 7857: #             to also be present, by combining
  Mutants (Total: 2, Killed: 2, Survived: 0)
 7858: #             error message pattern matching with
 7859: #             code condition matching.
 7860: #
 7861: # Entry:      $code        - method body source string.
 7862: #             $param_names - arrayref of parameter
 7863: #                            name strings.
 7864: #
 7865: # Exit:       Returns an arrayref of relationship
 7866: #             hashrefs of type 'dependency'.
 7867: #             Returns an empty arrayref if none found.
 7868: #
 7869: # Side effects: Logs detections to stdout when
 7870: #               verbose is set.
 7871: # --------------------------------------------------
 7872: sub _detect_dependencies {
●7873 → 7877 → 7898 7873: 	my ($self, $code, $param_names) = @_;
 7874: 
 7875: 	my @relationships;
 7876: 
 7877: 	foreach my $param1 (@$param_names) {
 7878: 		foreach my $param2 (@$param_names) {
 7879: 			next if $param1 eq $param2;
 7880: 
 7881: 			# Pattern 1: Error message mentions "X requires Y" AND code checks $x && !$y
 7882: 			# Split into two checks to be more flexible
 7883: 			if (($code =~ /(?:die|croak|confess)\s+['"]\w*$param1[^'"]*requires[^'"]*$param2/i) &&
 7884: 			    ($code =~ /if\s+\$$param1\s+&&\s+!\$$param2/)) {
 7885: 
 7886: 				push @relationships, {
 7887: 					type => 'dependency',
 7888: 					param => $param1,
 7889: 					requires => $param2,
 7890: 					description => "$param1 requires $param2 to be specified"
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7891: 				};
 7892: 
 7893: 				$self->_log("  RELATIONSHIP: $param1 depends on $param2");
 7894: 			}
 7895: 		}
 7896: 	}
 7897: 
 7898: 	return \@relationships;
 7899: }
 7900: 
 7901: # --------------------------------------------------
 7902: # _detect_value_constraints
 7903: #
 7904: # Purpose:    Detect value-based constraints between
 7905: #             parameters, such as 'if $ssl then

					

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

				
COND_INV_7905_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 7906: #             $port must equal 443' or 'if $mode
 7907: #             eq secure then $key is required'.
 7908: #
 7909: # Entry:      $code        - method body source string.
 7910: #             $param_names - arrayref of parameter
 7911: #                            name strings.
 7912: #
 7913: # Exit:       Returns an arrayref of relationship
 7914: #             hashrefs of type 'value_constraint'
 7915: #             or 'value_conditional'.
 7916: #             Returns an empty arrayref if none found.
 7917: #
 7918: # Side effects: Logs detections to stdout when
 7919: #               verbose is set.
 7920: # --------------------------------------------------
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7921: sub _detect_value_constraints {
●7922 → 7926 → 7976 7922: 	my ($self, $code, $param_names) = @_;
 7923: 
 7924: 	my @relationships;
 7925: 
 7926: 	foreach my $param1 (@$param_names) {
 7927: 		foreach my $param2 (@$param_names) {
 7928: 			next if $param1 eq $param2;
 7929: 
 7930: 			# Pattern 1: die if $x && $y != value
 7931: 			if ($code =~ /(?:die|croak|confess)[^;]*if\s+\$$param1\s+&&\s+\$$param2\s*!=\s*(\d+)/) {
 7932: 				my $value = $1;
 7933: 				push @relationships, {
 7934: 					type => 'value_constraint',
 7935: 					if => $param1,
  Mutants (Total: 2, Killed: 2, Survived: 0)
 7936: 					then => $param2,
 7937: 					operator => '==',
 7938: 					value => $value,
 7939: 					description => "When $param1 is specified, $param2 must equal $value"
 7940: 				};
 7941: 
 7942: 				$self->_log("  RELATIONSHIP: $param1 requires $param2 == $value");
 7943: 			}
 7944: 
 7945: 			# Pattern 2: die if $x && $y < value
 7946: 			if ($code =~ /(?:die|croak|confess)[^;]*if\s+\$$param1\s+&&\s+\$$param2\s*<\s*(\d+)/) {
 7947: 				my $value = $1;
 7948: 				push @relationships, {
 7949: 					type => 'value_constraint',
 7950: 					if => $param1,
 7951: 					then => $param2,
 7952: 					operator => '>=',
 7953: 					value => $value,
 7954: 					description => "When $param1 is specified, $param2 must be >= $value"
 7955: 				};
 7956: 
 7957: 				$self->_log("  RELATIONSHIP: $param1 requires $param2 >= $value");
 7958: 			}
 7959: 
 7960: 			# Pattern 3: die if $x eq 'value' && !$y
 7961: 			if ($code =~ /(?:die|croak|confess)[^;]*if\s+\$$param1\s+eq\s+['"]([^'"]+)['"]\s+&&\s+!\$$param2/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7962: 				my $value = $1;
 7963: 				push @relationships, {
 7964: 					type => 'value_conditional',
 7965: 					if => $param1,
 7966: 					equals => $value,
 7967: 					then_required => $param2,
 7968: 					description => "When $param1 equals '$value', $param2 is required"
 7969: 				};
 7970: 
 7971: 				$self->_log("  RELATIONSHIP: $param1='$value' requires $param2");
 7972: 			}
 7973: 		}
 7974: 	}
 7975: 
 7976: 	return \@relationships;
 7977: }
 7978: 
 7979: # Write a single method schema to a YAML file in output_dir.
 7980: #
 7981: # Entry:      $method_name is a non-empty string; $schema is a hashref.
 7982: # Exit:       YAML file written to output_dir/$method_name.yml.
 7983: # Side effects: Creates output_dir if it does not exist.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7984: # Notes:      Croaks if output_dir was not set in new().
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7985: 
 7986: sub _write_schema {
●7987 → 8002 → 8009 7987: 	my ($self, $method_name, $schema) = @_;
 7988: 
 7989: 	# output_dir is required here — croak early with a clear message
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7990: 	# rather than letting make_path fail with a cryptic error
 7991: 	croak(__PACKAGE__, ': output_dir must be provided to new() when writing schema files') unless defined $self->{output_dir};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 7992: 
 7993: 	make_path($self->{output_dir}) unless -d $self->{output_dir};
 7994: 
 7995: 	my $filename = "$self->{output_dir}/${method_name}.yml";
 7996: 
 7997: 	# Configure YAML::XS to not quote numeric strings
 7998: 	local $YAML::XS::QuoteNumericStrings = 0;
 7999: 
 8000: 	# Extract package name for module field
 8001: 	my $package_name = '';
 8002: 	if ($self->{_document}) {
 8003: 		my $package_stmt = $self->{_document}->find_first('PPI::Statement::Package');
 8004: 		$package_name = $package_stmt ? $package_stmt->namespace : '';
 8005: 		$self->{_package_name} //= $package_name;
 8006: 	}
 8007: 

					

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

				
COND_INV_8007_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8008: 	# Clean up schema for output - use the format expected by App::Test::Generator::Template
●8009 → 8024 → 8057 8009: 	my $output = {
 8010: 		function => $method_name,
 8011: 		module => $package_name,
 8012: 		config => {
 8013: 			close_stdin => 1,
 8014: 			dedup => 1,
 8015: 			test_nuls => 0,
 8016: 			test_undef => 0,

					

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

				
COND_INV_8016_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8017: 			test_empty => 1,
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8018: 			test_non_ascii => 0,
 8019: 			test_security => 0
 8020: 		}
 8021: 	};
 8022: 
 8023: 	# Process input parameters with advanced type handling
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8024: 	if($schema->{'input'}) {
 8025: 		if(scalar(keys %{$schema->{'input'}})) {
 8026: 			$output->{'input'} = {};
 8027: 
 8028: 			foreach my $param_name (keys %{$schema->{'input'}}) {
 8029: 				my $param = $schema->{'input'}{$param_name};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8030: 				if($param->{name}) {
 8031: 					my $name = delete $param->{name};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8032: 					if($name ne $param_name) {
 8033: 						# Sanity check
 8034: 						croak("BUG: Parameter name - expected $param_name, got $name");
 8035: 					}
 8036: 				}
 8037: 				my $cleaned_param = $self->_serialize_parameter_for_yaml($param);
 8038: 				$output->{'input'}{$param_name} = $cleaned_param;
 8039: 			}
 8040: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8041: 			# If some params have positions and others don't, treat the whole
 8042: 			# input as a named (hash) API and strip all positions.  Mixed
 8043: 			# position state arises when a named-API method also happens to

					

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

				
COND_INV_8043_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8044: 			# have a Params::Get positional-key call alongside =head4 Input
 8045: 			# named-block params that carry no position.
 8046: 			my @with_pos    = grep { defined $output->{input}{$_}{position} } keys %{$output->{input}};
 8047: 			my @without_pos = grep { !defined $output->{input}{$_}{position} } keys %{$output->{input}};
 8048: 			if (@with_pos && @without_pos) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8049: 				delete $output->{input}{$_}{position} for @with_pos;
 8050: 			}
 8051: 		} else {
 8052: 			delete $output->{input};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8053: 		}
 8054: 	}
 8055: 
 8056: 	# Process output
●8057 → 8057 → 8064 8057: 	if($schema->{'output'} && (scalar(keys %{$schema->{'output'}}))) {
 8058: 		if((ref($schema->{output}{_error_handling}) eq 'HASH') && (scalar(keys %{$schema->{output}{_error_handling}}) == 0)) {
 8059: 			delete $schema->{output}{_error_handling};
 8060: 		}
 8061: 		$output->{'output'} = $schema->{'output'};
 8062: 	}
 8063: 
●8064 → 8064 → 8070 8064: 	if($schema->{'output'}{'type'} && ($schema->{'output'}{'type'} eq 'scalar')) {
 8065: 		$schema->{'output'}{'type'} = 'string';
 8066: 		$schema->{_confidence}{output}->{level} = 'low';	# A guess
 8067: 	}
 8068: 
 8069: 	# Add 'new' field if object instantiation is needed
●8070 → 8070 → 8081 8070: 	if ($schema->{new}) {
 8071: 		# TODO: consider allowing parent class packages up the ISA chain
 8072: 		if(ref($schema->{new}) || ($schema->{new} eq $package_name)) {
 8073: 			$output->{new} = $schema->{new} eq $package_name ? undef : $schema->{'new'};
 8074: 		} else {
 8075: 			$self->_log("  NEW: Don't use $schema->{new} for object insantiation");
 8076: 			delete $schema->{new};
 8077: 			delete $output->{new};
 8078: 		}
 8079: 	}
 8080: 
●8081 → 8081 → 8084 8081: 	if(!defined($schema->{_confidence}{input}->{level})) {
 8082: 		$schema->{_confidence}{input} = $self->_calculate_input_confidence($schema->{input});
 8083: 	}
●8084 → 8084 → 8089 8084: 	if(!defined($schema->{_confidence}{output}->{level})) {
 8085: 		$schema->{_confidence}{output} = $self->_calculate_output_confidence($schema->{output});
 8086: 	}
 8087: 
 8088: 	# Add relationships if detected
●8089 → 8089 → 8093 8089: 	if ($schema->{relationships} && @{$schema->{relationships}}) {
 8090: 		$output->{relationships} = $schema->{relationships};
 8091: 	}
 8092: 
●8093 → 8093 → 8097 8093: 	if($schema->{accessor} && scalar(keys %{$schema->{accessor}})) {
 8094: 		$output->{accessor} = $schema->{accessor};
 8095: 	}
 8096: 
 8097: 	open my $fh, '>', $filename;
 8098: 	print $fh YAML::XS::Dump($output);
 8099: 	print $fh $self->_generate_schema_comments($schema, $method_name);
 8100: 	close $fh;
 8101: 
 8102: 	my $rel_info = $schema->{relationships} ?
 8103: 		' [' . scalar(@{$schema->{relationships}}) . ' relationships]' : '';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8104: 	$self->_log("  Wrote: $filename (input confidence: $schema->{_confidence}{input}->{level})" .
 8105: 				($schema->{new} ? " [requires: $schema->{new}]" : '') . $rel_info);
 8106: }
 8107: 
 8108: # --------------------------------------------------

					

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

				
COND_INV_8108_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8109: # _generate_schema_comments
 8110: #
 8111: # Purpose:    Generate the YAML comment block
 8112: #             appended to the end of each written
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8113: #             schema file, containing provenance,
 8114: #             confidence levels, parameter type
 8115: #             notes, relationship summaries, and
 8116: #             warnings about types requiring

					

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

				
COND_INV_8116_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8117: #             special test setup.
 8118: #
 8119: # Entry:      $schema      - the schema hashref as
 8120: #                            built by _analyze_method.
 8121: #             $method_name - the method name string,
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8122: #                            used in the fuzz
 8123: #                            command hint.
 8124: #
 8125: # Exit:       Returns a string of YAML comment lines
 8126: #             beginning with a blank line and ending
 8127: #             with a trailing newline.
 8128: #
 8129: # Side effects: None.
 8130: # --------------------------------------------------
 8131: sub _generate_schema_comments {
  Mutants (Total: 1, Killed: 1, Survived: 0)
●8132 → 8144 → 8172 8132: 	my ($self, $schema, $method_name) = @_;
 8133: 
 8134: 	my @comments;
 8135: 
 8136: 	push @comments, '';
 8137: 	push @comments, '# Generated by ' . ref($self);
 8138: 	push @comments, "# Run: fuzz-harness-generator -r $self->{output_dir}/${method_name}.yml";
 8139: 	push @comments, '#';
 8140: 	push @comments, "# Input confidence: $schema->{_confidence}{input}->{level}";
 8141: 	push @comments, "# Output confidence: $schema->{_confidence}{output}->{level}";
 8142: 
 8143: 	# Add notes about parameters
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8144: 	if ($schema->{input}) {
 8145: 		my @param_notes;
 8146: 		foreach my $param_name (sort keys %{$schema->{input}}) {
 8147: 			my $p = $schema->{input}{$param_name};
 8148: 
 8149: 			if ($p->{semantic}) {
 8150: 				push @param_notes, "$param_name: $p->{semantic}";
 8151: 			}

					

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

				
COND_INV_8151_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8152: 
 8153: 			if ($p->{enum}) {
 8154: 				push @param_notes, "$param_name: enum with " . scalar(@{$p->{enum}}) . " values";
 8155: 			}
 8156: 
 8157: 			if ($p->{isa}) {
 8158: 				push @param_notes, "$param_name: requires $p->{isa} object";
 8159: 			}
 8160: 		}
 8161: 
 8162: 		if (@param_notes) {
 8163: 			push @comments, '#';
 8164: 			push @comments, '# Parameter types detected:';
 8165: 			foreach my $note (@param_notes) {
 8166: 				push @comments, "#   - $note";
 8167: 			}
 8168: 		}
 8169: 	}
 8170: 
 8171: 	# Add relationship notes
  Mutants (Total: 1, Killed: 1, Survived: 0)
●8172 → 8172 → 8184 8172: 	if ($schema->{relationships} && @{$schema->{relationships}}) {
 8173: 		push @comments, (
 8174: 			'#',
 8175: 			'# Parameter relationships detected:'
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8176: 		);
 8177: 		foreach my $rel (@{$schema->{relationships}}) {
 8178: 			my $desc = $rel->{description} || _format_relationship($rel);
 8179: 			push @comments, "#   - $desc";

					

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

				
COND_INV_8179_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8180: 		}
 8181: 	}
 8182: 
 8183: 	# Add general notes

					

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

				
COND_INV_8183_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

●8184 → 8184 → 8192 8184: 	if ($schema->{_notes} && scalar(@{$schema->{_notes}})) {
 8185: 		push @comments, '#';
 8186: 		push @comments, '# Notes:';
 8187: 		foreach my $note (@{$schema->{_notes}}) {
 8188: 			push @comments, "#   - $note";
 8189: 		}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8190: 	}
 8191: 
●8192 → 8192 → 8211 8192: 	if($schema->{_analysis}) {
 8193: 		push @comments, (
 8194: 			'#',
 8195: 			'# Analysis:',
 8196: 			'# TODO:',
 8197: 		);
 8198: 		# confidence_factors:
 8199: 		#   input:
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8200: 		#   - No parameters found
 8201: 		#   output:
 8202: 		#   - 'Return type defined: object (+30)'
 8203: 		#   - 'Total output confidence score: 30'
 8204: 		#   - 'Medium confidence: return type defined'
 8205: 		#   input_confidence: none
 8206: 		#   output_confidence: medium
 8207: 		#   overall_confidence: none
 8208: 	}
 8209: 
 8210: 	# Add warnings for complex types
●8211 → 8212 → 8230 8211: 	my @warnings;
 8212: 	if ($schema->{input}) {
 8213: 		foreach my $param_name (keys %{$schema->{input}}) {
 8214: 			my $p = $schema->{input}{$param_name};
 8215: 
 8216: 			if ($p->{type} && $p->{type} eq 'coderef') {
 8217: 				push @warnings, "Parameter '$param_name' is a coderef - you'll need to provide a sub {} in tests";
 8218: 			}
 8219: 
 8220: 			if ($p->{semantic} && $p->{semantic} eq 'filehandle') {
 8221: 				push @warnings, "Parameter '$param_name' is a filehandle - consider using IO::String or mock";
 8222: 			}
 8223: 
 8224: 			if ($p->{isa} && $p->{isa} =~ /DateTime/) {
 8225: 				push @warnings, "Parameter '$param_name' requires DateTime - ensure DateTime is loaded";
 8226: 			}
 8227: 		}
 8228: 	}
 8229: 
●8230 → 8230 → 8238 8230: 	if (@warnings) {
 8231: 		push @comments, '#';
 8232: 		push @comments, '# WARNINGS - Manual test setup may be required:';
 8233: 		foreach my $warning (@warnings) {
 8234: 			push @comments, "#   ! $warning";
 8235: 		}
 8236: 	}
 8237: 
 8238: 	push @comments, '';
 8239: 
 8240: 	return join("\n", @comments);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8241: }
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8242: 
 8243: # --------------------------------------------------
 8244: # _serialize_parameter_for_yaml
 8245: #
 8246: # Purpose:    Convert a parameter spec hashref into
 8247: #             a cleaned, YAML-serialisable form
 8248: #             suitable for App::Test::Generator
 8249: #             consumption, handling semantic type
 8250: #             mappings, enum values, and object
 8251: #             class annotations.
 8252: #
 8253: # Entry:      $param - parameter spec hashref as
 8254: #                      produced by the merge and
 8255: #                      analysis pipeline.
 8256: #
 8257: # Exit:       Returns a new hashref containing only
 8258: #             the fields App::Test::Generator
 8259: #             understands, with internal _ keys
 8260: #             and semantic keys removed or converted.
 8261: #
 8262: # Side effects: None.
 8263: #
 8264: # Notes:      Semantic types are mapped to
 8265: #             appropriate base types with additional
 8266: #             constraint and note fields.
 8267: #             The original $param hashref is not
 8268: #             modified.
 8269: # --------------------------------------------------
 8270: sub _serialize_parameter_for_yaml {
●8271 → 8276 → 8281 8271: 	my ($self, $param) = @_;
 8272: 
 8273: 	my %cleaned;
 8274: 
 8275: 	# Copy basic fields that App::Test::Generator expects
 8276: 	foreach my $field (qw(type position optional min max matches default)) {
 8277: 		$cleaned{$field} = $param->{$field} if defined $param->{$field};
 8278: 	}
 8279: 
 8280: 	# Handle advanced type mappings
●8281 → 8281 → 8335 8281: 	if(my $semantic = $param->{semantic}) {
 8282: 		if ($semantic eq 'datetime_object') {
 8283: 			# DateTime objects: test generator needs to know how to create them
 8284: 			$cleaned{type} = 'object';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8285: 			$cleaned{isa} = $param->{isa} || 'DateTime';
 8286: 			$cleaned{_note} = 'Requires DateTime object';
 8287: 		} elsif ($semantic eq 'timepiece_object') {
 8288: 			$cleaned{type} = 'object';
 8289: 			$cleaned{isa} = $param->{isa} || 'Time::Piece';
 8290: 			$cleaned{_note} = 'Requires Time::Piece object';
 8291: 		} elsif ($semantic eq 'date_string') {
 8292: 			# Date strings: provide regex pattern
 8293: 			$cleaned{type} = 'string';
 8294: 			$cleaned{matches} ||= '/^\d{4}-\d{2}-\d{2}$/';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8295: 			$cleaned{_example} = '2024-12-12';
 8296: 		} elsif ($semantic eq 'iso8601_string') {
 8297: 			$cleaned{type} = 'string';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8298: 			$cleaned{matches} ||= '/^\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}Z?$/';
 8299: 			$cleaned{_example} = '2024-12-12T10:30:00Z';
 8300: 		} elsif ($semantic eq 'unix_timestamp') {
 8301: 			$cleaned{type} = 'integer';
 8302: 			$cleaned{min} ||= 0;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8303: 			$cleaned{max} ||= $INT32_MAX;	# 32-bit max
 8304: 			$cleaned{_note} = 'UNIX timestamp';
 8305: 		} elsif ($semantic eq 'datetime_parseable') {
 8306: 			$cleaned{type} = 'string';
 8307: 			$cleaned{_note} = 'Must be parseable as datetime';

					

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

				
COND_INV_8307_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8308: 		} elsif ($semantic eq 'filehandle') {
 8309: 			# File handles: special handling needed
 8310: 			$cleaned{type} = 'object';
 8311: 			$cleaned{isa} = $param->{isa} || 'IO::Handle';
 8312: 			$cleaned{_note} = 'File handle - may need mock in tests';
 8313: 		} elsif ($semantic eq 'filepath') {
 8314: 			# File paths: string with path pattern
 8315: 			$cleaned{type} = 'string';
 8316: 			$cleaned{matches} ||= '/^[\\w\\/.\\-_]+$/';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8317: 			$cleaned{_note} = 'File path';
 8318: 		} elsif ($semantic eq 'callback') {
 8319: 			# Coderefs: mark as special type
 8320: 			$cleaned{type} = 'coderef';
 8321: 			$cleaned{_note} = 'CODE reference - provide sub { } in tests';
 8322: 		} elsif ($semantic eq 'enum') {
 8323: 			# Enum: keep as string but add valid values
 8324: 			$cleaned{type} = 'string';
 8325: 			if ($param->{enum} && ref($param->{enum}) eq 'ARRAY') {
 8326: 				$cleaned{enum} = $param->{enum};
 8327: 				$cleaned{_note} = 'Must be one of: ' . join(', ', @{$param->{enum}});
 8328: 			}
 8329: 		}
 8330: 	}
 8331: 
 8332: 	# Handle memberof even if not marked with semantic.
 8333: 	# enum and memberof are mutually exclusive — only set memberof when enum
 8334: 	# is not already being output (avoids the "has both" validation error).
●8335 → 8335 → 8338 8335: 	if($param->{enum} && ref($param->{enum}) eq 'ARRAY' && !$cleaned{enum}) {
 8336: 		$cleaned{memberof} = $param->{enum};
 8337: 	}
●8338 → 8338 → 8343 8338: 	if($param->{memberof} && ref($param->{memberof}) eq 'ARRAY') {
 8339: 		$cleaned{memberof} = $param->{memberof};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8340: 	}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8341: 
 8342: 	# Handle object class
  Mutants (Total: 2, Killed: 2, Survived: 0)
●8343 → 8343 → 8348 8343: 	if ($param->{isa} && !$cleaned{isa}) {
 8344: 		$cleaned{isa} = $param->{isa};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8345: 	}
 8346: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8347: 	# Add format hints where available
●8348 → 8348 → 8353 8348: 	if ($param->{format}) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8349: 		$cleaned{_format} = $param->{format};
 8350: 	}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8351: 
 8352: 	# Remove internal fields
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8353: 	delete $cleaned{_source};
 8354: 	delete $cleaned{_from_input_spec};
 8355: 	delete $cleaned{semantic};
 8356: 
 8357: 	return \%cleaned;
 8358: }
 8359: 
 8360: # --------------------------------------------------
 8361: # _format_relationship
 8362: #
 8363: # Purpose:    Format a relationship hashref as a
 8364: #             short human-readable description
 8365: #             string for use in YAML comments.
 8366: #
 8367: # Entry:      $rel - relationship hashref as
 8368: #                    produced by the relationship
 8369: #                    detection methods.
 8370: #
 8371: # Exit:       Returns a description string.
 8372: #             Returns 'Unknown relationship' for
 8373: #             unrecognised types.
 8374: #
 8375: # Side effects: None.
 8376: # --------------------------------------------------
 8377: sub _format_relationship {
●8378 → 8380 → 8393 8378: 	my $rel = $_[0];
 8379: 
 8380: 	if ($rel->{type} eq 'mutually_exclusive') {
 8381: 		return 'Mutually exclusive: ' . join(', ', @{$rel->{params}});
 8382: 	} elsif ($rel->{type} eq 'required_group') {
 8383: 		return "Required group (OR): " . join(', ', @{$rel->{params}});
 8384: 	} elsif ($rel->{type} eq 'conditional_requirement') {
 8385: 		return "If $rel->{if} then $rel->{then_required} required";
 8386: 	} elsif ($rel->{type} eq 'dependency') {
 8387: 		return "$rel->{param} depends on $rel->{requires}";
 8388: 	} elsif ($rel->{type} eq 'value_constraint') {
 8389: 		return "If $rel->{if} then $rel->{then} $rel->{operator} $rel->{value}";
 8390: 	} elsif ($rel->{type} eq 'value_conditional') {
 8391: 		return "If $rel->{if}='$rel->{equals}' then $rel->{then_required} required";
 8392: 	}

					

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

				
BOOL_NEGATE_8392_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_8392_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 8393: 	return 'Unknown relationship';
 8394: }
 8395: 
 8396: # --------------------------------------------------
 8397: # _needs_object_instantiation
 8398: #
 8399: # Purpose:    Determine whether a method requires
 8400: #             an object to be instantiated before
 8401: #             it can be called, and if so return
 8402: #             the package name to instantiate.
 8403: #
 8404: # Entry:      $method_name - name of the method.
 8405: #             $method_body - method source string.
 8406: #             $method_info - method hashref from
 8407: #                            _find_methods (optional,
 8408: #                            for backward compat).
 8409: #
 8410: # Exit:       Returns the package name string if
 8411: #             object instantiation is required.
 8412: #             Returns undef if the method is a
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8413: #             constructor, factory, singleton, or
 8414: #             pure class method.

					

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

				
BOOL_NEGATE_8414_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_8414_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 8415: #
 8416: # Side effects: Logs analysis decisions to stdout

					

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

				
COND_INV_8416_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8417: #               when verbose is set.
 8418: #
 8419: # Notes:      Orchestrates five detection sub-steps:
 8420: #             factory detection, singleton detection,
 8421: #             instance method detection, inheritance
 8422: #             check, and constructor requirements.
 8423: #             Instance method detection overrides
 8424: #             factory detection when both fire.
 8425: # --------------------------------------------------
 8426: sub _needs_object_instantiation {
●8427 → 8453 → 8457 8427: 	my ($self, $method_name, $method_body, $method_info) = @_;

					

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

				
COND_INV_8427_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8428: 
 8429: 	# Allow method_info to be optional for backward compatibility
 8430: 	$method_info ||= {};
 8431: 
 8432: 	my $doc = $self->{_document};
 8433: 	return undef unless $doc;
 8434: 
 8435: 	# Get the current package name
 8436: 	my $package_stmt = $doc->find_first('PPI::Statement::Package');
 8437: 	my $current_package = $package_stmt ? $package_stmt->namespace : 'UNKNOWN';
 8438: 	$self->{_package_name} //= $current_package;
 8439: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8440: 	# Initialize result structure
 8441: 	my $result = {
 8442: 		package => $current_package,
 8443: 		needs_object => 0,
 8444: 		type => 'unknown',
 8445: 		details => {},
 8446: 		constructor_params => undef,
 8447: 	};

					

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

				
COND_INV_8447_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8448: 
 8449: 	# Track whether we should explicitly skip object instantiation
 8450: 	my $skip_object = 0;
 8451: 
 8452: 	# Skip constructors and destructors
 8453: 	if ($method_name eq 'new') {
 8454: 		$self->_log("  OBJECT: Constructor '$method_name' detected; skipping instantiation analysis");
 8455: 		return undef;
 8456: 	}
●8457 → 8457 → 8462 8457: 	if($method_name =~ /^(create|build|construct|init|DESTROY)$/i) {
 8458: 		$skip_object = 1;
 8459: 	}
 8460: 
 8461: 	# 1. Check for factory methods that return instances
  Mutants (Total: 1, Killed: 1, Survived: 0)
●8462 → 8468 → 8479 8462: 	my $is_factory = $self->_detect_factory_method(
 8463: 		$method_name, $method_body, $current_package, $method_info
 8464: 	);
 8465: 
 8466: 	# 2. Check for singleton patterns
 8467: 	my $is_singleton = $self->_detect_singleton_pattern($method_name, $method_body);
 8468: 	if ($is_singleton) {
 8469: 		$result->{needs_object} = 0;	# Singleton methods return the singleton instance
 8470: 		$result->{type} = 'singleton_accessor';
 8471: 		$result->{details} = $is_singleton;
 8472: 		$self->_log("  OBJECT: Detected singleton accessor '$method_name'");
 8473: 		# Singleton accessors typically don't need object creation in tests

					

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

				
COND_INV_8473_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8474: 		# as they're called on the class, not instance
 8475: 		$skip_object = 1;
 8476: 	}
 8477: 
 8478: 	# 3. Check if this is an instance method that needs an object
●8479 → 8480 → 8527 8479: 	my $is_instance_method = $self->_detect_instance_method($method_name, $method_body);
 8480: 	if ($is_instance_method &&
 8481: 	    ($is_instance_method->{explicit_self} ||
 8482: 	     $is_instance_method->{shift_self} ||
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8483: 	     $is_instance_method->{accesses_object_data} ||
 8484: 	     ($is_instance_method->{calls_instance_methods} &&
 8485: 	      scalar @{$is_instance_method->{calls_instance_methods}}))) {
 8486: 
 8487: 		# Instance-only methods override factory detection
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8488: 		if ($is_factory) {
 8489: 			$self->_log(
 8490: 				"  OBJECT: Instance-only method '$method_name' overrides factory detection"
 8491: 			);
 8492: 		}
 8493: 
 8494: 		$result->{needs_object} = 1;
 8495: 		$result->{type} = 'instance_method';
 8496: 		$result->{details} = $is_instance_method;
 8497: 

					

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

				
BOOL_NEGATE_8497_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_8497_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 8498: 		# 4. Check for inheritance - if parent class constructor should be used
 8499: 		my $inheritance_info = $self->_check_inheritance_for_constructor(
 8500: 			$current_package, $method_body
 8501: 		);

					

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

				
COND_INV_8501_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8502: 		if ($inheritance_info && $inheritance_info->{use_parent_constructor}) {
 8503: 			$result->{package} = $inheritance_info->{parent_class};
 8504: 			$result->{details}{inheritance} = $inheritance_info;
 8505: 			$self->_log(
 8506: 				"  OBJECT: Method '$method_name' uses parent class constructor: $inheritance_info->{parent_class}"
 8507: 			);
 8508: 		}
 8509: 
 8510: 		# 5. Check if constructor needs specific parameters
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8511: 		my $constructor_needs = $self->_detect_constructor_requirements(
 8512: 			$current_package, $result->{package}
 8513: 		);
 8514: 		if ($constructor_needs) {
 8515: 			$result->{constructor_params} = $constructor_needs;
 8516: 			$result->{details}{constructor_requirements} = $constructor_needs;
 8517: 			$self->_log(
 8518: 				"  OBJECT: Constructor for $result->{package} requires parameters"
 8519: 			);
 8520: 		}
 8521: 
 8522: 		# Return the package name (or parent package) that needs instantiation
 8523: 		return $result->{package};
 8524: 	}
 8525: 
 8526: 	# 6. Check for class methods that might need objects from other classes
●8527 → 8528 → 8542 8527: 	my $needs_other_object = $self->_detect_external_object_dependency($method_body);
 8528: 	if ($needs_other_object) {
 8529: 		$result->{needs_object} = 1;
 8530: 		$result->{type} = 'external_dependency';
 8531: 		$result->{package} = $needs_other_object->{package}
 8532: 			if $needs_other_object->{package};
 8533: 		$result->{details} = $needs_other_object;
 8534: 
 8535: 		$self->_log(
 8536: 			"  OBJECT: Method '$method_name' depends on external object: $needs_other_object->{package}"
 8537: 		);
 8538: 		return $result->{package} if $result->{package};
 8539: 	}
 8540: 
 8541: 	# Factory method only if NOT instance-based
●8542 → 8542 → 8551 8542: 	if ($is_factory && !$skip_object) {
 8543: 		$result->{needs_object} = 0;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8544: 		$result->{type} = 'factory';
 8545: 		$result->{details} = $is_factory;
 8546: 		$self->_log(
 8547: 			"  OBJECT: Detected factory method '$method_name' returns $is_factory->{returns_class} objects"
 8548: 		) if $is_factory->{returns_class};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8549: 	}
 8550: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8551: 	return undef;
 8552: }
 8553: 
 8554: # --------------------------------------------------
 8555: # _detect_factory_method
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8556: #
 8557: # Purpose:    Detect whether a method is a factory
 8558: #             that creates and returns object
 8559: #             instances rather than operating on
 8560: #             an existing instance.
 8561: #
 8562: # Entry:      $method_name     - method name string.
 8563: #             $method_body     - method source string.
 8564: #             $current_package - current package name.
 8565: #             $method_info     - method hashref
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8566: #                                (optional).
 8567: #
 8568: # Exit:       Returns a factory_info hashref on
 8569: #             detection, or undef if the method
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8570: #             is not a factory.
 8571: #             The hashref includes: returns_class,
 8572: #             confidence, and one of:
 8573: #             returns_blessed, returns_new,
 8574: #             returns_factory_result, pod_hint.

					

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

				
COND_INV_8574_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8575: #
 8576: # Side effects: None.
 8577: # --------------------------------------------------
 8578: sub _detect_factory_method {
●8579 → 8584 → 8589 8579: 	my ($self, $method_name, $method_body, $current_package, $method_info) = @_;
 8580: 
 8581: 	my %factory_info;
 8582: 
 8583: 	# Check method name patterns
 8584: 	if ($method_name =~ /^(create_|make_|build_|get_)/i) {
 8585: 		$factory_info{name_pattern} = 1;
 8586: 	}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8587: 
 8588: 	# Look for object creation patterns in the method body
●8589 → 8589 → 8640 8589: 	if ($method_body) {
 8590: 		# Pattern 1: Returns a blessed reference
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8591: 		if ($method_body =~ /return\s+bless\s*\{[^}]*\},\s*['"]?(\w+(?:::\w+)*|\$\w+)['"]?/s ||
 8592: 			$method_body =~ /bless\s*\{[^}]*\},\s*['"]?(\w+(?:::\w+)*|\$\w+)['"]?.*return/s) {
 8593: 			my $class_name = $1;
 8594: 

					

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

				
BOOL_NEGATE_8594_4: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_8594_4: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 8595: 			# Handle variable class names
 8596: 			if ($class_name =~ /^\$(class|self|package)$/) {
 8597: 				$factory_info{returns_class} = $current_package;
 8598: 			} elsif ($class_name =~ /^\$/) {
 8599: 				$factory_info{returns_class} = 'VARIABLE';	# Unknown variable

					

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

				
COND_INV_8599_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8600: 			} else {
 8601: 				$factory_info{returns_class} = $class_name;

					

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

				
COND_INV_8601_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8602: 			}
 8603: 
 8604: 			$factory_info{returns_blessed} = 1;

					

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

				
BOOL_NEGATE_8604_4: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_8604_4: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 8605: 			$factory_info{confidence} = 'high';
 8606: 			return \%factory_info;
 8607: 		}
 8608: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8609: 		# Pattern 2: Returns ->new() call on class or $self
 8610: 		if ($method_body =~ /return\s+([\$\w:]+)->new\(/s ||
 8611: 			$method_body =~ /([\$\w:]+)->new\(.*return/s) {
 8612: 			my $target = $1;
 8613: 
 8614: 			# Determine what class is being instantiated
 8615: 			if ($target eq '$self' || $target eq 'shift' || $target =~ /^\$/) {
 8616: 				$factory_info{returns_class} = $current_package;
 8617: 				$factory_info{self_new} = 1;
 8618: 			} elsif ($target =~ /::/) {
 8619: 				$factory_info{returns_class} = $target;
 8620: 				$factory_info{external_class} = 1;
 8621: 			} else {
 8622: 				$factory_info{returns_class} = $target;
 8623: 			}
 8624: 
 8625: 			$factory_info{returns_new} = 1;
 8626: 			$factory_info{confidence} = 'medium';
 8627: 			return \%factory_info;
 8628: 		}
 8629: 
 8630: 		# Pattern 3: Returns an object from another factory method
 8631: 		if ($method_body =~ /return\s+([\$\w:]+)->(create_|make_|build_|get_)/i ||
 8632: 			$method_body =~ /([\$\w:]+)->(create_|make_|build_|get_).*return/si) {
 8633: 			$factory_info{returns_factory_result} = 1;
 8634: 			$factory_info{confidence} = 'low';
 8635: 			return \%factory_info;
 8636: 		}
 8637: 	}
 8638: 
 8639: 	# Check for return type hints in POD if available
●8640 → 8640 → 8649 8640: 	if ($method_info && ref($method_info) eq 'HASH' && $method_info->{pod}) {
 8641: 		my $pod = $method_info->{pod};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8642: 		if ($pod =~ /returns?\s+(?:an?\s+)?(object|instance|new\s+\w+)/i) {
 8643: 			$factory_info{pod_hint} = 1;
 8644: 			$factory_info{confidence} = 'low';
 8645: 			return \%factory_info;
 8646: 		}
 8647: 	}
 8648: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8649: 	return undef;
 8650: }
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8651: 
 8652: # --------------------------------------------------
 8653: # _detect_singleton_pattern
 8654: #
 8655: # Purpose:    Detect singleton accessor methods
 8656: #             that return a shared instance rather
 8657: #             than creating a new object, by

					

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

				
COND_INV_8657_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8658: #             checking the method name and body
 8659: #             for singleton patterns.
 8660: #
 8661: # Entry:      $method_name - method name string.
 8662: #             $method_body - method source string.
 8663: #
 8664: # Exit:       Returns a singleton_info hashref on
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8665: #             detection (always contains at least
 8666: #             name_pattern => 1), or undef if the
 8667: #             method name does not match the
 8668: #             singleton accessor pattern.
 8669: #
 8670: # Side effects: None.
 8671: #

					

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

				
COND_INV_8671_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8672: # Notes:      Only fires for methods named
 8673: #             instance, get_instance, singleton,
 8674: #             or shared_instance. Methods not
 8675: #             matching these names always return
 8676: #             undef regardless of body content.
 8677: # --------------------------------------------------
  Mutants (Total: 5, Killed: 5, Survived: 0)
 8678: sub _detect_singleton_pattern {
●8679 → 8689 → 8718 8679: 	my ($self, $method_name, $method_body) = @_;

					

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

				
BOOL_NEGATE_8679_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_8679_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 8680: 
 8681: 	# Check method name patterns
 8682: 	return undef unless $method_name =~ /^(instance|get_instance|singleton|shared_instance)$/i;
 8683: 
 8684: 	my %singleton_info = (
 8685: 		name_pattern => 1,
 8686: 	);
 8687: 
 8688: 	# Look for singleton patterns in code
 8689: 	if ($method_body) {
 8690: 		# Pattern 1: Static/state variable holding instance
 8691: 		if ($method_body =~ /(?:my\s+)?(?:our\s+)?\$(?:instance|_instance|singleton)\b/s ||
 8692: 			$method_body =~ /state\s+\$(?:instance|_instance|singleton)\b/s) {
 8693: 			$singleton_info{static_variable} = 1;
 8694: 			$singleton_info{confidence} = 'high';
 8695: 		}
 8696: 
 8697: 		# Pattern 2: Returns $instance if defined (with better regex)
 8698: 		if ($method_body =~ /return\s+\$instance\s+if\s+(?:defined\s+)?\$instance/ ||
 8699: 			$method_body =~ /unless\s+\$instance.*?=\s*.*?new/) {
 8700: 			$singleton_info{returns_instance} = 1;
 8701: 			$singleton_info{confidence} = 'high';
 8702: 		}
 8703: 
 8704: 		# Pattern 3: ||= new() pattern (with better regex)
 8705: 		if ($method_body =~ /\$instance\s*\|\|=\s*.*?new/ ||
 8706: 			$method_body =~ /\$instance\s*=\s*.*?new\s+unless\s+(?:defined\s+)?\$instance/) {
 8707: 			$singleton_info{lazy_initialization} = 1;
 8708: 			$singleton_info{confidence} = 'medium';
 8709: 		}
 8710: 
 8711: 		# Pattern 4: Direct return of $instance variable
 8712: 		if ($method_body =~ /return\s+\$instance;/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8713: 			$singleton_info{returns_instance} = 1;
 8714: 			$singleton_info{confidence} = 'high' unless $singleton_info{confidence};
 8715: 		}
 8716: 	}
 8717: 
 8718: 	return \%singleton_info if keys %singleton_info > 0;	# Need at least name pattern
 8719: 
 8720: 	return undef;
 8721: }
 8722: 
 8723: # --------------------------------------------------
 8724: # _detect_instance_method
 8725: #
 8726: # Purpose:    Detect whether a method is an
 8727: #             instance method that requires a
 8728: #             blessed object ($self) to be called,
 8729: #             through multiple detection patterns
 8730: #             of varying confidence.
 8731: #
 8732: # Entry:      $method_name - method name string.
 8733: #             $method_body - method source string.
 8734: #
 8735: # Exit:       Returns an instance_info hashref if
 8736: #             any instance method signal is found.
 8737: #             Returns undef if no signals are
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8738: #             detected.
 8739: #             The hashref may contain: explicit_self,
 8740: #             shift_self, uses_self,
 8741: #             accesses_object_data,
 8742: #             calls_instance_methods,
 8743: #             private_method, and confidence.

					

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

				
COND_INV_8743_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8744: #
 8745: # Side effects: None.
 8746: # --------------------------------------------------
 8747: sub _detect_instance_method {
●8748 → 8753 → 8778 8748: 	my ($self, $method_name, $method_body) = @_;
 8749: 
 8750: 	my %instance_info;
 8751: 
 8752: 	# Pattern 1: my ($self, ...) = @_;

					

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

				
COND_INV_8752_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8753: 	if ($method_body =~ /my\s*\(\s*\$self\s*[,)]/) {
 8754: 		$instance_info{explicit_self} = 1;
 8755: 		$instance_info{confidence} = 'high';
 8756: 	}
 8757: 
 8758: 	# Pattern 1b: my $self = $_[0];  (direct-index style)
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8759: 	elsif ($method_body =~ /my\s+\$self\s*=\s*\$_\[0\]/) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8760: 		$instance_info{explicit_self} = 1;
 8761: 		$instance_info{confidence} = 'high';
 8762: 	}
 8763: 
 8764: 	# Pattern 2: my $self = shift;
 8765: 	elsif ($method_body =~ /my\s+\$self\s*=\s*shift/) {
 8766: 		$instance_info{shift_self} = 1;
 8767: 		$instance_info{confidence} = 'high';
 8768: 	}
 8769: 
 8770: 	# Pattern 3: Uses $self->something (including hash/array access)
 8771: 	# This catches $self->{value} and $self->[0] as well as $self->method()
 8772: 	elsif ($method_body =~ /\$self\s*->\s*(\w+|[\{\[])/) {
 8773: 		$instance_info{uses_self} = 1;
 8774: 		$instance_info{confidence} = 'medium';
 8775: 	}
 8776: 
 8777: 	# Pattern 4: Accesses object data: $self->{...}, $self->[...]
●8778 → 8778 → 8784 8778: 	if ($method_body =~ /\$self\s*->\s*[\{\[]/) {
 8779: 		$instance_info{accesses_object_data} = 1;
 8780: 		$instance_info{confidence} = 'high' unless $instance_info{confidence} eq 'high';
 8781: 	}
 8782: 
 8783: 	# Pattern 5: Calls other instance methods on $self
●8784 → 8784 → 8793 8784: 	if ($method_body =~ /\$self\s*->\s*(\w+)\s*\(/s) {
 8785: 		$instance_info{calls_instance_methods} = [];
 8786: 		while ($method_body =~ /\$self\s*->\s*(\w+)\s*\(/g) {
 8787: 			push @{$instance_info{calls_instance_methods}}, $1;
 8788: 		}
 8789: 		$instance_info{confidence} = 'high' if @{$instance_info{calls_instance_methods}};
 8790: 	}
 8791: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8792: 	# Pattern 6: Method name suggests instance method (not perfect but helpful)
●8793 → 8793 → 8799 8793: 	if ($method_name =~ /^_/ && $method_name !~ /^_new/) {
 8794: 		# Private methods are usually instance methods
 8795: 		$instance_info{private_method} = 1;
 8796: 		$instance_info{confidence} = 'low' unless exists $instance_info{confidence};
 8797: 	}
 8798: 
 8799: 	return \%instance_info if keys %instance_info;
 8800: 	return undef;
 8801: }
 8802: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8803: # --------------------------------------------------
 8804: # _check_inheritance_for_constructor
 8805: #
 8806: # Purpose:    Determine whether the current package
 8807: #             uses an inherited constructor from a
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8808: #             parent class, by examining use parent,
 8809: #             use base, and @ISA declarations.
 8810: #
 8811: # Entry:      $current_package - current package
 8812: #                                name string.
 8813: #             $method_body     - method source string
 8814: #                                (checked for SUPER::
 8815: #                                calls).
 8816: #
 8817: # Exit:       Returns an inheritance_info hashref
 8818: #             if any inheritance information is
 8819: #             found, or undef otherwise.
 8820: #             The hashref may contain:
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8821: #             parent_statements, isa_array,
 8822: #             uses_super, calls_super_new,
 8823: #             has_own_constructor,
 8824: #             use_parent_constructor, parent_class.
 8825: #
 8826: # Side effects: None.
 8827: # --------------------------------------------------
 8828: sub _check_inheritance_for_constructor {
●8829 → 8841 → 8857 8829: 	my ($self, $current_package, $method_body) = @_;
 8830: 
 8831: 	my $doc = $self->{_document};
 8832: 	return undef unless $doc;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8833: 
 8834: 	my %inheritance_info;
 8835: 
 8836: 	# 1. Look for parent/base statements
 8837: 	my @parent_classes;
 8838: 
 8839: 	# Find all 'use parent' or 'use base' statements
 8840: 	my $includes = $doc->find('PPI::Statement::Include') || [];
 8841: 	foreach my $inc (@$includes) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8842: 		my $content = $inc->content;
 8843: 		if ($content =~ /use\s+(parent|base)\s+['"]?([\w:]+)['"]?/) {

					

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

				
COND_INV_8843_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 8844: 			push @parent_classes, $2;
 8845: 			$inheritance_info{parent_statements} = \@parent_classes;
 8846: 		}
 8847: 		# Also check for multiple parents: use parent qw(Class1 Class2)
 8848: 		if ($content =~ /use\s+(parent|base)\s+qw?[\(\[]?(.+?)[\)\]]?;/) {
 8849: 			my $parents = $2;
 8850: 			my @multi_parents = split /\s+/, $parents;
 8851: 			push @parent_classes, @multi_parents;
 8852: 			$inheritance_info{parent_statements} = \@parent_classes;
 8853: 		}
 8854: 	}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8855: 
 8856: 	# 2. Look for @ISA assignments (with or without 'our')
●8857 → 8858 → 8870 8857: 	my $isas = $doc->find('PPI::Statement::Variable') || [];
 8858: 	foreach my $isa (@$isas) {
 8859: 		my $content = $isa->content();
 8860: 		# Match both "our @ISA = qw(...)" and "@ISA = qw(...)"
 8861: 		if ($content =~ /(?:our\s+)?\@ISA\s*=\s*qw?[\(\[]?(.+?)[\)\]]?/) {
 8862: 			my $parents = $1;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8863: 			my @isa_parents = split(/\s+/, $parents);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8864: 			push @parent_classes, @isa_parents;
 8865: 			$inheritance_info{isa_array} = \@isa_parents;
 8866: 		}
 8867: 	}
 8868: 
 8869: 	# Also look for @ISA in regular statements
●8870 → 8871 → 8882 8870: 	my $statements = $doc->find('PPI::Statement') || [];
 8871: 	foreach my $stmt (@$statements) {
 8872: 		my $content = $stmt->content;
 8873: 		if ($content =~ /\@ISA\s*=\s*qw?[\(\[]?(.+?)[\)\]]?/) {
 8874: 			my $parents = $1;
 8875: 			my @isa_parents = split(/\s+/, $parents);
 8876: 			push @parent_classes, @isa_parents;
 8877: 			$inheritance_info{isa_array} = \@isa_parents;
 8878: 		}
 8879: 	}
 8880: 
 8881: 	# 3. Check if method uses SUPER:: calls
●8882 → 8882 → 8890 8882: 	if ($method_body && $method_body =~ /SUPER::/) {
 8883: 		$inheritance_info{uses_super} = 1;
 8884: 		if ($method_body =~ /SUPER::new/) {
 8885: 			$inheritance_info{calls_super_new} = 1;
 8886: 		}
 8887: 	}
 8888: 
 8889: 	# 4. Check if current package has its own new method
●8890 → 8895 → 8903 8890: 	my $has_own_new = $doc->find(sub {
 8891: 		$_[1]->isa('PPI::Statement::Sub') &&
 8892: 		$_[1]->name eq 'new'
 8893: 	});
 8894: 
 8895: 	if ($has_own_new) {
 8896: 		$inheritance_info{has_own_constructor} = 1;

					

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

				
BOOL_NEGATE_8896_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_8896_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 8897: 	} elsif (@parent_classes) {
 8898: 		# No own constructor, but has parents - might need parent constructor
 8899: 		$inheritance_info{use_parent_constructor} = 1;
 8900: 		$inheritance_info{parent_class} = $parent_classes[0];	# Use first parent
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8901: 	}
 8902: 
 8903: 	return \%inheritance_info if keys %inheritance_info;
 8904: 	return undef;
 8905: }
 8906: 
 8907: # --------------------------------------------------
 8908: # _detect_constructor_requirements
 8909: #
 8910: # Purpose:    Analyse the new() method of the
 8911: #             current or target package to determine
 8912: #             what parameters the constructor
 8913: #             requires, including required and
 8914: #             optional parameters and their defaults.
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8915: #
 8916: # Entry:      $current_package - the package being
 8917: #                                analysed.
 8918: #             $target_package  - the package whose
 8919: #                                constructor will
 8920: #                                be called (may
 8921: #                                differ from current
 8922: #                                for inherited
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8923: #                                constructors).
 8924: #
 8925: # Exit:       Returns a requirements hashref on
 8926: #             success, or undef if no new() method
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8927: #             is found. For external classes,
 8928: #             returns a minimal hashref with
 8929: #             external_class => 1.
 8930: #
 8931: # Side effects: None.
 8932: # --------------------------------------------------
 8933: sub _detect_constructor_requirements {
●8934 → 8941 → 8950 8934: 	my ($self, $current_package, $target_package) = @_;
 8935: 
 8936: 	my $doc = $self->{_document};
 8937: 	return undef unless $doc;
 8938: 
 8939: 	# If target is different from current, we can't analyze it
 8940: 	# (external class, parent class in different file)
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8941: 	if ($target_package ne $current_package) {
 8942: 		return {
 8943: 			external_class => 1,
 8944: 			package => $target_package,
 8945: 			note => "Constructor for external class $target_package - parameters unknown"
 8946: 		};
 8947: 	}
 8948: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8949: 	# Find the new method in current package
●8950 → 8963 → 8974 8950: 	my $new_method = $doc->find_first(sub {
 8951: 		$_[1]->isa('PPI::Statement::Sub') &&
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8952: 		$_[1]->name eq 'new'
 8953: 	});
 8954: 
 8955: 	return undef unless $new_method;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8956: 
 8957: 	my %requirements;
 8958: 
 8959: 	# Get method body
 8960: 	my $body = $new_method->content;
 8961: 
 8962: 	# Look for parameter extraction patterns - handle both $self and $class
 8963: 	if ($body =~ /my\s*\(\s*\$(self|class)\s*,\s*(.+?)\)\s*=\s*\@_/s) {
 8964: 		my $params = $2;
 8965: 		my @param_names = $params =~ /\$(\w+)/g;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8966: 
 8967: 		if (@param_names) {
 8968: 			$requirements{parameters} = \@param_names;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8969: 			$requirements{parameter_count} = scalar @param_names;
 8970: 		}
 8971: 	}
 8972: 
 8973: 	# Look for shift patterns
●8974 → 8975 → 8979 8974: 	my @shift_params;
 8975: 	while ($body =~ /my\s+\$(\w+)\s*=\s*shift/g) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 8976: 		push @shift_params, $1;
 8977: 	}
 8978: 	# Remove $self or $class if present
●8979 → 8981 → 8988 8979: 	@shift_params = grep { $_ !~ /^(self|class)$/i } @shift_params;
 8980: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 8981: 	if (@shift_params) {

					

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

				
BOOL_NEGATE_8981_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_8981_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 8982: 		$requirements{parameters} = \@shift_params;
 8983: 		$requirements{parameter_count} = scalar @shift_params;
 8984: 		$requirements{shift_pattern} = 1;
 8985: 	}
 8986: 
 8987: 	# Look for validation of parameters (more flexible pattern)
●8988 → 8989 → 8992 8988: 	my @required_params;
 8989: 	if ($body =~ /croak.*unless.*(?:defined\s+)?\$(\w+)/g) {
 8990: 		push @required_params, $1;
 8991: 	}
●8992 → 8992 → 8996 8992: 	if ($body =~ /die.*unless.*(?:defined\s+)?\$(\w+)/g) {
 8993: 		push @required_params, $1;
 8994: 	}
 8995: 
●8996 → 8996 → 9001 8996: 	if (@required_params) {
 8997: 		$requirements{required_parameters} = \@required_params;
 8998: 	}
 8999: 
 9000: 	# Look for default values (optional parameters)
●9001 → 9006 → 9016 9001: 	my @optional_params;
 9002: 	my %default_values;
 9003: 
 9004: 	# Use the new _extract_default_value method
 9005: 	# Check for each parameter in the constructor body
 9006: 	if ($requirements{parameters}) {
 9007: 		foreach my $param (@{$requirements{parameters}}) {
 9008: 			my $default = $self->_extract_default_value($param, $body);
 9009: 			if (defined $default) {
 9010: 				push @optional_params, $param;
 9011: 				$default_values{$param} = $default;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9012: 			}
 9013: 		}
 9014: 	}
 9015: 
●9016 → 9016 → 9021 9016: 	if (@optional_params) {
 9017: 		$requirements{optional_parameters} = \@optional_params;
 9018: 		$requirements{default_values} = \%default_values;
 9019: 	}
 9020: 
 9021: 	return \%requirements if keys %requirements;
 9022: 	return undef;
 9023: }
 9024: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9025: 
 9026: # --------------------------------------------------
 9027: # _detect_external_object_dependency
 9028: #
 9029: # Purpose:    Detect whether a method creates or
 9030: #             depends on objects from classes other
 9031: #             than the current package, by scanning
 9032: #             for ->new() calls on named classes
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9033: #             and method calls on typed variables.
 9034: #
 9035: # Entry:      $method_body - method source string.
 9036: #                            May be undef.
 9037: #
 9038: # Exit:       Returns a dependency_info hashref if
 9039: #             external object usage is found, or
 9040: #             undef otherwise.
 9041: #             The hashref may contain:
 9042: #             creates_objects (arrayref of class
 9043: #             names), uses_objects (arrayref of
 9044: #             class names), and package (the primary
 9045: #             dependency class).
 9046: #

					

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

				
COND_INV_9046_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 9047: # Side effects: None.
 9048: # --------------------------------------------------
 9049: sub _detect_external_object_dependency {
●9050 → 9059 → 9065 9050: 	my ($self, $method_body) = @_;
 9051: 
 9052: 	return undef unless $method_body;
 9053: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9054: 	my %dependency_info;
 9055: 
 9056: 	# Pattern 1: Creates objects of other classes with ->new() or ->create()
 9057: 	# Reset pos for global match
 9058: 	pos($method_body) = 0;
 9059: 	while ($method_body =~ /(\w+(?:::\w+)*)->(?:new|create)\(/g) {
 9060: 		my $class = $1;
 9061: 		next if $class eq 'main' || $class eq '__PACKAGE__' || $class =~ /^\$/;
 9062: 		push @{$dependency_info{creates_objects}}, $class;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9063: 	}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9064: 
●9065 → 9065 → 9073 9065: 	if ($dependency_info{creates_objects}) {
 9066: 		# Remove duplicates
 9067: 		my %seen;
 9068: 		$dependency_info{creates_objects} = [grep { !$seen{$_}++ } @{$dependency_info{creates_objects}}];
 9069: 		$dependency_info{package} = $dependency_info{creates_objects}[0];
 9070: 	}
 9071: 
 9072: 	# Pattern 2: Calls methods on objects from other classes
●9073 → 9073 → 9103 9073: 	if ($method_body =~ /\$(\w+)->\w+\(/) {
 9074: 		my %object_vars;
 9075: 		# Reset pos for global match — the if check above used a
 9076: 		# non-/g match so it cannot have advanced pos, but the while
 9077: 		# loop's own /g matches still need to start from the beginning.
 9078: 		pos($method_body) = 0;
 9079: 		while ($method_body =~ /\$(\w+)->\w+\(/g) {
 9080: 			$object_vars{$1}++;
 9081: 		}
 9082: 
 9083: 		# Try to determine type of object variables
 9084: 		my @object_classes;
 9085: 		foreach my $var (keys %object_vars) {
 9086: 			# Look for type declarations or assignments
 9087: 			if ($method_body =~ /my\s+\$$var\s*=\s*(\w+(?:::\w+)+)->(?:new|create)/) {
 9088: 				push @object_classes, $1;
 9089: 			} elsif ($method_body =~ /my\s+\$$var\s*=\s*(\w+(?:::\w+)+)->/) {
 9090: 				push @object_classes, $1;
 9091: 			}
 9092: 		}
 9093: 
 9094: 		if (@object_classes) {

					

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

				
COND_INV_9094_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 9095: 			$dependency_info{uses_objects} = \@object_classes;
 9096: 			$dependency_info{package} = $object_classes[0] unless $dependency_info{package};

					

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

				
BOOL_NEGATE_9096_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_9096_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 9097: 		}
 9098: 	}
 9099: 
 9100: 	# Pattern 3: Receives objects as parameters (type hints in comments/POD)
 9101: 	# This would need integration with parameter analysis
 9102: 
 9103: 	return \%dependency_info if keys %dependency_info;
 9104: 	return undef;

					

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

				
COND_INV_9104_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 9105: }

					

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

				
BOOL_NEGATE_9105_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_9105_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 9106: 
 9107: # --------------------------------------------------
 9108: # _get_parent_class
 9109: #
 9110: # Purpose:    Find the first parent class of the
 9111: #             current package by searching the
 9112: #             PPI document for use parent, use base,
 9113: #             or our @ISA declarations.
 9114: #
 9115: # Entry:      None (operates on $self->{_document}).
 9116: #
 9117: # Exit:       Returns the parent class name string,
 9118: #             or undef if no parent is found.
 9119: #
 9120: # Side effects: None.
 9121: # --------------------------------------------------
 9122: sub _get_parent_class {
●9123 → 9135 → 9141 9123: 	my $self = $_[0];
 9124: 
 9125: 	my $doc = $self->{_document};
 9126: 	return unless $doc;
 9127: 
 9128: 	# Look for use parent statements
 9129: 	my $parent_stmt = $doc->find_first(sub {
 9130: 		$_[1]->isa('PPI::Statement::Include') &&
 9131: 		$_[1]->type eq 'use' &&
 9132: 		$_[1]->module =~ /^(parent|base)$/ &&
 9133: 		$_[1]->arguments =~ /['"](\w+(?:::\w+)*)['"]/
 9134: 	});
 9135: 	if ($parent_stmt) {
 9136: 		my $parent = $1;
 9137: 		return $parent;
 9138: 	}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9139: 
 9140: 	# Look for @ISA assignment
●9141 → 9145 → 9149 9141: 	my $isa_stmt = $doc->find_first(sub {
 9142: 		$_[1]->isa('PPI::Statement') &&
 9143: 		$_[1]->content =~ /our\s+\@ISA\s*=\s*\(\s*['"](\w+(?:::\w+)*)['"]\s*\)/
 9144: 	});
 9145: 	if ($isa_stmt && $isa_stmt->content =~ /['"](\w+(?:::\w+)*)['"]/) {
 9146: 		return $1;
 9147: 	}

					

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

				
COND_INV_9147_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 9148: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9149: 	return;
 9150: }
 9151: 
 9152: # --------------------------------------------------
 9153: # _get_class_for_instance_method

					

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

				
BOOL_NEGATE_9153_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_9153_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 9154: #
 9155: # Purpose:    Determine which class should be used
 9156: #             for object instantiation when testing

					

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

				
BOOL_NEGATE_9156_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_9156_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 9157: #             an instance method, preferring the
 9158: #             current package if it has a new()
 9159: #             method, falling back to the parent
 9160: #             class otherwise.
 9161: #
 9162: # Entry:      None (operates on $self->{_document}).
 9163: #
 9164: # Exit:       Returns the package name string to
 9165: #             use for instantiation. Returns
 9166: #             'UNKNOWN_PACKAGE' if no package
 9167: #             statement is found.
 9168: #
 9169: # Side effects: Stores the package name in
 9170: #               $self->{_package_name} if not
 9171: #               already set.
 9172: # --------------------------------------------------
 9173: sub _get_class_for_instance_method {
●9174 → 9188 → 9193 9174: 	my $self = $_[0];
 9175: 
 9176: 	# Get the current package
 9177: 	my $doc = $self->{_document};
 9178: 	my $package_stmt = $doc->find_first('PPI::Statement::Package');
 9179: 	return 'UNKNOWN_PACKAGE' unless $package_stmt;
 9180: 	my $package_name = $package_stmt->namespace;
 9181: 	$self->{_package_name} //= $package_name;
 9182: 
 9183: 	# Check if the current package has a 'new' method
 9184: 	my $has_new = $doc->find(sub {
 9185: 		$_[1]->isa('PPI::Statement::Sub') && $_[1]->name eq 'new'
 9186: 	});
 9187: 
 9188: 	if ($has_new) {
 9189: 		return $package_name;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9190: 	}
 9191: 
 9192: 	# Otherwise, try to get the parent class
 9193: 	my $parent = $self->_get_parent_class();
 9194: 	return $parent if $parent;
 9195: 
 9196: 	# Fallback to current package
 9197: 	return $package_name;
 9198: }
 9199: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9200: # --------------------------------------------------
 9201: # _extract_default_value
 9202: #
 9203: # Purpose:    Extract a default value for a named
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9204: #             parameter from a method body by
 9205: #             matching multiple common Perl default
 9206: #             assignment idioms.
 9207: #
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9208: # Entry:      $param - parameter name string.
 9209: #             $code  - method body source string.
 9210: #
 9211: # Exit:       Returns the cleaned default value
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9212: #             scalar on success, or undef if no
 9213: #             default assignment pattern is found.
 9214: #
 9215: # Side effects: None.
 9216: #
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9217: # Notes:      Eight patterns are tried in order:
 9218: #             ||, //=, defined ternary, unless
 9219: #             defined, ||=, //, multi-line if
 9220: #             !defined, unless defined block.
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9221: #             Comment lines are stripped from the
 9222: #             code before matching to avoid false
 9223: #             positives. Delegates to
 9224: #             _clean_default_value for value
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9225: #             normalisation.
 9226: # --------------------------------------------------
 9227: sub _extract_default_value {
  Mutants (Total: 2, Killed: 2, Survived: 0)
●9228 → 9240 → 9248 9228: 	my ($self, $param, $code) = @_;
 9229: 
 9230: 	return undef unless $param && $code;
 9231: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9232: 	# Clean up the code for easier pattern matching
 9233: 	# Remove comments to avoid false positives
 9234: 	my $clean_code = $code;
 9235: 	$clean_code =~ s/#.*$//gm;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9236: 	$clean_code =~ s/^\s+|\s+$//g;
 9237: 
 9238: 	# Pattern 1: $param = $param || 'default_value'
 9239: 	# Also handles: $param = $arg || 'default'
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9240: 	if ($clean_code =~ /\$$param\s*=\s*(?:\$$param|\$[a-zA-Z_]\w*)\s*\|\|\s*([^;]+)/) {
 9241: 		my $default = $1;
 9242: 		$default =~ s/\s*;\s*$//;
 9243: 		$default = $self->_clean_default_value($default);

					

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

				
BOOL_NEGATE_9243_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_9243_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 9244: 		return $default if defined $default;
 9245: 	}
 9246: 
 9247: 	# Pattern 2: $param //= 'default_value'
  Mutants (Total: 1, Killed: 1, Survived: 0)
●9248 → 9248 → 9257 9248: 	if ($clean_code =~ /\$$param\s*\/\/=\s*([^;]+)/) {
 9249: 		my $default = $1;
 9250: 		$default =~ s/\s*;\s*$//;
 9251: 		$default = $self->_clean_default_value($default);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9252: 		return $default if defined $default;
 9253: 	}
 9254: 
 9255: 	# Pattern 3: $param = defined $param ? $param : 'default'
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9256: 	# Also handles: $param = defined $arg ? $arg : 'default'
●9257 → 9257 → 9265 9257: 	if ($clean_code =~ /\$$param\s*=\s*defined\s+(?:\$$param|\$[a-zA-Z_]\w*)\s*\?\s*(?:\$$param|\$[a-zA-Z_]\w*)\s*:\s*([^;]+)/) {
 9258: 		my $default = $1;
 9259: 		$default =~ s/\s*;\s*$//;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9260: 		$default = $self->_clean_default_value($default);
 9261: 		return $default if defined $default;
 9262: 	}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9263: 
 9264: 	# Pattern 4: $param = 'default' unless defined $param;
●9265 → 9265 → 9272 9265: 	if ($clean_code =~ /\$$param\s*=\s*([^;]+?)\s+unless\s+defined\s+(?:\$$param|\$[a-zA-Z_]\w*)/) {
 9266: 		my $default = $1;
 9267: 		$default = $self->_clean_default_value($default);
 9268: 		return $default if defined $default;
 9269: 	}
 9270: 
 9271: 	# Pattern 5: $param ||= 'default'
●9272 → 9272 → 9280 9272: 	if ($clean_code =~ /\$$param\s*\|\|=\s*([^;]+)/) {
 9273: 		my $default = $1;
 9274: 		$default =~ s/\s*;\s*$//;
 9275: 		$default = $self->_clean_default_value($default);
 9276: 		return $default if defined $default;
 9277: 	}
 9278: 
 9279: 	# Pattern 6: $param = $arg // 'default'
●9280 → 9280 → 9288 9280: 	if ($clean_code =~ /\$$param\s*=\s*(?:\$$param|\$[a-zA-Z_]\w*)\s*\/\/\s*([^;]+)/) {
 9281: 		my $default = $1;
 9282: 		$default =~ s/\s*;\s*$//;
 9283: 		$default = $self->_clean_default_value($default);
 9284: 		return $default if defined $default;
 9285: 	}
 9286: 
 9287: 	# Pattern 7: Multi-line: if (!defined $param) { $param = 'default'; }
●9288 → 9288 → 9296 9288: 	if ($clean_code =~ /if\s*\(\s*!defined\s+\$$param\s*\)\s*\{[^}]*\$$param\s*=\s*([^;]+)/s) {
 9289: 		my $default = $1;
 9290: 		$default =~ s/\s*;\s*$//;
 9291: 		$default = $self->_clean_default_value($default);
 9292: 		return $default if defined $default;
 9293: 	}
 9294: 
 9295: 	# Pattern 8: unless (defined $param) { $param = 'default'; }
●9296 → 9296 → 9303 9296: 	if ($clean_code =~ /unless\s*\(\s*defined\s+\$$param\s*\)\s*\{[^}]*\$$param\s*=\s*([^;]+)/s) {
 9297: 		my $default = $1;
 9298: 		$default =~ s/\s*;\s*$//;
 9299: 		$default = $self->_clean_default_value($default);
 9300: 		return $default if defined $default;
 9301: 	}
 9302: 
 9303: 	return undef;
 9304: }
 9305: 
 9306: # --------------------------------------------------
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9307: # _extract_test_hints
 9308: #
 9309: # Purpose:    Extract structured test hints from
 9310: #             a method's code and schema, including
 9311: #             boundary values, invalid inputs, and
 9312: #             valid input examples from POD.
 9313: #
 9314: # Entry:      $method - method hashref.
 9315: #             $schema - schema hashref as built so
 9316: #                       far by _analyze_method.
 9317: #
 9318: # Exit:       Returns a hints hashref with keys:
 9319: #             boundary_values, invalid_inputs,
 9320: #             equivalence_classes, valid_inputs.
 9321: #             Keys with empty arrays are deleted
 9322: #             before returning.
 9323: #
 9324: # Side effects: None.
 9325: # --------------------------------------------------
 9326: sub _extract_test_hints {
●9327 → 9343 → 9347 9327: 	my ($self, $method, $schema) = @_;
 9328: 
 9329: 	my %hints = (
 9330: 		boundary_values => [],
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9331: 		invalid_inputs => [],
 9332: 		equivalence_classes => [],
 9333: 		valid_inputs => [],
 9334: 	);
 9335: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9336: 	my $code = $method->{body};
 9337: 	return {} unless $code;
 9338: 
 9339: 	$self->_extract_invalid_input_hints($code, \%hints);
 9340: 	$self->_extract_boundary_value_hints($code, \%hints);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9341: 
 9342: 	# prune empties
 9343: 	for my $k (keys %hints) {
 9344: 		delete $hints{$k} unless @{$hints{$k}};
 9345: 	}
 9346: 
 9347: 	return \%hints;
 9348: }
 9349: 
 9350: # --------------------------------------------------
 9351: # _extract_invalid_input_hints
 9352: #
 9353: # Purpose:    Detect likely invalid input values
 9354: #             from a method body by looking for
 9355: #             defined checks, empty string checks,
 9356: #             and negative number checks.
 9357: #
 9358: # Entry:      $code  - method body source string.
 9359: #             $hints - hints hashref (modified in
 9360: #                      place via invalid_inputs key).
 9361: #
 9362: # Exit:       Returns nothing. Appends to
 9363: #             $hints->{invalid_inputs}.
 9364: #
 9365: # Side effects: None.
 9366: # --------------------------------------------------
 9367: sub _extract_invalid_input_hints {
●9368 → 9371 → 9376 9368: 	my ($self, $code, $hints) = @_;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9369: 
 9370: 	# undef invalid
 9371: 	if ($code =~ /defined\s*\(\s*\$/) {
 9372: 		push @{ $hints->{invalid_inputs} }, 'undef';
 9373: 	}
 9374: 
 9375: 	# empty string invalid
●9376 → 9376 → 9381 9376: 	if ($code =~ /\beq\s*''/ || $code =~ /\blength\s*\(/) {
 9377: 		push @{ $hints->{invalid_inputs} }, '';
 9378: 	}
 9379: 
 9380: 	# negative number invalid
●9381 → 9381 → 0 9381: 	if ($code =~ /\$\w+\s*<\s*0/) {
 9382: 		push @{ $hints->{invalid_inputs} }, -1;
 9383: 	}
 9384: }
 9385: 
 9386: # --------------------------------------------------
 9387: # _extract_boundary_value_hints
 9388: #
 9389: # Purpose:    Extract numeric boundary values from
 9390: #             comparison operators in a method body,
 9391: #             adding both the boundary value and
 9392: #             the value one step either side.
 9393: #
 9394: # Entry:      $code  - method body source string.
 9395: #             $hints - hints hashref (modified in
 9396: #                      place via boundary_values key).
 9397: #
 9398: # Exit:       Returns nothing. Appends to and
 9399: #             deduplicates $hints->{boundary_values}.
 9400: #
 9401: # Side effects: None.
 9402: # --------------------------------------------------
 9403: sub _extract_boundary_value_hints {
●9404 → 9406 → 9421 9404: 	my ($self, $code, $hints) = @_;
 9405: 
 9406: 	while ($code =~ /\$\w+\s*(<=|<|>=|>)\s*(\d+)/g) {
 9407: 		my ($op, $n) = ($1, $2);
 9408: 

					

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

				
BOOL_NEGATE_9408_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_9408_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 9409: 		if ($op eq '<') {
 9410: 			push @{ $hints->{boundary_values} }, $n, $n+1;
 9411: 		} elsif ($op eq '<=') {
 9412: 			push @{ $hints->{boundary_values} }, $n, $n+1;
 9413: 		} elsif ($op eq '>') {
 9414: 			push @{ $hints->{boundary_values} }, $n, $n-1;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9415: 		} elsif ($op eq '>=') {
 9416: 			push @{ $hints->{boundary_values} }, $n, $n-1;
 9417: 		}
 9418: 	}
 9419: 
 9420: 	# Remove duplicates
 9421: 	my %seen;
 9422: 	$hints->{boundary_values} = [ grep { !$seen{$_}++ } @{ $hints->{boundary_values} } ];
 9423: }
 9424: 
 9425: # --------------------------------------------------
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9426: # _extract_pod_examples
 9427: #
 9428: # Purpose:    Extract example method call patterns from a method's
 9429: #             SYNOPSIS section (=head1 or =head2) and from any
 9430: #             =for example begin/end blocks, and add them as
 9431: #             valid_inputs hints for fuzzing.
 9432: #
 9433: # Entry:      $pod   - POD string for the method. May be undef.
 9434: #             $hints - hints hashref (modified in place via the
 9435: #                      valid_inputs key).
 9436: #
 9437: # Exit:       Returns $hints. Appends to $hints->{valid_inputs}.
 9438: #
 9439: # Side effects: Logs the number of examples found to stdout when
 9440: #               verbose is set.
 9441: #
 9442: # Notes:      For standalone runnable round-trip tests (not just
 9443: #             fuzzing hints) use App::Test::Generator::PodExampleExtractor
 9444: #             and bin/pod-example-tester instead.
 9445: # --------------------------------------------------
 9446: sub _extract_pod_examples {
  Mutants (Total: 1, Killed: 1, Survived: 0)
●9447 → 9455 → 9460 9447: 	my ($self, $pod, $hints) = @_;
 9448: 
 9449: 	return $hints unless $pod;
 9450: 
 9451: 	my @examples;
 9452: 
 9453: 	# Accept both =head1 SYNOPSIS (module-level) and =head2 SYNOPSIS (method-level)
 9454: 	my $synopsis = '';
 9455: 	if($pod =~ /=head[12]\s+SYNOPSIS\s*(.+?)(?=\n=head|\z)/s) {
 9456: 		$synopsis = $1;
 9457: 	}
 9458: 
 9459: 	# Also collect =for example begin ... =for example end blocks
●9460 → 9461 → 9464 9460: 	my @for_blocks;
 9461: 	while($pod =~ /=for\s+example\s+begin(.+?)=for\s+example\s+end/sg) {
 9462: 		push @for_blocks, $1;
 9463: 	}
●9464 → 9469 → 9487 9464: 	$synopsis .= join('', @for_blocks);
 9465: 
 9466: 	return $hints unless length($synopsis);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9467: 
 9468: 	# Constructor examples: ->wilma(foo => 'bar', count => 5)
 9469: 	while ($synopsis =~ /->([a-z_0-9A-Z]+)\s*\(\s*(.*?)\s*\)/sg) {
 9470: 		my ($method, $args) = ($1, $2);
 9471: 		my %kv;
 9472: 
 9473: 		while ($args =~ /(\w+)\s*=>\s*(?:'([^']*)'|"([^"]*)"|(\d+))/g) {
 9474: 			my $key = $1;
 9475: 			my $val = defined $2 ? $2 : defined $3 ? $3 : $4;
 9476: 			$kv{$key} = $val;
 9477: 		}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9478: 
 9479: 		push @examples, {
 9480: 			style => 'named',
 9481: 			source => 'pod',
 9482: 			args => \%kv,
 9483: 			function => $method,	# TODO: add a sanity check this is what we expect
 9484: 		} if %kv;
 9485: 	}
 9486: 
●9487 → 9487 → 9507 9487: 	unless(scalar(@examples)) {
 9488: 		# Positional calls: func($a, $b)
 9489: 		while ($synopsis =~ /\b(\w+)\s*\(\s*(.*?)\s*\)/sg) {
 9490: 			my ($func, $argstr) = ($1, $2);
 9491: 
 9492: 			# next if $func eq 'new';	# already handled
 9493: 
 9494: 			my @args = map { s/^\s+|\s+$//gr } split /\s*,\s*/, $argstr;
 9495: 
 9496: 			next unless @args;
 9497: 
 9498: 			push @examples, {
 9499: 				style	=> 'positional',
 9500: 				source	=> 'pod',
 9501: 				function => $func,
 9502: 				args	=> \@args,
 9503: 			};
 9504: 		}
 9505: 	}
 9506: 
●9507 → 9507 → 9514 9507: 	if (scalar(@examples)) {
 9508: 		$hints->{valid_inputs} ||= [];
 9509: 		push @{ $hints->{valid_inputs} }, @examples;
 9510: 
 9511: 		$self->_log("  POD: extracted " . scalar(@examples) . " example call(s)");
 9512: 	}
 9513: 
●9514 → 9514 → 9518 9514: 	for my $k (qw(boundary_values invalid_inputs valid_inputs equivalence_classes)) {
 9515: 		$hints->{$k} //= [];
 9516: 	}
 9517: 
 9518: 	return $hints;
 9519: }
 9520: 
 9521: # --------------------------------------------------
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9522: # _clean_default_value
 9523: #
 9524: # Purpose:    Normalise a raw default value string
 9525: #             extracted from code or POD into a
 9526: #             clean Perl scalar, handling quoted
 9527: #             strings, numeric literals, boolean
 9528: #             keywords, empty containers, and
 9529: #             undef.
 9530: #
 9531: # Entry:      $value     - raw value string.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9532: #                          May be undef.
 9533: #             $from_code - true if the value was
 9534: #                          extracted from source
 9535: #                          code (affects escape
 9536: #                          sequence handling).
 9537: #
 9538: # Exit:       Returns the cleaned value:
 9539: #               undef   for undef or unparseable
 9540: #               {}      for empty hashrefs
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9541: #               []      for empty arrayrefs
 9542: #               integer for whole numbers
 9543: #               float   for decimal numbers
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9544: #               1 or 0  for boolean keywords
 9545: #               string  for everything else
 9546: #
 9547: # Side effects: None.
 9548: # --------------------------------------------------
 9549: sub _clean_default_value {
●9550 → 9562 → 9569 9550: 	my ($self, $value, $from_code) = @_;
 9551: 
 9552: 	return unless defined $value;
 9553: 
 9554: 	# Remove leading/trailing whitespace
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9555: 	$value =~ s/^\s+|\s+$//g;
 9556: 
 9557: 	# Remove parenthetical notes like "(no password)" only if there's content before them
 9558: 	$value =~ s/(\S+)\s*\([^)]+\)\s*$/$1/;
 9559: 	$value =~ s/^\s+|\s+$//g;
 9560: 
 9561: 	# Handle chained || or // operators - extract the rightmost value
 9562: 	if ($value =~ /\|\||\/{2}/) {
 9563: 		my @parts = split(/\s*(?:\|\||\/{2})\s*/, $value);

					

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

				
COND_INV_9563_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 9564: 		$value = $parts[-1];
 9565: 		$value =~ s/^\s+|\s+$//g;
 9566: 	}
 9567: 
 9568: 	# Remove trailing semicolon if present
  Mutants (Total: 1, Killed: 1, Survived: 0)
●9569 → 9572 → 9581 9569: 	$value =~ s/;\s*$//;
 9570: 
 9571: 	# Handle q{}, qq{}, qw{} quotes
 9572: 	if ($value =~ /^qq?\{(.*?)\}$/s) {
 9573: 		$value = $1;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9574: 	} elsif ($value =~ /^qw\{(.*?)\}$/s) {
 9575: 		$value = $1;
 9576: 	} elsif ($value =~ /^q[qwx]?\s*([^a-zA-Z0-9\{\[])(.*?)\1$/s) {
 9577: 		$value = $2;
 9578: 	}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9579: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9580: 	# Handle quoted strings
  Mutants (Total: 2, Killed: 2, Survived: 0)
●9581 → 9581 → 9604 9581: 	if ($value =~ /^(['"])(.*)\1$/s) {
 9582: 		$value = $2;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9583: 
 9584: 		if ($from_code) {
 9585: 			# In regex captures from source code, escape sequences are doubled
 9586: 			# \\n in capture needs to become \n for the test
 9587: 			$value =~ s/\\\\/\\/g;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9588: 		}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9589: 
 9590: 		# Only unescape the quote characters themselves
 9591: 		$value =~ s/\\"/"/g;
 9592: 		$value =~ s/\\'/'/g;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9593: 

					

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

				
BOOL_NEGATE_9593_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_9593_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 9594: 		# If NOT from code (i.e., from POD), interpret escape sequences
 9595: 		unless ($from_code) {

					

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

				
BOOL_NEGATE_9595_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_9595_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 9596: 			$value =~ s/\\n/\n/g;
 9597: 			$value =~ s/\\r/\r/g;
 9598: 			$value =~ s/\\t/\t/g;
 9599: 			$value =~ s/\\\\/\\/g;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9600: 		}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9601: 	}
 9602: 
 9603: 	# Sometimes trailing ) is left on
●9604 → 9604 → 9609 9604: 	if($value !~ /^\(/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9605: 		$value =~ s/\)$//;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9606: 	}
 9607: 
 9608: 	# Handle Perl empty hash (must be before numeric/boolean checks)
●9609 → 9609 → 9614 9609: 	if ($value =~ /^\{\s*\}$/) {
 9610: 		return {};
 9611: 	}
 9612: 

					

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

				
COND_INV_9612_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 9613: 	# Handle Perl empty list/array
●9614 → 9614 → 9619 9614: 	if ($value =~ /^\[\s*\]$/) {
 9615: 		return [];
 9616: 	}
 9617: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9618: 	# Handle numeric values
●9619 → 9619 → 9628 9619: 	if ($value =~ /^-?\d+(?:\.\d+)?$/) {
 9620: 		if ($value =~ /\./) {
 9621: 			return $value + 0;
 9622: 		} else {
 9623: 			return int($value);
 9624: 		}
 9625: 	}
 9626: 
 9627: 	# Handle boolean keywords
●9628 → 9628 → 9633 9628: 	if ($value =~ /^(true|false)$/i) {
 9629: 		return lc($1) eq 'true' ? 1 : 0;
 9630: 	}
 9631: 
 9632: 	# Handle Perl boolean constants
●9633 → 9633 → 9640 9633: 	if ($value eq '1') {
 9634: 		return 1;
 9635: 	} elsif ($value eq '0') {
 9636: 		return 0;
 9637: 	}
 9638: 
 9639: 	# Handle undef
●9640 → 9640 → 9645 9640: 	if ($value eq 'undef') {
 9641: 		return undef;
 9642: 	}
 9643: 
 9644: 	# Handle __PACKAGE__ and similar constants
●9645 → 9645 → 9650 9645: 	if ($value eq '__PACKAGE__') {
 9646: 		return '__PACKAGE__';
 9647: 	}
 9648: 
 9649: 	# Remove surrounding parentheses
●9650 → 9653 → 9658 9650: 	$value =~ s/^\((.+)\)$/$1/;
 9651: 
 9652: 	# Handle expressions we can't evaluate
 9653: 	if ($value =~ /^\$[a-zA-Z_]/ || $value =~ /\(.*\)/) {
 9654: 		return if($value =~ /^\$|\@|\%/);	# The default is a value, so who knows its type?
 9655: 		# return $value;
 9656: 	}
 9657: 
 9658: 	return $value;
 9659: }
 9660: 
 9661: # --------------------------------------------------
 9662: # _validate_pod_code_agreement
 9663: #
 9664: # Purpose:    Compare POD parameter documentation
 9665: #             against code-inferred parameters and
 9666: #             return a list of disagreements when
 9667: #             strict_pod mode is enabled.
 9668: #
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9669: # Entry:      $pod_params  - hashref of parameters
 9670: #                            from POD analysis.
 9671: #             $code_params - hashref of parameters
 9672: #                            from code analysis.
 9673: #             $method_name - method name string,
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9674: #                            used for context in
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9675: #                            error messages.
 9676: #
 9677: # Exit:       Returns a list of disagreement
 9678: #             strings. Returns an empty list if
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9679: #             all parameters agree.
 9680: #
 9681: # Side effects: None.
 9682: #
 9683: # Notes:      Type mismatches are classified as
 9684: #             either 'compatible' (e.g. integer vs
 9685: #             number) or 'incompatible' via
 9686: #             _types_are_compatible. $self and
 9687: #             $class are excluded from undocumented
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9688: #             parameter warnings in appropriate
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9689: #             context.
 9690: # --------------------------------------------------
 9691: sub _validate_pod_code_agreement {
●9692 → 9699 → 9760 9692: 	my ($self, $pod_params, $code_params, $method_name) = @_;
 9693: 
 9694: 	my @errors;
 9695: 
 9696: 	# Get all parameter names from both sources
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9697: 	my %all_params = map { $_ => 1 } (keys %$pod_params, keys %$code_params);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9698: 
 9699: 	foreach my $param (sort keys %all_params) {
 9700: 		my $pod = $pod_params->{$param} || {};
 9701: 		my $code = $code_params->{$param} || {};
 9702: 
 9703: 		# Params from a =head3|4 Input formal spec are the authoritative API
 9704: 		# definition — they are exempt from POD/code disagreement checks since

					

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

				
NUM_BOUNDARY_9704_66_==: Numeric boundary flip != to ==
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 9705: 		# the spec takes precedence over heuristic code analysis.
 9706: 		next if $pod->{_from_input_spec};
 9707: 
 9708: 		# Check if parameter exists in both

					

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

				
NUM_BOUNDARY_9708_66_==: Numeric boundary flip != to ==
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 9709: 		if (exists $pod_params->{$param} && !exists $code_params->{$param}) {
 9710: 			push @errors, "Parameter '\$$param' documented in POD but not found in code signature";
 9711: 			next;
 9712: 		}
 9713: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9714: 		if(!exists $pod_params->{$param} && exists $code_params->{$param}) {
 9715: 			if($param eq 'class') {
 9716: 				# $class is the class invocant, not a user-facing parameter
 9717: 				next;
 9718: 			}
 9719: 			if($param eq 'self') {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9720: 				# $self is the instance invocant, not a user-facing parameter
 9721: 				next;
 9722: 			}
 9723: 			push @errors, "Parameter '\$$param' found in code but not documented in POD";
 9724: 			next;
 9725: 		}
 9726: 
 9727: 		# Compare types if both exist
 9728: 		if ($pod->{type} && $code->{type} && $pod->{type} ne $code->{type}) {
 9729: 			if (!$self->_types_are_compatible($pod->{type}, $code->{type})) {
 9730: 				push @errors, "Type mismatch for '\$$param': POD says '$pod->{type}', code suggests '$code->{type}' (incompatible)";
 9731: 			} else {
 9732: 				push @errors, "Type difference for '\$$param': POD says '$pod->{type}', code suggests '$code->{type}' (compatible)";
 9733: 			}
 9734: 		}
 9735: 
 9736: 		# Compare optional status if both exist
 9737: 		if (exists $pod->{optional} && exists $code->{optional} &&
 9738: 			$pod->{optional} != $code->{optional}) {
 9739: 			my $pod_status = $pod->{optional} ? 'optional' : 'required';
 9740: 			my $code_status = $code->{optional} ? 'optional' : 'required';
 9741: 			push @errors, "Optional status mismatch for '\$$param': POD says '$pod_status', code suggests '$code_status'";
 9742: 		}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9743: 
 9744: 		# Check constraints (min/max)
 9745: 		if (defined $pod->{min} && defined $code->{min} && $pod->{min} != $code->{min}) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9746: 			push @errors, "Min constraint mismatch for '\$$param': POD says '$pod->{min}', code suggests '$code->{min}'";
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9747: 		}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9748: 
 9749: 		if (defined $pod->{max} && defined $code->{max} && $pod->{max} != $code->{max}) {
 9750: 			push @errors, "Max constraint mismatch for '\$$param': POD says '$pod->{max}', code suggests '$code->{max}'";
 9751: 		}
 9752: 
 9753: 		# Check regex patterns
 9754: 		if ($pod->{matches} && $code->{matches} && $pod->{matches} ne $code->{matches}) {
 9755: 			push @errors, "Pattern mismatch for '\$$param': POD says '$pod->{matches}', code suggests '$code->{matches}'";
 9756: 		}
 9757: 	}
 9758: 
 9759: 	# Return errors (empty array if no errors)
 9760: 	return @errors;
 9761: }
 9762: 
 9763: # --------------------------------------------------
 9764: # _validate_strictness_level
 9765: #
 9766: # Purpose:    Validate and normalise the strict_pod
 9767: #             option value accepted by new() into
 9768: #             an integer level: 0 (off), 1 (warn),
 9769: #             or 2 (fatal).
 9770: #
 9771: # Entry:      $val - the raw value passed to
 9772: #                    strict_pod in new(). May be
 9773: #                    undef, a number, or a string.
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9774: #
 9775: # Exit:       Returns 0, 1, or 2.
 9776: #             Croaks if the value is not recognised.
 9777: #
 9778: # Side effects: None.
 9779: # --------------------------------------------------
 9780: sub _validate_strictness_level {
 9781: 	my $val = $_[0];
 9782: 
 9783: 	return 0 unless defined $val;
 9784: 
 9785: 	# Numeric
 9786: 	return 0 if $val =~ /^(0|off|none)$/i;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9787: 	return 1 if $val =~ /^(1|warn|warning)$/i;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9788: 	return 2 if $val =~ /^(2|fatal|die|error)$/i;
 9789: 
 9790: 	croak("Invalid value for --strict-pod: '$val' (use off|warn|fatal)");
 9791: }

					

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

				
COND_INV_9791_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 9792: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9793: # --------------------------------------------------
 9794: # _types_are_compatible
 9795: #

					

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

				
BOOL_NEGATE_9795_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_9795_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 9796: # Purpose:    Determine whether two type strings
 9797: #             are compatible for POD/code agreement
 9798: #             checking, allowing semantically
 9799: #             equivalent types (e.g. 'integer' and
 9800: #             'number') to coexist without
 9801: #             triggering a strict POD warning.
 9802: #
 9803: # Entry:      $pod_type  - type string from POD.
 9804: #             $code_type - type string from code.
 9805: #
 9806: # Exit:       Returns 1 if compatible, 0 otherwise.
 9807: #
 9808: # Side effects: None.
 9809: # --------------------------------------------------
 9810: sub _types_are_compatible {
●9811 → 9827 → 9832 9811: 	my ($self, $pod_type, $code_type) = @_;
 9812: 
 9813: 	# Exact match is always compatible
 9814: 	return 1 if $pod_type eq $code_type;
 9815: 
 9816: 	# Define compatibility matrix
 9817: 	my %compatible_types = (
 9818: 		'integer' => ['number', 'scalar'],
 9819: 		'number' => ['scalar'],
 9820: 		'string' => ['scalar'],
 9821: 		'scalar' => ['string', 'integer', 'number'],
 9822: 		'arrayref' => ['array'],
 9823: 		'hashref' => ['hash'],
 9824: 	);
 9825: 
 9826: 	# Check if code_type is compatible with pod_type
 9827: 	if (my $allowed = $compatible_types{$pod_type}) {
 9828: 		return grep { $_ eq $code_type } @$allowed;
 9829: 	}
 9830: 
 9831: 	# Check if pod_type is compatible with code_type
●9832 → 9832 → 9836 9832: 	if (my $allowed = $compatible_types{$code_type}) {
 9833: 		return grep { $_ eq $pod_type } @$allowed;
 9834: 	}
 9835: 
 9836: 	return 0;	# Not compatible
 9837: }
 9838: 
 9839: =head2 generate_pod_validation_report
 9840: 
 9841: Generate a human-readable report of all POD/code disagreements found
 9842: across a set of extracted schemas.
 9843: 
 9844:     my $schemas = $extractor->extract_all(no_write => 1);
 9845:     my $report  = $extractor->generate_pod_validation_report($schemas);
 9846:     print $report;
 9847: 
 9848: =head3 Arguments
 9849: 
 9850: =over 4
 9851: 
 9852: =item * C<$schemas>
 9853: 
 9854: A hashref of method name to schema hashref as returned by
 9855: C<extract_all>. Required.
 9856: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9857: =back
 9858: 
 9859: =head3 Returns
 9860: 
 9861: A string containing the full validation report, or a single line
 9862: confirming all methods passed if no disagreements were found.
 9863: 
 9864: =head3 Side effects
 9865: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 9866: None.
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9867: 
 9868: =head3 Notes
  Mutants (Total: 2, Killed: 2, Survived: 0)
 9869: 
 9870: Only methods whose schemas contain a C<_pod_validation_errors> key
 9871: (populated when C<strict_pod> is 1 or 2) appear in the report. If
 9872: C<strict_pod> was 0 when C<extract_all> was called, this method will
 9873: always return the all-passed message.
 9874: 
 9875: =head3 API specification
 9876: 
 9877: =head4 input
 9878: 
 9879:     {
 9880:         self    => { type => OBJECT,  isa => 'App::Test::Generator::SchemaExtractor' },
 9881:         schemas => { type => HASHREF },
 9882:     }
 9883: 
 9884: =head4 output
 9885: 
 9886:     { type => SCALAR }
 9887: 
 9888: =cut
 9889: 
 9890: sub generate_pod_validation_report {
●9891 → 9894 → 9906 9891: 	my ($self, $schemas) = @_;
 9892: 
 9893: 	my @reports;
 9894: 	foreach my $method_name (sort keys %$schemas) {
 9895: 		my $schema = $schemas->{$method_name};
 9896: 
 9897: 		if (my $errors = $schema->{_pod_validation_errors}) {
 9898: 			push @reports, "Method: $method_name";
 9899: 			push @reports, "  Severity: " . ($schema->{_pod_disagreement} ? 'warning' : 'fatal');
 9900: 			push @reports, "  Errors:";
 9901: 			push @reports, map { "    - $_" } @$errors;
 9902: 			push @reports, '';
 9903: 		}
 9904: 	}
 9905: 
●9906 → 9906 → 0 9906: 	if (@reports) {
 9907: 		return join("\n", "POD/Code Validation Report:", '=' x 40, '', @reports);
 9908: 	} else {
 9909: 		return 'POD/Code Validation: All methods passed consistency checks.';
 9910: 	}
 9911: }
 9912: 
 9913: =head2 _log
 9914: 
 9915: Log a message if verbose mode is on.
 9916: 
 9917: =cut
 9918: 
 9919: sub _log {
 9920: 	my($self, $msg) = @_;
 9921: 
 9922: 	print "$msg\n" if $self->{verbose};
 9923: }
 9924: 
 9925: =head1 NOTES
 9926: 
 9927: C<SchemaExtractor> uses heuristic analysis of Perl source and POD to infer
 9928: parameter types and constraints. Inference accuracy improves with
 9929: well-documented modules; C<=head3 Input> / C<=head4 Input> formal specs are
 9930: parsed at highest priority and override all heuristics.
 9931: 
 9932: The output is always a best-effort schema suitable as a starting template;
 9933: review and augment the generated YAML before using it as a definitive
 9934: specification. Pass it to L<App::Test::Generator> to generate fuzz harnesses.
 9935: 
 9936: =head1 TODO
 9937: 
 9938: Extend C<=head4 Input> parsing to cover the C<enum>/C<memberof> constraint
 9939: synonym (union types, e.g. C<scalar | scalarref>, are already handled by
 9940: C<_map_formal_input_type>).
 9941: 
 9942: =head1 SEE ALSO
 9943: 
 9944: =over 4
 9945: 
 9946: =item * L<App::Test::Generator> - Generate fuzz and corpus-driven test harnesses
 9947: 
 9948: Output from this module serves as input to that module.
 9949: So with well-documented code, you can automatically create your tests.
 9950: 
 9951: =item * L<App::Test::Generator::Template> - Template of the file of tests created by C<App::Test::Generator>
 9952: 
 9953: =back
 9954: 
 9955: =head1 AUTHOR
 9956: 
 9957: Nigel Horne, C<< <njh at nigelhorne.com> >>
 9958: 
 9959: =head1 LICENCE AND COPYRIGHT
 9960: 
 9961: Copyright 2025-2026 Nigel Horne.
 9962: 
 9963: Usage is subject to GPL2 licence terms.
 9964: If you use it,
 9965: please let me know.
 9966: 
 9967: =cut
 9968: 
 9969: 1;