package App::Test::Generator::SchemaExtractor;

use strict;
use warnings;
use autodie qw(:all);

use App::Test::Generator::Model::Method;
use App::Test::Generator::Analyzer::Complexity;
use App::Test::Generator::Analyzer::Return;
use App::Test::Generator::Analyzer::ReturnMeta;
use App::Test::Generator::Analyzer::SideEffect;

use Carp qw(carp croak);
use PPI;
use Pod::Simple::Text;
use File::Basename;
use File::Path qw(make_path);
use Params::Get;
use Safe;
use Scalar::Util qw(looks_like_number);
use YAML::XS;
use IPC::Open3;
use JSON::MaybeXS qw(encode_json decode_json);
use Readonly;
use Symbol qw(gensym);

# --------------------------------------------------
# Confidence score thresholds for input and output analysis
# --------------------------------------------------
Readonly my $CONFIDENCE_HIGH_THRESHOLD   => 60;
Readonly my $CONFIDENCE_MEDIUM_THRESHOLD => 35;
Readonly my $CONFIDENCE_LOW_THRESHOLD    => 15;

# --------------------------------------------------
# Confidence level label strings
# --------------------------------------------------
Readonly my $LEVEL_HIGH     => 'high';
Readonly my $LEVEL_MEDIUM   => 'medium';
Readonly my $LEVEL_LOW      => 'low';
Readonly my $LEVEL_VERY_LOW => 'very_low';
Readonly my $LEVEL_NONE     => 'none';

# --------------------------------------------------
# Analysis limits
# --------------------------------------------------
Readonly my $DEFAULT_MAX_PARAMETERS     => 20;
Readonly my $DEFAULT_CONFIDENCE_THRESH  => 0.5;
Readonly my $POD_WALK_LIMIT             => 200;
Readonly my $SIGNATURE_TIMEOUT_SECS     => 3;
Readonly my $MEMORY_LIMIT_BYTES         => 50_000_000;

# --------------------------------------------------
# Numeric boundary values for test hint generation
# --------------------------------------------------
Readonly my $INT32_MAX => 2_147_483_647;

# --------------------------------------------------
# Boolean return score thresholds
# --------------------------------------------------
Readonly my $BOOLEAN_SCORE_THRESHOLD => 30;

=head1 NAME

App::Test::Generator::SchemaExtractor - Extract test schemas from Perl modules

=head1 VERSION

Version 0.35

=cut

our $VERSION = '0.35';

=head1 SYNOPSIS

	use App::Test::Generator::SchemaExtractor;

	my $extractor = App::Test::Generator::SchemaExtractor->new(
		input_file => 'lib/MyModule.pm',
		output_dir => 'schemas/',
		verbose	=> 1,
	);

	my $schemas = $extractor->extract_all();

=head1 DESCRIPTION

App::Test::Generator::SchemaExtractor analyzes Perl modules and generates
structured YAML schema files suitable for automated test generation by L<App::Test::Generator>.
This module employs
static analysis techniques to infer parameter types, constraints, and
method behaviors directly from your source code.

=head2 Analysis Methods

The extractor combines multiple analysis approaches for a comprehensive schema generation:

=over 4

=item * B<POD Documentation Analysis>

Parses embedded documentation to extract:
  - Parameter names, types, and descriptions from =head2 sections
  - Method signatures with positional parameters
  - Return value specifications from "Returns:" sections
  - Constraints (ranges, patterns, required/optional status)
  - Semantic type detection (email, URL, filename)

=item * B<Code Pattern Detection>

Analyzes source code using PPI to identify:
  - Method signatures and parameter extraction patterns
  - Type validation (ref(), isa(), blessed())
  - Constraint patterns (length checks, numeric comparisons, regex matches)
  - Return statement analysis and value type inference
  - Object instantiation requirements and accessor methods

=item * B<Signature Analysis>

Examines method declarations for:
  - Parameter names and positional information
  - Instance vs. class method detection
  - Method modifiers (Moose-style before/after/around)
  - Various parameter declaration styles (shift, @_ assignment)

=item * B<Heuristic Inference>

Applies Perl-specific domain knowledge:
  - Boolean return detection from method names (is_*, has_*, can_*)
  - Common Perl idioms and coding patterns
  - Context awareness (scalar vs list, wantarray usage)
  - Object-oriented patterns (constructors, accessors, chaining)

=back

=head2 Generated Schema Structure

The extracted schemas follow this YAML structure:

    function: method_name
    module: Package::Name
    input:
      param1:
        type: string
        min: 3
        max: 50
        optional: 0
        position: 0
      param2:
        type: integer
        min: 0
        max: 100
        optional: 1
        position: 1
    output:
      type: boolean
      value: 1
    new: Package::Name # if object instantiation required
    config:
      test_empty: 1
      test_nuls: 0
      test_undef: 0
      test_non_ascii: 0

=head2 Advanced Detection Capabilities

=over 4

=item * B<Accessor Method Detection>

Automatically identifies getter, setter, and combined accessor methods
by analyzing common patterns like C<return $self-E<gt>{property}> and
C<$self-E<gt>{property} = $value>.

=item * B<Boolean Return Inference>

Detects boolean-returning methods through multiple signals:
  - Method name patterns (is_*, has_*, can_*)
  - Return patterns (consistent 1/0 returns)
  - POD descriptions ("returns true on success")
  - Ternary operators with boolean results

=item * B<Context Awareness>

Identifies methods that use C<wantarray> and can return different
values in scalar vs list context.

=item * B<Object Lifecycle Management>

Detects instance methods requiring object instantiation and
automatically adds the C<new> field to schemas.

=item * B<Enhanced Object Detection>

The extractor includes sophisticated object detection capabilities that go beyond simple instance method identification:

=over 4

=item * B<Factory Method Recognition>

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.

=item * B<Singleton Pattern Detection>

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.

=item * B<Constructor Parameter Analysis>

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.

=item * B<Inheritance Relationship Handling>

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.

=item * B<External Object Dependency Detection>

Identifies when methods create or depend on objects from other classes, enabling proper test setup with mock objects or real dependencies.

=back

These enhancements ensure that generated test schemas accurately reflect the object-oriented structure of the code, leading to more meaningful and effective test generation.

=back

=head2 Confidence Scoring

Each generated schema includes detailed confidence assessments:

=over 4

=item * B<High Confidence>

Multiple independent analysis sources converge on consistent,
well-constrained parameters with explicit validation logic and
comprehensive documentation.

=item * B<Medium Confidence>

Reasonable evidence from code patterns or partial documentation,
but may lack comprehensive constraints or have some ambiguities.

=item * B<Low Confidence>

Minimal evidence - primarily based on naming conventions,
default assumptions, or single-source analysis.

=item * B<Very Low Confidence>

Barely any detectable signals - schema should be thoroughly
reviewed before use in test generation.

=back

=head2 Use Cases

=over 4

=item * B<Automated Test Generation>

Generate comprehensive test suites with L<App::Test::Generator> using
extracted schemas as input. The schemas provide the necessary structure
for generating both positive and negative test cases.

=item * B<API Documentation Generation>

Supplement existing documentation with automatically inferred interface
specifications, parameter requirements, and return types.

=item * B<Code Quality Assessment>

Identify methods with poor documentation, inconsistent parameter handling,
or unclear interfaces that may benefit from refactoring.

=item * B<Refactoring Assistance>

Detect method dependencies, object instantiation requirements, and
parameter usage patterns to inform refactoring decisions.

=item * B<Legacy Code Analysis>

Quickly understand the interface contracts of legacy Perl codebases
without extensive manual code reading.

=back

=head2 Integration with Testing Ecosystem

The generated schemas are specifically designed to work with the
L<App::Test::Generator> ecosystem:

    # Extract schemas from your module
    my $extractor = App::Test::Generator::SchemaExtractor->new(...);
    my $schemas = $extractor->extract_all();

    # Use with test generator (typically as separate steps)
    # fuzz-harness-generator -r schemas/method_name.yml

=head2 Limitations and Considerations

=over 4

=item * B<Dynamic Code Patterns>

Highly dynamic code (string evals, AUTOLOAD, symbolic references)
may not be fully detected by static analysis.

=item * B<Complex Validation Logic>

Sophisticated validation involving multiple parameters or external
dependencies may require manual schema refinement.

=item * B<Confidence Heuristics>

Confidence scores are based on heuristics and should be reviewed
by developers familiar with the codebase.

=item * B<Perl Idiom Recognition>

Some Perl-specific idioms may require custom pattern recognition
beyond the built-in detectors.

=item * B<Documentation Dependency>

Analysis quality improves significantly with comprehensive POD
documentation following consistent patterns.

=back

=head2 Best Practices for Optimal Results

=over 4

=item * B<Comprehensive POD Documentation>

Write detailed POD with explicit parameter documentation using
consistent patterns like C<$param - type (constraints), description>.

=item * B<Consistent Coding Patterns>

Use consistent parameter validation patterns and method signatures
throughout your codebase.

=item * B<Schema Review Process>

Review and refine automatically generated schemas, particularly
those with low confidence scores.

=item * B<Descriptive Naming>

Use descriptive method and parameter names that clearly indicate
purpose and expected types.

=item * B<Progressive Enhancement>

Start with automatically generated schemas and progressively
refine them based on test results and code understanding.

=back

The module is particularly valuable for large codebases where manual schema
creation would be prohibitively time-consuming, and for maintaining test
coverage as code evolves through continuous integration pipelines.

=head2 Advanced Type Detection

The schema extractor includes enhanced type detection capabilities that identify specialized Perl types beyond basic strings and integers.
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.
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.
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.

=head3 Example Advanced Type Schema

For a method like:

    sub process_event {
        my ($self, $timestamp, $status, $callback) = @_;
        croak unless $timestamp > 1000000000;
        croak unless $status =~ /^(active|pending|complete)$/;
        croak unless ref($callback) eq 'CODE';
        $callback->($timestamp, $status);
    }

The extractor generates:

    ---
    function: process_event
    module: MyModule
    input:
      timestamp:
        type: integer
        # min: 0
        # max: 2147483647
        position: 0
        _note: Unix timestamp
	semantic: unix_timestamp
      status:
        type: string
        enum:
          - active
          - pending
          - complete
        position: 1
        _note: 'Must be one of: active, pending, complete'
      callback:
        type: coderef
        position: 2
        _note: 'CODE reference - provide sub { } in tests'

=head1 RELATIONSHIP DETECTION

The schema extractor detects relationships and dependencies between parameters,
enabling more sophisticated validation and test generation.

=head2 Relationship Types

=over 4

=item * B<mutually_exclusive>

Parameters that cannot be used together.

    die if $file && $content;  # Can't specify both

Generated schema:

    relationships:
      - type: mutually_exclusive
        params: [file, content]
        description: Cannot specify both file and content

=item * B<required_group>

At least one parameter from the group must be specified (OR logic).

    die unless $id || $name;  # Must provide one

Generated schema:

    relationships:
      - type: required_group
        params: [id, name]
        logic: or
        description: Must specify either id or name

=item * B<conditional_requirement>

If one parameter is specified, another becomes required (IF-THEN logic).

    die if $async && !$callback;  # async requires callback

Generated schema:

    relationships:
      - type: conditional_requirement
        if: async
        then_required: callback
        description: When async is specified, callback is required

=item * B<dependency>

One parameter depends on another being present.

    die "Port requires host" if $port && !$host;

Generated schema:

    relationships:
      - type: dependency
        param: port
        requires: host
        description: port requires host to be specified

=item * B<value_constraint>

Specific value requirements between parameters.

    die if $ssl && $port != 443;  # ssl requires port 443

Generated schema:

    relationships:
      - type: value_constraint
        if: ssl
        then: port
        operator: ==
        value: 443
        description: When ssl is specified, port must equal 443

=item * B<value_conditional>

Parameter required when another has a specific value.

    die if $mode eq 'secure' && !$key;

Generated schema:

    relationships:
      - type: value_conditional
        if: mode
        equals: secure
        then_required: key
        description: When mode equals 'secure', key is required

=back

=head2 Default Value Extraction

The extractor comprehensively extracts default values from both code and POD documentation:

=head3 Code Pattern Recognition

Extracts defaults from multiple Perl idioms:

=over 4

=item * Logical OR operator: C<$param = $param || 'default'>

=item * Defined-or operator: C<$param //= 'default'>

=item * Ternary operator: C<$param = defined $param ? $param : 'default'>

=item * Unless conditional: C<$param = 'default' unless defined $param>

=item * Chained defaults: C<$param = $param || $self->{_default} || 'fallback'>

=item * Multi-line patterns: C<$param = {} unless $param>

=back

=head3 POD Pattern Recognition

Extracts defaults from documentation:

=over 4

=item * Standard format: C<Default: 'value'>

=item * Alternative format: C<Defaults to: 'value'>

=item * Inline format: C<Optional, default: 'value'>

=item * Parameter lists: C<$param - type, default 'value'>

=back

=head3 Value Processing

Properly handles:

=over 4

=item * String literals with quotes and escape sequences

=item * Numeric values (integers and floats)

=item * Boolean values (true/false converted to 1/0)

=item * Empty data structures ([] and {})

=item * Special values (undef, __PACKAGE__)

=item * Complex expressions (preserved as-is when unevaluatable)

=item * Quote operators (q{}, qq{}, qw{})

=back

=head3 Type Inference

When a parameter has a default value but no explicit type annotation,
the type is automatically inferred from the default:

    $options = {}        # inferred as hashref
    $items = []          # inferred as arrayref
    $count = 42          # inferred as integer
    $ratio = 3.14        # inferred as number
    $enabled = 1         # inferred as boolean

=head2 Context-Aware Return Analysis

The extractor provides comprehensive analysis of method return behavior,
including context sensitivity, error handling conventions, and method chaining patterns.

=head3 List vs Scalar Context Detection

Automatically detects methods that return different values based on calling context:

    sub get_items {
        my $self = $_[0];
        return wantarray ? @items : scalar(@items);
    }

Detection captures:

=over 4

=item * C<_context_aware> flag - Method uses wantarray

=item * C<_list_context> - Type returned in list context (e.g., 'array')

=item * C<_scalar_context> - Type returned in scalar context (e.g., 'integer')

=back

Recognizes both ternary operator patterns and conditional return patterns.

=head3 Void Context Methods

Identifies methods that don't return meaningful values:

=over 4

=item * Setters (C<set_*> methods)

=item * Mutators (C<add_*, remove_*, delete_*, clear_*, reset_*, update_*>)

=item * Loggers (C<log, debug, warn, error, info>)

=item * Methods with only empty returns

=back

Example:

    sub set_name {
        my ($self, $name) = @_;
        $self->{name} = $name;
        return;  # Void context
    }

Sets C<_void_context> flag and C<type =E<gt> 'void'>.

=head3 Method Chaining Detection

Identifies chainable methods that return C<$self> for fluent interfaces:

    sub set_width {
        my ($self, $width) = @_;
        $self->{width} = $width;
        return $self;  # Chainable
    }

Detection provides:

=over 4

=item * C<_returns_self> - Returns invocant for chaining

=item * C<class> - The class name being returned

=back

Also detects chaining documentation in POD (keywords: "chainable", "fluent interface",
"returns self", "method chaining").

=head3 Error Return Conventions

Analyzes how methods signal errors:

B<Pattern Detection:>

=over 4

=item * C<undef_on_error> - Explicit C<return undef if/unless condition>

=item * C<implicit_undef> - Bare C<return if/unless condition>

=item * C<empty_list> - C<return ()> for list context errors

=item * C<zero_on_error> - Returns 0/false for boolean error indication

=item * C<exception_handling> - Uses eval blocks with error checking

=back

B<Example Analysis:>

    sub fetch_user {
        my ($self, $id) = @_;

        return undef unless $id;        # undef_on_error
        return undef if $id < 0;        # undef_on_error

        return $self->{users}{$id};
    }

Results in:

    _error_return: 'undef'
    _success_failure_pattern: 1
    _error_handling: {
        undef_on_error: ['$id', '$id < 0']
    }

B<Success/Failure Pattern:>

Methods that return different types for success vs. failure are flagged with
C<_success_failure_pattern>. Common patterns:

=over 4

=item * Returns value on success, undef on failure

=item * Returns true on success, false on failure

=item * Returns data on success, empty list on failure

=back

=head3 Success Indicator Detection

Methods that always return true (typically for side effects):

    sub update_status {
        my ($self, $status) = @_;
        $self->{status} = $status;
        return 1;  # Success indicator
    }

Sets C<_success_indicator> flag when method consistently returns 1.

=head3 Schema Output

Enhanced return analysis adds these fields to method schemas:

    output:
      type: boolean              # Inferred return type
      _context_aware: 1           # Uses wantarray
      _list_context:
        type: array
      _scalar_context:
        type: integer
      _returns_self: 1               # Returns $self
      _void_context: 1            # No meaningful return
      _success_indicator: 1       # Always returns true
      _error_return: undef        # How errors are signaled
      _success_failure_pattern: 1 # Mixed return types
      _error_handling:            # Detailed error patterns
        undef_on_error: [...]
        exception_handling: 1

This comprehensive analysis enables:

=over 4

=item * Better test generation (testing both contexts, error paths)

=item * Documentation generation (clear error conventions)

=item * API design validation (consistent error handling)

=item * Contract specification (precise return behavior)

=back

=head2 Example

For a method like:

    sub connect {
        my ($self, $host, $port, $ssl, $file, $content) = @_;

        die if $file && $content;                    # mutually exclusive
        die unless $host || $file;                   # required group
        die "Port requires host" if $port && !$host; # dependency
        die if $ssl && $port != 443;                 # value constraint

        # ... connection logic
    }

The extractor generates:

    relationships:
      - type: mutually_exclusive
        params: [file, content]
        description: Cannot specify both file and content
      - type: required_group
        params: [host, file]
        logic: or
        description: Must specify either host or file
      - type: dependency
        param: port
        requires: host
        description: port requires host to be specified
      - type: value_constraint
        if: ssl
        then: port
        operator: ==
        value: 443
        description: When ssl is specified, port must equal 443

=head1 MODERN PERL FEATURES

This module adds support for:

=head2 Subroutine Signatures (Perl 5.20+)

    sub connect($host, $port = 3306, %options) {
        ...
    }

Extracts: required params, optional params with defaults, slurpy params

=head2 Type Constraints (Perl 5.36+)

    sub calculate($x :Int, $y :Num) {
        ...
    }

Recognizes: Int, Num, Str, Bool, ArrayRef, HashRef, custom classes

=head3 Subroutine Attributes

    sub get_value :lvalue :Returns(Int) {
        ...
    }

Detects: :lvalue, :method, :Returns(Type), custom attributes

=head2 Postfix Dereferencing (Perl 5.20+)

    my @array = $arrayref->@*;
    my %hash = $hashref->%*;
    my @slice = $arrayref->@[1,3,5];

Tracks usage of modern dereferencing syntax

=head2 Field Declarations (Perl 5.38+)

    field $host :param = 'localhost';
    field $port :param(port_number) = 3306;
    field $logger :param :isa(Log::Any);

Extracts fields and maps them to parameters

=head2 Modern Perl Features Support

The schema extractor supports modern Perl syntax introduced in versions 5.20, 5.36, and 5.38+.

=head3 Subroutine Signatures (Perl 5.20+)

Automatically extracts parameters from native Perl signatures:

    use feature 'signatures';

    sub connect($host, $port = 3306, $database = undef) {
        ...
    }

Extracted schema includes:

=over 4

=item * Parameter positions

=item * Optional vs required parameters

=item * Default values from signature

=item * Slurpy parameters (@array, %hash)

=back

B<Example:>

    # Signature with defaults
    sub process($file, %options) { ... }

    # Extracts:
    # $file: position 0, required
    # %options: position 1, optional, slurpy hash

=head3 Type Constraints in Signatures (Perl 5.36+)

Recognizes type constraints in signature parameters:

    sub calculate($x :Int, $y :Num, $name :Str = "result") {
        return $x + $y;
    }

Supported constraint types:

=over 4

=item * C<:Int, :Integer> -> integer

=item * C<:Num, :Number> -> number

=item * C<:Str, :String> -> string

=item * C<:Bool, :Boolean> -> boolean

=item * C<:ArrayRef, :Array> -> arrayref

=item * C<:HashRef, :Hash> -> hashref

=item * C<:ClassName> -> object with isa constraint

=back

Type constraints are combined with defaults when both are present.

=head3 Subroutine Attributes

Extracts and documents subroutine attributes:

    sub get_value :lvalue {
        my $self = shift;
        return $self->{value};
    }

    sub calculate :Returns(Int) :method {
        my ($self, $x, $y) = @_;
        return $x + $y;
    }

Recognized attributes stored in C<_attributes> field:

=over 4

=item * C<:lvalue> - Method can be assigned to

=item * C<:method> - Explicitly marked as method

=item * C<:Returns(Type)> - Declares return type

=item * Custom attributes with values: C<:MyAttr(value)>

=back

=head3 Postfix Dereferencing (Perl 5.20+)

Detects usage of postfix dereferencing syntax:

    use feature 'postderef';

    sub process_array {
        my ($self, $arrayref) = @_;
        my @array = $arrayref->@*;        # Array dereference
        my @slice = $arrayref->@[1,3,5];  # Array slice
        return @array;
    }

    sub process_hash {
        my ($self, $hashref) = @_;
        my %hash = $hashref->%*;          # Hash dereference
        return keys %hash;
    }

Tracked features stored in C<_modern_features>:

=over 4

=item * C<array_deref> - Uses C<-E<gt>@*>

=item * C<hash_deref> - Uses C<-E<gt>%*>

=item * C<scalar_deref> - Uses C<-E<gt>$*>

=item * C<code_deref> - Uses C<-E<gt>&*>

=item * C<array_slice> - Uses C<-E<gt>@[...]>

=item * C<hash_slice> - Uses C<-E<gt>%{...}>

=back

=head3 Field Declarations (Perl 5.38+)

Extracts field declarations from class syntax and maps them to method parameters:

    use feature 'class';

    class DatabaseConnection {
        field $host :param = 'localhost';
        field $port :param = 3306;
        field $username :param(user);
        field $password :param;
        field $logger :param :isa(Log::Any);

        method connect() {
            # Fields available as instance variables
        }
    }

Field attributes:

=over 4

=item * C<:param> - Field is a constructor parameter (uses field name)

=item * C<:param(name)> - Field maps to parameter with different name

=item * C<:isa(Class)> - Type constraint for the field

=item * Default values in field declarations

=back

Extracted schema includes both field information in C<_fields> and merged parameter
information in C<input>, allowing proper validation of class constructors.

=head3 Mixed Modern and Traditional Syntax

The extractor handles code that mixes modern and traditional syntax:

    sub modern($x, $y = 5) {
        # Modern signature with default
    }

    sub traditional {
        my ($self, $x, $y) = @_;
        $y //= 5;  # Traditional default in code
        # Both extract same parameter information
    }

Priority order for parameter information:

=over 4

=item 1. Signature declarations (highest priority)

=item 2. Field declarations (for class methods)

=item 3. POD documentation

=item 4. Code analysis (lowest priority)

=back

This ensures that explicit declarations in signatures take precedence over
inferred information from code analysis.

=head3 Backwards Compatibility

All modern Perl feature detection is optional and automatic:

=over 4

=item * Traditional C<sub> declarations continue to work

=item * Code without modern features extracts parameters as before

=item * Modern features are additive - they enhance rather than replace existing extraction

=item * Schemas include C<_source> field indicating where parameter info came from

=back

=head2 _yamltest_hints

Each method schema returned by L</extract_all> now optionally includes a
C<_yamltest_hints> key, which provides guidance for automated test generation
based on the code analysis.

This is intended to help L<App::Test::Generator> create meaningful tests,
including boundary and invalid input cases, without manually specifying them.

The structure is a hashref with the following keys:

=over 4

=item * boundary_values

An arrayref of numeric values that represent boundaries detected from
comparisons in the code. These are derived from literals in statements
like C<$x < 0> or C<$y >= 255>. The generator can use these to create
boundary tests.

Example:

    _yamltest_hints:
      boundary_values: [0, 1, 100, 255]

=item * invalid_inputs

An arrayref of values that are likely to be rejected by the method,
based on checks like C<defined>, empty strings, or numeric validations.

Example:

    _yamltest_hints:
      invalid_inputs: [undef, '', -1]

=item * equivalence_classes

An arrayref intended to capture detected equivalence classes or patterns
among inputs. Currently this is empty by default, but future enhancements
may populate it based on detected input groupings.

Example:

    _yamltest_hints:
      equivalence_classes: []

=back

=head3 Usage

When calling C<extract_all>, each method schema will include
C<_yamltest_hints> if any hints were detected:

    my $schemas = $extractor->extract_all;
    my $hints  = $schemas->{example_method}->{_yamltest_hints};

You can then feed these hints into automated test generators to produce
negative tests, boundary tests, and parameter-specific test cases.

=head3 Notes

=over 4

=item * Hints are inferred heuristically from code and validation statements.

=item * Not all inputs are guaranteed to be detected; the feature is additive
and will never remove information from the schema.

=item * Currently, equivalence classes are not populated, but the field exists
for future extension.

=item * Boundary and invalid input hints are deduplicated to avoid repeated
test values.

=back

=head3 Examples

Given a method like:

    sub example {
        my ($x) = @_;
        die "negative" if $x < 0;
        return unless defined($x);
        return $x * 2;
    }

After running:

    my $extractor = App::Test::Generator::SchemaExtractor->new(
        input_file => 'TestHints.pm',
        output_dir => '/tmp',
        quiet    => 1,
    );

    my $schemas = $extractor->extract_all;

The schema for the method "example" will include:

    $schemas->{example} = {
        function => 'example',
        _confidence => {
            input  => 'unknown',
            output => 'unknown',
        },
        input => {
            x => {
                type     => 'scalar',
                optional => 0,
            }
        },
        output => {
            type => 'scalar',
        },
        _yamltest_hints => {
            boundary_values => [0, 1],
            invalid_inputs  => [undef, -1],
            equivalence_classes => [],
        },
        _notes => '...',
        _analysis => {
            input_confidence  => 'low',
            output_confidence => 'unknown',
            confidence_factors => {
                input  => {...},
                output => {...},
            },
            overall_confidence => 'low',
        },
        _fields => {},
        _modern_features => {},
        _attributes => {},
    };

=head1 METHODS

=head2 new

Construct a new SchemaExtractor for a given Perl source file.

    my $extractor = App::Test::Generator::SchemaExtractor->new(
        input_file           => 'lib/MyModule.pm',  # Required
        output_dir           => 'schemas/',         # Optional - only needed if writing schemas
        verbose              => 1,                  # Default: 0
        include_private      => 1,                  # Default: 0
        max_parameters       => 50,                 # Default: 20
        confidence_threshold => 0.7,               # Default: 0.5
        strict_pod           => 0|1|2,              # Default: 0 (off)
    );

=head3 Arguments

=over 4

=item * C<input_file>

Path to the Perl source file to analyse. Required. Must exist on disk.

=item * C<output_dir>

Directory to write generated schema YAML files. Optional - only
required if C<_write_schema> will be called. Callers passing
C<no_write =E<gt> 1> to C<extract_all> do not need to supply it.

=item * C<verbose>

Print progress messages to stdout during analysis. Optional, default 0.

=item * C<include_private>

Include methods whose names begin with C<_> in the analysis. Optional,
default 0. Methods named C<_new>, C<_init>, and C<_build> are always
included regardless of this setting.

=item * C<max_parameters>

Safety limit on the number of parameters analysed per method to prevent
runaway processing on pathological code. Optional, default 20.

=item * C<confidence_threshold>

Minimum confidence score (0.0-1.0) below which a schema is marked with
C<_low_confidence =E<gt> 1>. Optional, default 0.5.

=item * C<strict_pod>

Controls POD/code agreement validation. C<0> disables validation,
C<1> emits warnings, C<2> croaks on first disagreement. Also accepts
the strings C<off>, C<warn>, and C<fatal>. Optional, default 0.

=back

=head3 Returns

A blessed hashref. Croaks if C<input_file> is missing or does not
exist on disk.

=head3 Side effects

Reads and parses the input file using L<PPI> at construction time.

=head3 API specification

=head4 input

    {
        input_file           => { type => SCALAR },
        output_dir           => { type => SCALAR,  optional => 1 },
        verbose              => { type => SCALAR,  optional => 1 },
        include_private      => { type => SCALAR,  optional => 1 },
        max_parameters       => { type => SCALAR,  optional => 1 },
        confidence_threshold => { type => SCALAR,  optional => 1 },
        strict_pod           => { type => SCALAR,  optional => 1 },
    }

=head4 output

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

=cut

sub new {
	my $class = shift;

	# Handle hash or hashref arguments
	my $params = Params::Get::get_params('input_file', @_) || {};

	croak(__PACKAGE__, ': input_file required') unless exists $params->{input_file};

	my $self = {
		input_file => $params->{input_file},
		# output_dir is optional — only required if _write_schema will be called.
		# Callers using extract_all(no_write => 1) do not need to supply it.
		output_dir => $params->{output_dir},
		verbose	=> $params->{verbose} // 0,
		include_private => $params->{include_private} // 0,	# include _private methods
		confidence_threshold => $params->{confidence_threshold} // $DEFAULT_CONFIDENCE_THRESH,
		max_parameters       => $params->{max_parameters}       // $DEFAULT_MAX_PARAMETERS,	# safety limit
		strict_pod => _validate_strictness_level($params->{strict_pod}),	# Enable strict POD checking
	};

	# Validate input file exists
	unless (-f $self->{input_file}) {
		croak(__PACKAGE__, ": Input file '$self->{input_file}' does not exist");
	}

	return bless $self, $class;
}

=head2 extract_all

Extract schemas for all qualifying methods in the module and return
them as a hashref.

    my $schemas = $extractor->extract_all();

    # Suppress writing .yml files to disk
    my $schemas = $extractor->extract_all(no_write => 1);

=head3 Arguments

=over 4

=item * C<no_write>

When true, schema files are not written to C<output_dir>. The returned
hashref is still fully populated. Useful when the caller wants to
inspect or augment schemas before deciding whether to write them.
Optional, default 0.

=back

=head3 Returns

A hashref mapping method name strings to schema hashrefs. Each schema
contains at minimum the keys C<function>, C<module>, C<input>,
C<output>, and C<_analysis>. See L</Generated Schema Structure> for
the full structure.

=head3 Side effects

Parses the input file with L<PPI>. Writes one YAML file per method to
C<output_dir> unless C<no_write> is set. Creates C<output_dir> if it
does not exist and writing is enabled.

=head3 Notes

Private methods (names beginning with C<_>) are excluded unless
C<include_private =E<gt> 1> was passed to C<new>. Duplicate method
names are deduplicated with a warning logged to stdout in verbose mode.

POD/code agreement validation is applied if C<strict_pod> was set in
C<new>. At level 2 (fatal), the first disagreement causes an immediate
croak.

=head3 API specification

=head4 input

    {
        self     => { type => OBJECT, isa => 'App::Test::Generator::SchemaExtractor' },
        no_write => { type => SCALAR, optional => 1 },
    }

=head4 output

    {
        type => HASHREF,
        keys => {
            '*' => {
                type => HASHREF,
                keys => {
                    function  => { type => SCALAR  },
                    module    => { type => SCALAR  },
                    input     => { type => HASHREF },
                    output    => { type => HASHREF },
                    _analysis => { type => HASHREF },
                },
            },
        },
    }

=cut

sub extract_all {
	my $self = shift;
	my $params = Params::Get::get_params(undef, @_) || {};

	$self->_log("Parsing $self->{input_file}...");
	$self->_log('Strict POD mode: ' . (qw(off warn fatal))[$self->{strict_pod}]);

	my $document = PPI::Document->new($self->{input_file}) or die "Failed to parse $self->{input_file}: $!";

	# Store document for later use
	$self->{_document} = $document;

	my $package_name = $self->_extract_package_name($document);
	$self->{_package_name} //= $package_name;
	$self->_log("Package: $package_name");

	my $methods = $self->_find_methods($document);
	$self->_log('Found ' . scalar(@$methods) . ' methods (pre-dedup)');

	my %schemas;
	foreach my $method (@{$methods}) {
		$self->_log("\nAnalyzing method: $method->{name}");

		my $schema = $self->_analyze_method($method);
		$schemas{$method->{name}} = $schema;
		$schema->{'module'} = $package_name;

		# Write individual schema file
		# Only write schema files if no_write is not set
		$self->_write_schema($method->{name}, $schema) unless $params->{no_write};
	}

	return \%schemas;
}

# --------------------------------------------------
# _extract_package_name
#
# Purpose:    Extract the Perl package name from a
#             PPI document, or from the cached value
#             stored at construction time.
#
# Entry:      $document - a PPI::Document, or undef
#                         to use $self->{_document}.
#
# Exit:       Returns the package namespace string,
#             or an empty string if no package
#             statement is found.
#
# Side effects: Stores the package name in
#               $self->{_package_name} if not already
#               set.
#
# Notes:      Croaks if more than one package
#             declaration is found — multi-package
#             files are not supported.
# --------------------------------------------------
sub _extract_package_name {
	my ($self, $document) = @_;

	if(!defined($document)) {
		$document = $self->{_document};
	}
	my $pkgs = $document->find('PPI::Statement::Package') || [];
	if(@$pkgs == 0) {
		my $package_stmt = $document->find_first('PPI::Statement::Package');
		return $package_stmt ? $package_stmt->namespace() : '';
	}
	croak('More than one package declaration found') if @$pkgs > 1;
	$self->{_package_name} //= $pkgs->[0]->namespace();
	return $pkgs->[0]->namespace();
}

# --------------------------------------------------
# _find_methods
#
# Purpose:    Locate all subroutine and method
#             declarations in a PPI document,
#             including Moose-style method modifiers
#             and Perl 5.38 class/method syntax.
#
# Entry:      $document - a PPI::Document.
#
# Exit:       Returns an arrayref of method hashrefs,
#             each containing: name, node, body, pod,
#             type, and optionally modifier, class,
#             and fields keys.
#             Private methods (names beginning with
#             _) are excluded unless include_private
#             was set in new(), except for _new,
#             _init, and _build which are always
#             included.
#
# Side effects: Logs progress and warnings to stdout
#               when verbose is set.
#
# Notes:      Duplicate method names are silently
#             deduplicated — the second occurrence
#             is dropped with a verbose warning.
#             Class/method detection is regex-based
#             and may misbehave on complex code.
# --------------------------------------------------
sub _find_methods {
	my ($self, $document) = @_;

	my $subs = $document->find('PPI::Statement::Sub') || [];
	my $sub_decls = $document->find('PPI::Statement') || [];

	my @methods;
	foreach my $sub (@$subs) {
		my $name = $sub->name();

		next unless defined $name;	# Skip anonymous routines

		# Skip private methods unless explicitly included, or they're special
		if ($name =~ /^_/ && $name !~ /^_(new|init|build)/) {
			next unless $self->{include_private};
		}

		# Get the POD before this sub
		my $pod = $self->_extract_pod_before($sub);

		push @methods, {
			name => $name,
			node => $sub,
			body => $sub->content(),
			pod => $pod,
			type => 'sub',
		};
	}

	# Look for class { method } syntax (Perl 5.38+)
	my $content = $document->content();
	if ($content =~ /\bclass\b/) {
		$self->_log('  Detecting class/method syntax...');
		$self->_extract_class_methods($content, \@methods);
	}

	# Process method modifiers (Moose)
	foreach my $decl (@$sub_decls) {
		my $content = $decl->content;
		if ($content =~ /^\s*(before|after|around)\s+['"]?(\w+)['"]?\b/) {
			my ($modifier, $method_name) = ($1, $2);
			my $full_name = "${modifier}_$method_name";

			# Look for the actual sub definition that follows
			my $next_sib = $decl->next_sibling;
			while ($next_sib && !$next_sib->isa('PPI::Statement::Sub')) {
				$next_sib = $next_sib->next_sibling;
			}

			if ($next_sib && $next_sib->isa('PPI::Statement::Sub')) {
				my $pod = $self->_extract_pod_before($decl); # POD might be before modifier
				push @methods, {
					name => $full_name,
					node => $next_sib,
					body => $next_sib->content,
					pod => $pod,
					type => 'modifier',
					original_method => $method_name,
					modifier => $modifier,
				};
				$self->_log("  Found method modifier: $full_name");
			}
		}
	}

	# Prevent silent duplicate method overwrites
	my %seen;
	@methods = grep {
		my $n = $_->{name};
		if ($seen{$n}++) {
			$self->_log("  WARNING: duplicate method '$n' ignored");
			0;
		} else {
			1;
		}
	} @methods;

	return \@methods;
}

# --------------------------------------------------
# _extract_class_methods
#
# Purpose:    Extract method declarations from
#             Perl 5.38 class { method {} } syntax
#             by regex-based scanning of the class
#             body content.
#
# Entry:      $content - full document source string.
#             $methods - arrayref to push discovered
#                        method hashrefs onto
#                        (modified in place).
#
# Exit:       Returns nothing. Appends to $methods.
#
# Side effects: Logs class and method discoveries
#               to stdout when verbose is set.
#
# Notes:      This is experimental — regex-based
#             class body parsing may misbehave on
#             complex or nested class declarations.
#             Class body boundaries are tracked by
#             simple brace counting, which will
#             fail on unbalanced braces in strings
#             or heredocs.
# --------------------------------------------------
sub _extract_class_methods {
	my ($self, $content, $methods) = @_;

	# EXPERIMENTAL: regex-based parsing, may misbehave on complex code

	# Simple pattern: find "class Name {" blocks
	# This won't handle all edge cases but will work for simple classes
	while ($content =~ /class\s+(\w+)\s*\{/g) {
		my $class_name = $1;
		my $start_pos = pos($content);

		# Find the matching closing brace (simple brace counting)
		my $depth = 1;
		my $class_end = $start_pos;

		while ($depth > 0 && $class_end < length($content)) {
			my $char = substr($content, $class_end, 1);
			$depth++ if $char eq '{';
			$depth-- if $char eq '}';
			$class_end++;
		}

		next if $depth != 0;	# unbalanced braces, skip class

		my $class_body = substr($content, $start_pos, $class_end - $start_pos - 1);

		$self->_log("  Found class $class_name");

		# Extract field declarations from class
		my $fields = $self->_extract_field_declarations($class_body);

		# Find methods in the class body
		while ($class_body =~ /method\s+(\w+)\s*(\([^)]*\))?\s*\{/g) {
			my ($method_name, $sig_with_parens) = ($1, $2 || '()');

			# Skip private unless configured
			if ($method_name =~ /^_/ && $method_name !~ /^_(new|init|build)/) {
				next unless $self->{include_private};
			}

			# Reconstruct as sub for analysis
			my $signature = $sig_with_parens;
			$signature =~ s/^\(//;
			$signature =~ s/\)$//;

			# Build a fake sub declaration
			my $fake_sub = "sub $method_name($signature) { }";

			push @$methods, {
				name => $method_name,
				node => undef,
				body => $fake_sub,	# Just the signature for now
				is_stub => 1,
				pod => '',
				type => 'method',
				class => $class_name,
				fields => $fields,
			};

			$self->_log("  Found method $method_name in class $class_name");
		}
	}
}

# --------------------------------------------------
# _extract_pod_before
#
# Purpose:    Collect the POD documentation that
#             appears immediately before a
#             subroutine in the PPI document, by
#             walking backwards through siblings.
#
# Entry:      $sub - a PPI node (typically a
#                    PPI::Statement::Sub).
#
# Exit:       Returns a string containing all POD
#             content found before the sub, with
#             inline parameter comments converted
#             to =item format. Returns an empty
#             string if no POD is found.
#
# Side effects: None.
#
# Notes:      Stops walking backwards on the first
#             non-POD, non-whitespace, non-separator,
#             non-include node encountered.
#             Walking is capped at $POD_WALK_LIMIT
#             steps to prevent runaway processing
#             on pathological documents.
# --------------------------------------------------
sub _extract_pod_before {
	my ($self, $sub) = @_;

	my $pod = '';
	my $current = $sub->previous_sibling();
	my $seen_code = 0;
	my $steps = 0;

	# Walk backwards collecting POD
	while($current && $steps++ < $POD_WALK_LIMIT) {
		if ($current->isa('PPI::Token::Pod')) {
			$pod = $current->content() . $pod;
		} elsif ($current->isa('PPI::Token::Comment')) {
			# Include comments that might contain parameter info
			my $comment = $current->content();
			if ($comment =~ /#\s*(?:param|arg|input)\s+\$(\w+)\s*:\s*(.+)/i) {
				$pod .= "=item \$$1\n$2\n\n";
			}
		} elsif ($current->isa('PPI::Token::Whitespace') ||
			 $current->isa('PPI::Token::Separator')) {
			# Skip whitespace and separators
		} elsif ($current->isa('PPI::Statement::Include')) {
			# allow 'use strict', 'use warnings' between POD and sub
		} else {
			# Hit non-POD, non-whitespace - stop
			last;
		}
		$current = $current->previous_sibling();
	}

	return $pod;
}

# --------------------------------------------------
# _analyze_method
#
# Purpose:    Perform full multi-source analysis of
#             a single method and produce a complete
#             schema hashref, combining POD analysis,
#             code pattern detection, signature
#             analysis, validator schema extraction,
#             confidence scoring, relationship
#             detection, and modern Perl feature
#             extraction.
#
# Entry:      $method - a method hashref as produced
#                       by _find_methods, containing
#                       at minimum: name, body, pod.
#
# Exit:       Returns a schema hashref containing:
#             function, input, output, _confidence,
#             _analysis, _notes, and optionally:
#             new, accessor, relationships,
#             _yamltest_hints, _attributes,
#             _modern_features, _fields, _model,
#             _low_confidence.
#
# Side effects: Logs progress to stdout when verbose
#               is set. May carp or croak if
#               strict_pod is enabled and POD/code
#               disagreements are found.
#
# Notes:      This is the central analysis entry
#             point — it orchestrates all other
#             analysis helpers and merges their
#             results. The non-invasive reasoning
#             layer (Model::Method, Analyzer::*)
#             runs after the main schema is built
#             and attaches metadata only.
# --------------------------------------------------
sub _analyze_method {
	my ($self, $method) = @_;
	my $code = $method->{body};
	my $pod = $method->{pod};

	# Extract modern features
	my $attributes = $self->_extract_subroutine_attributes($code);
	my $postfix_derefs = $self->_analyze_postfix_dereferencing($code);
	my $fields = $self->_extract_field_declarations($code);

	# If this method came from a class, use those field declarations
	if ($method->{fields} && keys %{$method->{fields}}) {
		$fields = $method->{fields};
	}

	my $schema = {
		function => $method->{name},
		_confidence => {
			'input' => {},
			'output' => {}
		},
		input => {},
		output => {},
		setup => undef,
		transforms => {},
	};

	# Analyze different sources
	my $pod_params = $self->_analyze_pod($pod);
	my $code_params = $self->_analyze_code($code, $method);

	# Validate POD/code agreement if strict mode is enabled
	if ($self->{strict_pod}) {
		my @validation_errors = $self->_validate_pod_code_agreement(
			$pod_params,
			$code_params,
			$method->{name},
			{
				ignore_self => 1,
				allow_renames => 1,
			}
		);

		if (@validation_errors) {
			my $error_msg = "POD/Code disagreement in method '$method->{name}':\n  " .
				join("\n  ", @validation_errors);

			# Add to schema for reference even if we croak
			$schema->{_pod_validation_errors} = \@validation_errors;

			# Either croak immediately or log based on configuration
			if($self->{strict_pod} == 2) {	# 2 = fatal errors
				croak("[POD STRICT] $error_msg");
			} else {	# 1 = warnings
				carp("[POD STRICT] $error_msg");
				# Continue with analysis, but mark as problematic
				$schema->{_pod_disagreement} = 1;
			}
		}
		$schema->{_strict_pod_level} = $self->{strict_pod};
	}

	my $validator_params = $self->_extract_validator_schema($code);

	if ($validator_params) {
		$schema->{input} = $validator_params->{input};
		$schema->{input_style} = 'hash';
		$schema->{_confidence}{input} = { 'factors' => [ 'Determined from validator' ], 'level' => 'high' };
		$schema->{_analysis}{confidence_factors}{input} = [
			'Input schema extracted from validator'
		];
	} else {
		# Merge field declarations into code_params before merging analyses
		if (keys %$fields) {
			$self->_merge_field_declarations($code_params, $fields);
		}

		# Merge analyses
		$schema->{input} = $self->_merge_parameter_analyses(
			$pod_params,
			$code_params,
		);
	}

# ----------------------------------------
# Legacy Output Analysis (unchanged)
# ----------------------------------------

$schema->{output} = $self->_analyze_output(
    $method->{pod},
    $method->{body},
    $method->{name}
);


	# Detect accessor methods
	$self->_detect_accessor_methods($method, $schema);

	# Detect if this is an instance method that needs object instantiation
	# Constructors never require object instantiation
	my $needs_object = $self->_needs_object_instantiation($method->{name}, $method->{body}, $method);
	if($method->{name} ne 'new' && $needs_object) {
		$schema->{new} = $needs_object;
		$self->_log("  NEW: Method requires object instantiation: $needs_object");
	}

	# Calculate confidences
	my $input_confidence = $schema->{_confidence}{'input'};
	if(!ref($input_confidence)) {
		$input_confidence = $schema->{_confidence}{'input'} = $self->_calculate_input_confidence($schema->{input});
	}
	my $output_confidence = $schema->{_confidence}{'output'} = $self->_calculate_output_confidence($schema->{output});

	# Add metadata
	$schema->{_notes} = $self->_generate_notes($schema->{input});

	# Add analytics
	$schema->{_analysis} ||= {};
	$schema->{_analysis}{input_confidence} = $input_confidence->{level};
	$schema->{_analysis}{output_confidence} = $output_confidence->{level};
	$schema->{_analysis}{confidence_factors} ||= {};
	$schema->{_analysis}{confidence_factors}{input} ||= $input_confidence->{factors};
	$schema->{_analysis}{confidence_factors}{output} ||= $output_confidence->{factors};

	foreach my $mode('input', 'output') {
		$self->_set_defaults($schema, $mode);
	}

	# Optionally store detailed per-parameter analysis
	if ($input_confidence->{per_parameter}) {
		$schema->{_analysis}{per_parameter_scores} = $input_confidence->{per_parameter};
	}

	# Calculate overall confidence (for backward compatibility)
	my $input_level = $input_confidence->{level};
	my $output_level = $output_confidence->{level};

	my %level_rank = (
		none => 0,
		very_low => 1,
		low => 2,
		medium => 3,
		high => 4
	);

	# Overall is the lower of input and output
	$input_level //= 'none';
	$output_level //= 'none';
	my $overall = $level_rank{$input_level} < $level_rank{$output_level} ? $input_level : $output_level;

	$schema->{_analysis}{overall_confidence} = $overall;

	# Analyze parameter relationships
	my $relationships = $self->_analyze_relationships($method);
	if ($relationships && @{$relationships}) {
		$schema->{relationships} = $relationships;
		$self->_log("  Found " . scalar(@$relationships) . " parameter relationships");
	}

	# Store modern feature info in schema
	$schema->{_attributes} = $attributes if keys %$attributes;
	$schema->{_modern_features}{postfix_dereferencing} = $postfix_derefs if keys %$postfix_derefs;
	$schema->{_fields} = $fields if keys %$fields;

	# Store class info if this is a class method
	if ($method->{class}) {
		$schema->{_class} = $method->{class};
	}

	my $hints = $self->_extract_test_hints($method, $schema);
	$self->_extract_pod_examples($pod, $hints);

	for my $k (qw(boundary_values invalid_inputs valid_inputs equivalence_classes)) {
		my %seen;
		$hints->{$k} = [
			grep { !$seen{ defined $_ ? $_ : '__undef__' }++ }
			@{ $hints->{$k} }
		];
	}

	# --------------------------------------------------
	# YAML test hints: numeric boundaries
	# --------------------------------------------------
	if ($self->_method_has_numeric_intent($schema)) {
		$schema->{_yamltest_hints} ||= {};

		# Do not override existing hints
		$schema->{_yamltest_hints}{boundary_values} ||= [];

		my %seen = map { (defined $_ ? $_ : '__undef__') => 1 }
			@{ $schema->{_yamltest_hints}{boundary_values} };

		foreach my $v (@{ $self->_numeric_boundary_values }) {
			push @{ $schema->{_yamltest_hints}{boundary_values} }, $v
			unless $seen{$v}++;

			my $key = defined $v ? $v : '__undef__';
			push @{ $schema->{_yamltest_hints}{boundary_values} }, $v unless $seen{$key}++;
		}

		$self->_log('  HINTS: Added numeric boundary values');
	}

	if (keys %$hints) {
		$schema->{_yamltest_hints} ||= {};
		foreach my $k (keys %$hints) {
			$schema->{_yamltest_hints}{$k} = $hints->{$k}
			unless exists $schema->{_yamltest_hints}{$k};
		}
	}

	if(($level_rank{$overall} < $level_rank{$LEVEL_MEDIUM}) &&
	   ($level_rank{$overall} < ($self->{confidence_threshold} * 4))) {
		$schema->{_low_confidence} = 1
	}

	# ----------------------------------------
	# Non-invasive reasoning layer
	# ----------------------------------------

	my $method_model = App::Test::Generator::Model::Method->new(
		name => $method->{name},
		source => $method->{body},
	);

	my $return_analyzer = App::Test::Generator::Analyzer::Return->new();
	$return_analyzer->analyze($method_model);

	# Let model learn from finalized schema
	if ($schema->{output}) {
		$method_model->absorb_legacy_output($schema->{output});
	}

	$method_model->resolve_return_type();
	$method_model->resolve_classification();
	$method_model->resolve_confidence();

	# Attach only metadata
	$schema->{_model} = {
		classification => $method_model->classification,
		confidence => $method_model->confidence,
	};

	# ----------------------------------------
	# Return Meta Analysis (Non-invasive)
	# ----------------------------------------

	my $meta = App::Test::Generator::Analyzer::ReturnMeta->new();
	my $analysis = $meta->analyze($schema);

	$schema->{_analysis}{stability_score} = $analysis->{stability_score};
	$schema->{_analysis}{consistency_score} = $analysis->{consistency_score};
	$schema->{_analysis}{risk_flags} = $analysis->{risk_flags};

	# ----------------------------------------
	# Side Effect Analysis (Non-invasive)
	# ----------------------------------------

	my $se = App::Test::Generator::Analyzer::SideEffect->new();

	my $effects = $se->analyze($method);

	$schema->{_analysis}{side_effects} = $effects;

	# ----------------------------------------
	# Complexity Analysis (Non-invasive)
	# ----------------------------------------

	my $cx = App::Test::Generator::Analyzer::Complexity->new();
	my $complexity = $cx->analyze($method);

	$schema->{_analysis}{complexity} = $complexity;

	return $schema;
}

# --------------------------------------------------
# _method_has_numeric_intent
#
# Purpose:    Determine whether a method schema
#             has numeric intent — either a numeric
#             output type or at least one required
#             numeric input parameter — to decide
#             whether to add standard numeric
#             boundary hint values.
#
# Entry:      $schema - schema hashref as built by
#                       _analyze_method.
#
# Exit:       Returns 1 if numeric intent is
#             detected, 0 otherwise.
#
# Side effects: None.
# --------------------------------------------------
sub _method_has_numeric_intent {
	my ($self, $schema) = @_;

	# Numeric output
	return 1 if ($schema->{output} && $schema->{output}{type} && $schema->{output}{type} =~ /^(number|integer)$/);

	# Numeric inputs
	foreach my $p (values %{ $schema->{input} || {} }) {
		next if $p->{optional};
		return 1 if ($p->{type} && $p->{type} =~ /^(number|integer)$/);
	}

	return 0;
}

# --------------------------------------------------
# _numeric_boundary_values
#
# Purpose:    Return the standard set of numeric
#             boundary values used as test hints
#             for methods with numeric intent.
#
# Entry:      None.
#
# Exit:       Returns an arrayref of boundary
#             values: [-1, 0, 1, 2, 100].
#
# Side effects: None.
# --------------------------------------------------
sub _numeric_boundary_values {
	return [ -1, 0, 1, 2, 100 ];
}

# --------------------------------------------------
# _detect_accessor_methods
#
# Purpose:    Detect whether a method is a getter,
#             setter, or combined getter/setter
#             accessor by analysing assignment and
#             return patterns involving $self->{...}.
#
# Entry:      $method - method hashref containing
#                       at minimum 'body' and
#                       optionally 'pod'.
#             $schema - schema hashref (modified
#                       in place).
#
# Exit:       Returns nothing. Modifies $schema in
#             place, setting accessor, input,
#             input_style, output, and _confidence
#             keys as appropriate.
#
# Side effects: Croaks if a getter/setter has more
#               than one argument, or if a setter
#               returns non-self data.
#               Logs detections to stdout when
#               verbose is set.
#
# Notes:      Four accessor patterns are detected
#             in order: (1) combined getter/setter
#             with shift, (2) combined getter/setter
#             with validated input, (3) getter only,
#             (4) setter that returns $self. Methods
#             accessing multiple $self fields are
#             skipped immediately.
# --------------------------------------------------
sub _detect_accessor_methods {
	my ($self, $method, $schema) = @_;

	my $body = $method->{body};

	# Normalize whitespace for regex sanity
	my $code = $body;
	$code =~ s/\s+/ /g;

	# If a method touches more than one $self->{...}, it’s not an accessor.
	my %fields_seen;
	while ($code =~ /\$self\s*->\s*\{\s*['"]?([^}'"]+)['"]?\s*\}/g) {
		$fields_seen{$1}++;
	}
	if (keys(%fields_seen) > 1) {
		$self->_log("  Skipping accessor detection: multiple fields accessed");
		return;
	}

	# -------------------------------
	# Getter/Setter combo
	# -------------------------------
	if (
		# Require get/set of the same property
		$code =~ /\$self\s*->\s*\{\s*['"]?([^}'"]+)['"]?\s*\}\s*=\s*shift\s*;/ &&
		$code =~ /return\s+\$self\s*->\s*\{\s*['"]?\Q$1\E['"]?\s*\}\s*;/ &&
		$code =~ /if\s*\(\s*\@_/
	) {
		my $property = $1;

		if(!defined($property)) {
			if($code =~ /\$self\s*->\s*\{\s*['"]?([^}'"]+)['"]?\s*\}\s*=\s*shift\s*;/) {
				$property = $1;
			}
		}

		$schema->{accessor} = {
			type => 'getset',
			property => $property,
		};

		$self->_log("  Detected getter/setter accessor for property: $property");

		$schema->{input} ||= { value => { type => 'string', optional => 1 } };

		$schema->{input_style} = 'hash';

		$schema->{_confidence}{input} = {
			level => 'high',
			factors => ['Detected combined getter/setter accessor'],
		};
		if (my $pod = $method->{pod}) {
			if ($pod =~ /\b(LWP::UserAgent(::\w+)*)\b/) {
				my $class = $1;
				$schema->{output} = {
					type => 'object',
					isa => $class,
				};
				$schema->{input}{$property} = {
					type => 'object',
					isa => $class,
					optional => 1,
				};

				$schema->{_confidence}{output} = {
					level => 'high',
					factors => ['POD specifies UserAgent object'],
				};
			}
		}
	} elsif($code =~ /if\s*\(\s*(?:\@_|[\$]\w+)/ &&
	    $code =~ /\$self\s*->\s*\{\s*['"]?([^}'"]+)['"]?\s*\}\s*=\s*(?:shift|\@_|\$_\[\d+\]|\$\w+)\b/x &&
	    $code =~ /return\b/
	) {
		# -------------------------------
		# Getter/Setter (validated input)
		# -------------------------------
		my $property = $1;

		if(!defined($property)) {
			if($code =~ /\$self\s*->\s*\{\s*['"]?([^}'"]+)['"]?\s*\}\s*=/) {
				$property = $1;
			}
		}
		if ($code =~ /validate_strict/) {
			push @{ $schema->{_confidence}{input}{factors} }, 'Setter uses Params::Validate::Strict';
		} else {
			# ---------------------------------------
			# Detect object input via blessed($arg)
			# ---------------------------------------
			if ($code =~ /blessed\s*\(\s*\$(\w+)\s*\)/) {
				my $param = $1;

				$self->_log("  Detected object input via blessed(\$$param)");

				$schema->{input} = {
					$param => {
						type => 'object',
						optional => 1,
					}
				};

				$schema->{_confidence}{input} = {
					level   => 'high',
					factors => ['Input validated by Scalar::Util::blessed'],
				};
			} else {
				# fallback ONLY if nothing known
				$schema->{input} ||= {
					value => { type => 'string', optional => 1 },
				};
			}
		};
		$schema->{accessor} = {
			type => 'getset',
			property => $property,
		};

		$self->_log("  Detected getter/setter accessor for property: $property");
		if (my $pod = $method->{pod}) {
			if ($pod =~ /\b(LWP::UserAgent(::\w+)*)\b/) {
				my $class = $1;
				$schema->{output} = {
					type => 'object',
					isa => $class,
				};
				$schema->{input}{$property} = {
					type => 'object',
					isa => $class,
					optional => 1,
				};

				$schema->{_confidence}{output} = {
					level => 'high',
					factors => ['POD specifies UserAgent object'],
				};
			}
		}
		if(ref($schema->{input}) eq 'HASH') {
			if(scalar keys(%{$schema->{input}}) > 1) {
				croak(__PACKAGE__, ': A getset accessor function can have at most one argument');
			}
		}
		$schema->{input}->{$property}->{position} = 0;
	} elsif ($code =~ /return\s+\$self\s*->\s*\{\s*['"]?([^}'"]+)['"]?\s*\}\s*;/) {
		# -------------------------------
		# Getter
		# -------------------------------
		my $property = $1;

		# Don't flag mutators like
		# sub foo {
		    # my $self = shift;
		    # $self->{bar} = shift;
		    # return $self->{bar};
		# }
		# Only exclude if the property is being set FROM EXTERNAL INPUT
		if($code !~ /\$self\s*->\s*\{\s*['"]?\Q$property\E['"]?\s*\}\s*=\s*(?:shift|\$\w+\s*=\s*shift|\@_|\$_\[\d+\])/) {
			my @returns = $code =~ /return\b/g;
			my @self_returns = $code =~ /return\s+\$self\s*->\s*\{\s*['"]?\Q$property\E['"]?\s*\}/g;
			# it's a getter
			if (scalar(@returns) == scalar(@self_returns)) {
				# all returns are returning $self->{$property}, so it's a getter
				$schema->{accessor} = {
					type => 'getter',
					property => $property,
				};

				$self->_log("  Detected getter accessor for property: $property");

				$schema->{_confidence}{output} = {
					level => 'high',
					factors => ['Detected getter method'],
				};
				delete $schema->{input};
			}
		}
	} elsif (
		$code =~ /return\s+\$self\b/ &&
		$code =~ /\$self\s*->\s*\{\s*['"]?([^}'"]+)['"]?\s*\}\s*=\s*\$(\w+)\s*;/
	) {
		# -------------------------------
		# Setter
		# -------------------------------
		my ($property, $param) = ($1, $2);

		$schema->{accessor} = {
			type => 'setter',
			property => $property,
			param => $param,
		};

		$self->_log("  Detected setter accessor for property: $property");

		$schema->{input} = {
			$param => { type => 'string' }, # safe default
		};
		$schema->{input_style} = 'hash';

		$schema->{_confidence}{input} = {
			level => 'high',
			factors => ['Detected setter/accessor method'],
		};
		if($schema->{output}{_returns_self}) {
			if($schema->{output}{type} ne 'object') {
				croak 'Setter can not return data other than $self';
			}
			if($schema->{output}{isa} ne $self->{_package_name}) {
				croak 'Setter can not return data other than $self';
			}
		} elsif(scalar(keys %{$schema->{output}}) != 0) {
			$self->_analysis_error(
				method  => $method->{name},
				message => "Setter cannot return data",
			);
		}
	}

	if(exists($schema->{accessor})) {
		if($schema->{accessor}{type} && $schema->{accessor}{type} =~ /setter|getset/ && $schema->{input}) {
			for my $param (keys %{ $schema->{input} }) {
				my $in = $schema->{input}{$param};

				if ($in->{type} && ($in->{type} eq 'object')) {
					$schema->{output} = {
						type => 'object',
						($in->{isa} ? (isa => $in->{isa}) : ()),
					};

					$schema->{_confidence}{output} = {
						level => 'high',
						factors => ['Output type propagated from setter input'],
					};
				}
			}
		}

		if($schema->{accessor}{type} && $schema->{accessor}{property} && ($schema->{accessor}{type} =~ /getter|getset/) &&
		   ((!defined($schema->{output}{type})) || ($schema->{output}{type} eq 'string'))) {
			if (my $pod = $method->{pod}) {
				# POD says "UserAgent object"
				if ($pod =~ /\bUser[- ]?Agent\b.*\bobject\b/i) {
					$schema->{output}{type} = 'object';
					$schema->{output}{isa} = 'LWP::UserAgent';

					push @{ $schema->{_confidence}{output}{factors} }, 'POD indicates UserAgent object';

					$schema->{_confidence}{output}{level} = 'high';
				}
			}
		}
	}
}

# --------------------------------------------------
# _analysis_error
#
# Purpose:    Report a fatal analysis error with
#             module, method, and file context,
#             then croak.
#
# Entry:      Named args:
#               method  - method name string.
#               message - error description string.
#
# Exit:       Does not return — always croaks.
#
# Side effects: None beyond the croak.
# --------------------------------------------------
sub _analysis_error {
	my ($self, %args) = @_;

	my $method = $args{method} // 'UNKNOWN';
	my $msg = $args{message} // 'Analysis error';

	my $module = $self->{_package_name} // 'UNKNOWN';
	my $file   = $self->{input_file} // 'UNKNOWN';

	croak join "\n",
		$msg,
		"  Module: $module",
		"  Method: $method",
		"  File:   $file",
	'';
}

# --------------------------------------------------
# _extract_validator_schema
#
# Purpose:    Try each supported validator extractor
#             in priority order and return the first
#             schema that yields a non-empty input
#             spec. Used to detect explicit
#             parameter validation declarations
#             before falling back to heuristic
#             code analysis.
#
# Entry:      $code - method body source string.
#
# Exit:       Returns a schema hashref on success,
#             or undef if no supported validator
#             call is detected.
#
# Side effects: None.
#
# Notes:      Extractors tried in order:
#             Params::Validate::Strict,
#             Params::Validate,
#             MooseX::Params::Validate,
#             Type::Params.
# --------------------------------------------------
sub _extract_validator_schema {
	my ($self, $code) = @_;

	for my $extractor ('_extract_pvs_schema', '_extract_pv_schema', '_extract_moosex_params_schema', '_extract_type_params_schema') {
		my $res = $self->$extractor($code);
		return $res if ($res && ref($res) eq 'HASH' && keys %{ $res->{input} || {} });
	}

	return;
}

# --------------------------------------------------
# _parse_schema_hash
#
# Purpose:    Parse a PPI block node representing
#             a validator schema hash literal and
#             return a normalised schema structure
#             suitable for use as input spec.
#
# Entry:      $hash - a PPI node with a children()
#                     method, typically a
#                     PPI::Structure::Block from
#                     a validate_strict call.
#
# Exit:       Returns a hashref with keys:
#               input       - hashref of param specs
#               input_style - 'hash'
#               _confidence - confidence hashref
#             or undef if parsing fails.
#
# Side effects: None.
# --------------------------------------------------
sub _parse_schema_hash {
	my ($self, $hash) = @_;

	my %result;

	for my $child ($hash->children) {
		# skip whitespace and operators
		if ($child->isa('PPI::Statement') || $child->isa('PPI::Statement::Expression')) {
			my ($key, $val);

			my @tokens = grep {
				!$_->isa('PPI::Token::Whitespace') &&
				!$_->isa('PPI::Token::Operator')
			} $child->children;

			for (my $i = 0; $i < @tokens - 1; $i++) {
				if(($tokens[$i]->isa('PPI::Token::Word') || $tokens[$i]->isa('PPI::Token::Quote')) &&
				   $tokens[$i+1]->isa('PPI::Structure::Constructor')) {
					$key = $tokens[$i]->content;
					$key =~ s/^['"]|['"]$//g;
					$val = $tokens[$i+1];
					last;
				}
			}

			next unless $key && $val;

			my %param;
			for my $inner ($val->children) {
				next unless $inner->isa('PPI::Statement') || $inner->isa('PPI::Statement::Expression');

				my ($k, undef, $v) = grep {
					!$_->isa('PPI::Token::Whitespace') &&
					!$_->isa('PPI::Token::Operator')
				} $inner->children;

				next unless $k && $v;

				my $keyname = $k->content;
				my $value = $v->can('content') ? $v->content : undef;
				$value =~ s/^['"]|['"]$//g if defined $value;

				if ($keyname eq 'type') {
					$param{type} = lc($value);
				} elsif ($keyname eq 'optional') {
					$param{optional} = $value ? 1 : 0;
				} elsif ($keyname =~ /^(min|max)$/ && looks_like_number($value)) {
					$param{$keyname} = 0 + $value;
				} elsif ($keyname eq 'matches') {
					$param{matches} = qr/$value/;
				}
			}

			$param{type} //= 'string';
			$param{optional} //= 0;

			$result{$key} = \%param;
		}
	}

	return {
		input => \%result,
		input_style => 'hash',
		_confidence => {
			input => {
				level => 'high',
				factors => ['Input schema extracted from validator'],
			},
		},
	};
}

# --------------------------------------------------
# _ppi
#
# Purpose:    Return a PPI::Document for a code
#             string, using a per-instance cache
#             to avoid re-parsing the same string
#             multiple times during a single
#             analysis pass.
#
# Entry:      $code - either a string of Perl source
#                     code, or an object that
#                     already has a find() method
#                     (returned as-is).
#
# Exit:       Returns a PPI::Document, or the
#             original object if it already
#             supports find().
#
# Side effects: Populates $self->{_ppi_cache}.
# --------------------------------------------------
sub _ppi {
	my ($self, $code) = @_;

	return $code if ref($code) && $code->can('find');

	$self->{_ppi_cache} ||= {};
	return $self->{_ppi_cache}{$code} //= PPI::Document->new(\$code);
}

# --------------------------------------------------
# _extract_pvs_schema
#
# Purpose:    Detect and extract a parameter schema
#             from a Params::Validate::Strict
#             validate_strict() call in the method
#             body.
#
# Entry:      $code - method body source string.
#
# Exit:       Returns a schema hashref with input,
#             style, and source keys on success,
#             or undef if no validate_strict call
#             is found or parsing fails.
#
# Side effects: None.
# --------------------------------------------------
sub _extract_pvs_schema {
	my ($self, $code) = @_;

	return unless $code =~ /\bvalidate_strict\s*\(/;

	my $doc = $self->_ppi($code) or return;

	my $calls = $doc->find(sub {
		$_[1]->isa('PPI::Token::Word') && ($_[1]->content eq 'validate_strict' || $_[1]->content eq 'Params::Validate::Strict::validate_strict')
	}) or return;

	for my $call (@$calls) {
		my $list = $call->parent();
		while ($list && !$list->isa('PPI::Structure::List')) {
			$list = $list->parent();
		}
		if(!defined($list)) {
			my $next = $call->next_sibling();
			next unless defined $next;
			if($next->content() =~ /schema\s*=>\s*(\{(?:[^{}]|\{(?:[^{}]|\{[^{}]*\})*\})*\})/s) {
				my $schema_text = $1;
				my $compartment = Safe->new();
				$compartment->permit_only(qw(:base_core :base_mem :base_orig));

				my $schema_str = "my \$schema = $schema_text";
				my $schema = $compartment->reval($schema_str);
				if(scalar keys %{$schema}) {
					return {
						input => $schema,
						style => 'hash',
						source => 'validator'
					}
				}
			}
		}
		next unless $list;

		my ($schema_block) = grep { $_->isa('PPI::Structure::Block') } $list->children;

		next unless $schema_block;

		my $schema = $self->_extract_schema_hash_from_block($schema_block);
		return $self->_normalize_validator_schema($schema) if $schema;
	}

	return;
}

# --------------------------------------------------
# _extract_pv_schema
#
# Purpose:    Detect and extract a parameter schema
#             from a Params::Validate validate()
#             call in the method body.
#
# Entry:      $code - method body source string.
#
# Exit:       Returns a schema hashref with input,
#             style, and source keys on success,
#             or undef if no validate() call is
#             found or parsing fails.
#
# Side effects: None.
# --------------------------------------------------
sub _extract_pv_schema {
	my ($self, $code) = @_;

	return unless $code =~ /\bvalidate\s*\(/;

	my $doc = $self->_ppi($code) or return;

	my $calls = $doc->find(sub {
		$_[1]->isa('PPI::Token::Word') && ($_[1]->content eq 'validate' || $_[1]->content eq 'Params::Validate::validate')
	}) or return;

	for my $call (@$calls) {
		my $list = $call->parent;
		while ($list && !$list->isa('PPI::Structure::List')) {
			$list = $list->parent;
		}
		if(!defined($list)) {
			my $next = $call->next_sibling();
			my ($arglist, $schema_text) = $self->_parse_pv_call($next);

			if($schema_text) {
				my $compartment = Safe->new();
				$compartment->permit_only(qw(:base_core :base_mem :base_orig));

				my $schema_str = "my \$schema = $schema_text";
				my $schema = $compartment->reval($schema_str);

				if(scalar keys %{$schema}) {
					foreach my $arg(keys %{$schema}) {
						my $field = $schema->{$arg};
						if(my $type = $field->{'type'}) {
							if($type eq 'ARRAYREF') {
								$field->{'type'} = 'arrayref';
							} elsif($type eq 'SCALAR') {
								$field->{'type'} = 'string';
							}
						}
						delete $field->{'callbacks'};
					}

					return {
						input => $schema,
						style => 'hash',
						source => 'validator'
					}
				}
			}
		}
		next unless $list;

		my ($schema_block) = grep { $_->isa('PPI::Structure::Block') } $list->children;

		next unless $schema_block;

		my $schema = $self->_extract_schema_hash_from_block($schema_block);
		return $self->_normalize_validator_schema($schema) if $schema;
	}

	return;
}

# --------------------------------------------------
# _parse_pv_call
#
# Purpose:    Split a Params::Validate call argument
#             string into its two components: the
#             first argument (typically \@_) and
#             the schema hash string.
#
# Entry:      $string - the raw argument string
#                       from the validate() call,
#                       including outer parentheses.
#
# Exit:       Returns a two-element list:
#               ($first_arg, $hash_str)
#             or an empty list if no comma is found
#             at brace depth zero (malformed call).
#
# Side effects: None.
# --------------------------------------------------
sub _parse_pv_call {
	my ($self, $string) = @_;

	# Remove outer parentheses and whitespace
	$string =~ s/^\s*\(\s*//;
	$string =~ s/\s*\)\s*$//;

	# Find the first comma at brace-depth 0
	my $depth = 0;
	my $comma_pos;

	for my $i (0 .. length($string) - 1) {
		my $char = substr($string, $i, 1);

		if ($char eq '{') {
			$depth++;
		} elsif ($char eq '}') {
			$depth--;
			return if $depth < 0;	# Broken source code
		} elsif ($char eq ',' && $depth == 0) {
			$comma_pos = $i;
			last;
		}
	}

	return unless defined $comma_pos;

	my $first_arg = substr($string, 0, $comma_pos);
	my $hash_str = substr($string, $comma_pos + 1);

	# Trim whitespace
	$first_arg =~ s/^\s+|\s+$//g;
	$hash_str =~ s/^\s+|\s+$//g;

	return ($first_arg, $hash_str);
}

# --------------------------------------------------
# _extract_moosex_params_schema
#
# Purpose:    Detect and extract a parameter schema
#             from a MooseX::Params::Validate
#             validated_hash() call in the method
#             body.
#
# Entry:      $code - method body source string.
#
# Exit:       Returns a schema hashref with input,
#             style, and source keys on success,
#             or undef if no validated_hash() call
#             is found or parsing fails.
#
# Side effects: None.
# --------------------------------------------------
sub _extract_moosex_params_schema
{
	my ($self, $code) = @_;

	return unless $code =~ /\bvalidated_hash\s*\(/;

	my $doc = $self->_ppi($code) or return;

	my $calls = $doc->find(sub {
		$_[1]->isa('PPI::Token::Word') && ($_[1]->content eq 'validated_hash')
	}) or return;

	for my $call (@$calls) {
		my $list = $call->parent();
		while ($list && !$list->isa('PPI::Structure::List')) {
			$list = $list->parent;
		}
		if(!defined($list)) {
			my $next = $call->next_sibling();
			my ($arglist, $schema_text) = $self->_parse_pv_call($next);

			if($schema_text) {
				my $compartment = Safe->new();
				$compartment->permit_only(qw(:base_core :base_mem :base_orig));

				my $schema_str = "my \$schema = { $schema_text }";
				$schema_str =~ s/ArrayRef\[(.+?)\]/arrayref, element_type => $1/g;
				my $schema = $compartment->reval($schema_str);

				if(scalar keys %{$schema}) {
					foreach my $arg(keys %{$schema}) {
						my $field = $schema->{$arg};
						if(my $isa = delete $field->{'isa'}) {
							$field->{'type'} = $isa;
						}
						if(exists($field->{'required'})) {
							my $required = delete $field->{'required'};
							$field->{'optional'} = $required ? 0 : 1;
						} else {
							$field->{'optional'} = 1;
						}
						if(ref($field->{'default'}) eq 'CODE') {
							delete $field->{'default'};	# TODO
						}
					}

					foreach my $arg(keys %{$schema}) {
						my $field = $schema->{$arg};
						if(my $type = $field->{'type'}) {
							if($type eq 'ARRAYREF') {
								$field->{'type'} = 'arrayref';
							} elsif($type eq 'SCALAR') {
								$field->{'type'} = 'string';
							}
						}
						delete $field->{'callbacks'};
					}

					return {
						input => $schema,
						style => 'hash',
						source => 'validator'
					}
				}
			}
		}
		next unless $list;

		my ($schema_block) = grep { $_->isa('PPI::Structure::Block') } $list->children;

		next unless $schema_block;

		my $schema = $self->_extract_schema_hash_from_block($schema_block);
		return $self->_normalize_validator_schema($schema) if $schema;
	}

	return;
}

# --------------------------------------------------
# _extract_schema_hash_from_block
#
# Purpose:    Extract a parameter schema hashref from
#             a PPI::Structure::Block node representing
#             the schema argument to a validator call
#             such as validate_strict({ ... }).
#
# Entry:      $block - a PPI::Structure::Block node.
#
# Exit:       Returns a hashref of parameter name to
#             spec hashref, or undef if parsing fails.
#
# Side effects: None.
#
# Notes:      Delegates to _parse_schema_hash which
#             expects a PPI node with a children()
#             method. This method exists to provide
#             a clear semantic name at the call site.
# --------------------------------------------------
sub _extract_schema_hash_from_block {
	my ($self, $block) = @_;

	return unless $block && $block->can('children');

	my $result = $self->_parse_schema_hash($block);

	return unless $result && ref($result) eq 'HASH' && $result->{input};

	return $result->{input};
}

# --------------------------------------------------
# _normalize_validator_schema
#
# Purpose:    Normalise a raw validator schema
#             hashref (as extracted from PPI) into
#             the standard input spec format used
#             throughout the extractor.
#
# Entry:      $schema - hashref of parameter name
#                       to raw spec hashref, as
#                       produced by
#                       _extract_schema_hash_from_block.
#
# Exit:       Returns a hashref with keys:
#               input_style - 'hash'
#               input       - normalised param specs
#             Each param spec gains an explicit
#             optional key and _source / _type_confidence
#             metadata.
#
# Side effects: None.
# --------------------------------------------------
sub _normalize_validator_schema {
	my ($self, $schema) = @_;

	my %input;

	for my $name (keys %$schema) {
		my $spec = $schema->{$name};

		$input{$name} = {
			%$spec,
			optional => exists $spec->{optional} ? $spec->{optional} : 0,
			_source => 'validator',
			_type_confidence => 'high',
		};
	}

	return {
		input_style => 'hash',
		input => \%input,
	};
}

# --------------------------------------------------
# _extract_type_params_schema
#
# Purpose:    Detect and extract a parameter schema
#             from a Type::Params signature_for()
#             declaration for the current method,
#             located in the module-level document.
#
# Entry:      $code - method body source string
#                     (used to extract the function
#                     name for lookup).
#
# Exit:       Returns a schema hashref on success,
#             or undef if no signature_for
#             declaration is found or compilation
#             fails.
#
# Side effects: May fork a child process to compile
#               the signature in isolation.
# --------------------------------------------------
sub _extract_type_params_schema {
	my ($self, $code) = @_;

	my $function = $self->_extract_function_name($code) or return;

	my $doc = $self->{_document} or return;
	my $stmt = $self->_find_signature_statement($doc, $function) or return;

	my $signature_expr = $self->_extract_signature_expression($stmt, $function) or return;

	my $meta = $self->_compile_signature_isolated($function, $signature_expr) or return;

	return $self->_build_schema_from_meta($meta);
}

# --------------------------------------------------
# _extract_function_name
#
# Purpose:    Extract the subroutine name from the
#             start of a method body string, used
#             to look up its Type::Params signature.
#
# Entry:      $code - method body source string.
#
# Exit:       Returns the subroutine name string,
#             or undef if no 'sub name' declaration
#             is found.
#
# Side effects: None.
# --------------------------------------------------
sub _extract_function_name {
	my ($self, $code) = @_;
	return $1 if $code =~ /^\s*sub\s+([a-zA-Z0-9_]+)/;
	return;
}

# --------------------------------------------------
# _find_signature_statement
#
# Purpose:    Search a PPI document for a
#             signature_for statement that
#             corresponds to a named function.
#
# Entry:      $doc      - PPI::Document to search.
#             $function - function name string.
#
# Exit:       Returns the matching PPI::Statement
#             node, or undef if none is found.
#
# Side effects: None.
# --------------------------------------------------
sub _find_signature_statement {
	my ($self, $doc, $function) = @_;

	my $statements = $doc->find(
		sub {
			$_[1]->isa('PPI::Statement') && $_[1]->content =~ /^\s*signature_for\b/
		}
	) or return;

	foreach my $stmt (@$statements) {
		my $content = $stmt->content;
		if ($content =~ /^\s*signature_for\s+\Q$function\E\b/) {
			return $stmt;
		}
	}

	return;
}

# --------------------------------------------------
# _extract_signature_expression
#
# Purpose:    Extract the Type::Params signature
#             expression (everything after =>) from
#             a signature_for statement node.
#
# Entry:      $stmt     - PPI::Statement node.
#             $function - function name string,
#                         used in the match pattern.
#
# Exit:       Returns the signature expression
#             string, or undef if the pattern
#             does not match.
#
# Side effects: None.
# --------------------------------------------------
sub _extract_signature_expression {
	my ($self, $stmt, $function) = @_;

	my $content = $stmt->content;

	if ($content =~ /^\s*signature_for\s+\Q$function\E\s*=>\s*(.+?);?\s*$/s) {
		return $1;
	}

	return;
}

# --------------------------------------------------
# _compile_signature_isolated
#
# Purpose:    Compile and evaluate a Type::Params
#             signature expression in an isolated
#             environment to extract parameter
#             metadata without polluting the
#             current process.
#
# Entry:      $function        - function name string.
#             $signature_expr  - Type::Params
#                                signature expression
#                                string.
#
# Exit:       Returns a decoded JSON hashref
#             containing parameters and returns
#             metadata on success.
#             Croaks on unsafe expressions, timeout,
#             or compile errors.
#
# Side effects: May fork a child process with a
#               memory limit applied via
#               BSD::Resource if available.
#               Memory limiting is best-effort and
#               silently skipped on platforms where
#               BSD::Resource is unavailable.
# --------------------------------------------------
sub _compile_signature_isolated {
	my ($self, $function, $signature_expr) = @_;

	# Remove comments
	$signature_expr =~ s/#.*$//mg;

	# Reject obviously dangerous constructs
	if ($signature_expr =~ /\b(?:system|exec|open|fork|require|do|eval|qx)\b/) {
		die 'Unsafe signature expression';
	}

	if ($signature_expr =~ /[`{};]/) {
		die "Unsafe signature expression";
	}

	my $payload = <<'PERL';
use strict;
use warnings;
use Type::Params -sigs;
use Types::Common -types;
use JSON::MaybeXS;

# Stub sub so Perl can parse it
sub FUNCTION_NAME {}

# Create the Type::Params signature object
my $sig = signature_for FUNCTION_NAME => SIGNATURE_EXPR;

# Extract parameters
my @sig_params = @{ $sig->parameters || [] };
my $pos = 0;
my @params;

# if ($sig->method) {
    # The $self value
    # push @params, {
        # name     => 'arg0',
        # optional => 0,
        # position => $pos++,
    # };
# }

for my $p (@sig_params) {
	push @params, {
		name => "arg$pos",
		optional => $p->optional ? 1 : 0,
		position => $pos,
		type => $p->type->name
	};
	$pos++;
}

# Extract return type
my $returns;
if (my $r = $sig->returns_scalar) {
	$returns = {
		context => 'scalar',
		type => $r ? $r->name : 'unknown',
	};
} elsif ($r = $sig->returns_list) {
	$returns = {
		context => 'list',
		type => $r ? $r->name : 'unknown',
	};
}

print encode_json({
	parameters => \@params,
	returns => $returns,
});
PERL

	# Substitute function name and signature expression
	$payload =~ s/FUNCTION_NAME/$function/g;
	$payload =~ s/SIGNATURE_EXPR/$signature_expr/;

	my $compartment = Safe->new();
	$compartment->permit_only(qw(:base_core :base_mem :base_orig :load));
	if(my $sig = $compartment->reval($payload)) {
		return $sig;
	}

	# Run in an isolated Perl process
	my ($wtr, $rdr, $err) = (undef, undef, gensym);
	local %ENV;

	# Apply memory limit if BSD::Resource is available.
	# This module is Unix-only and not available on Windows,
	# so we guard the call and skip silently if not present.
	eval {
		require BSD::Resource;
		BSD::Resource::setrlimit(
			BSD::Resource::RLIMIT_AS(),
			$MEMORY_LIMIT_BYTES,
			$MEMORY_LIMIT_BYTES
		);
	};
	# Ignore failure — resource limiting is best-effort only

	my $pid = open3($wtr, $rdr, $err, $^X, '-T');

	print $wtr $payload;
	close $wtr;

	local $SIG{ALRM} = sub { croak 'Signature compile timeout' };
	eval { alarm($SIGNATURE_TIMEOUT_SECS) };	# no-op on Windows

	my $stdout = do { local $/; <$rdr> };
	my $stderr = do { local $/; <$err> };

	eval { alarm 0 };

	waitpid($pid, 0);

	if ($stderr && length $stderr) {
		croak "Error compiling signature:\n$stderr";
	}

	return decode_json($stdout);
}

# --------------------------------------------------
# _build_schema_from_meta
#
# Purpose:    Convert the parameter and return type
#             metadata produced by
#             _compile_signature_isolated into a
#             standard schema hashref.
#
# Entry:      $meta - hashref with 'parameters'
#                     arrayref and optional
#                     'returns' hashref, as decoded
#                     from the isolated compile
#                     JSON output.
#
# Exit:       Returns a schema hashref with input,
#             output, style, source, _notes, and
#             _confidence keys.
#
# Side effects: None.
#
# Notes:      Unknown Type::Params type names are
#             mapped to 'string' with a note added
#             and confidence downgraded to 'medium'.
# --------------------------------------------------
sub _build_schema_from_meta {
	my ($self, $meta) = @_;

	my %type_map = (
		Num => 'number',
		Int => 'integer',
		Str => 'string',
		Bool => 'boolean',
		Object  => 'object',
		ArrayRef => 'array',
		HashRef  => 'object',
	);

	my $input;
	my $position = 0;
	my $confidence = 'high';
	my @notes = ('Type::Params detected');

	foreach my $p (@{ $meta->{parameters} || [] }) {
		my $type = $type_map{ $p->{type} } // 'string';

		if (!exists $type_map{$p->{type}}) {
			push @notes, "Unknown type $p->{type}, defaulting to string";
			$confidence = 'medium';
		}

		$input->{"arg$position"} = {
			type => $type,
			position => $position,
			optional => $p->{optional} ? 1 : 0,
		};

		$position++;
	}

	my $output;

	if (my $ret = $meta->{returns}) {
		my $type = $type_map{ $ret->{type} } // 'string';

		if (!exists $type_map{$ret->{type}}) {
			push @notes, "Unknown return type $ret->{type}, defaulting to string";
			$confidence = 'medium';
		}

		$output = {
			type => $type,
			"_$ret->{context}_context" => { type => $type },
		};
	}

	return {
		input  => $input,
		output => $output,
		style  => 'hash',
		source => 'validator',
		_notes => \@notes,
		_confidence => {
			input => $confidence,
		},
	};
}

# --------------------------------------------------
# _analyze_pod
#
# Purpose:    Parse POD documentation for a method
#             and extract parameter names, types,
#             constraints, and optionality from
#             multiple POD patterns.
#
# Entry:      $pod - string of POD content as
#                    returned by _extract_pod_before.
#                    May be undef or empty.
#
# Exit:       Returns a hashref of parameter name
#             to parameter spec hashref. Returns an
#             empty hashref if no POD is provided
#             or no parameters are found.
#
# Side effects: Carps when a semantic type is
#               detected, advising the caller to
#               set config->properties.
#               Logs progress to stdout when
#               verbose is set.
#
# Notes:      Three pattern strategies are tried
#             in order: (1) named Parameters section,
#             (2) inline $name - type format,
#             (3) =over/=item list. Parameters found
#             earlier take precedence over later
#             discoveries. Default values from POD
#             are merged in last.
# --------------------------------------------------
sub _analyze_pod {
	my ($self, $pod) = @_;

	return {} unless $pod;

	my %params;
	my $position_counter = 0;

	# Check for positional arguments in method signature
	# Pattern: =head2 method_name($arg1, $arg2, $arg3)
	if ($pod =~ /=head2\s+\w+\s*\(([^)]+)\)/s) {
		my $sig = $1;
		# Extract parameter names in order
		my @sig_params = $sig =~ /\$(\w+)/g;

		# Skip $self or $class
		shift @sig_params if @sig_params && $sig_params[0] =~ /^(self|class)$/i;

		# Assign positions
		foreach my $param (@sig_params) {
			$params{$param}{position} //= $position_counter;
			$self->_log("  POD: $param has position $params{$param}{position}");
			$position_counter++;
		}
	}

	$self->_log("  POD: Found $position_counter unnamed parameters to add to the position list");

	# Pattern 1: Parse line-by-line in Parameters section
	# First, extract the Parameters section
	my $param_section;
	if($pod =~ /(?:Parameters?|Arguments?|Inputs?):?\s*\n((?:\s*\$.*\n)+)/si) {
		$param_section = $1;
	} elsif ($pod =~ /^=head\d+\s+(?:Parameters?|Arguments?|Inputs?)\b.*?\n(.*?)(?=^=head|\Z)/msi) {
		$param_section = $1;
	}
	if($param_section) {
		my $param_order = 0;

		$self->_log("  POD: Scan for named parameters in '$param_section'");
		# Now parse each line that starts with $varname
		foreach my $line (split /\n/, $param_section) {
			if ($line =~ /C<\$(\w+)>\s*\((Required|Mandatory)\)/i) {
				$params{$1}{optional} = 0;
				$self->_log("  POD: $1 marked required from item header");
			}

			# Match: $name - type (constraints), description
			# or:	$name - type, description
			# or:	$name - type
			if(($line =~ /^\s*\$(\w+)\s*-\s*(\w+)(?:\s*\(([^)]+)\))?\s*,?\s*(.*)$/i) ||
			   ($line =~ /^\s*C<\$(\w+)>\s*-\s*(\w+)(?:\s*\(([^)]+)\))?\s*,?\s*(.*)$/i)) {
				my ($name, $type, $constraint, $desc) = ($1, lc($2), $3, $4);

				# Clean up
				$desc =~ s/^\s+|\s+$//g if $desc;

				# Skip common non-parameters
				next if $name =~ /^(self|class|return|returns?)$/i;

				$params{$name} ||= { _source => 'pod' };

				# If we haven't already assigned a position from the signature, use order in Parameters section
				unless (exists $params{$name}{position}) {
					$params{$name}{position} = $param_order++;
					$self->_log("  POD: $name has position $params{$name}{position} (from Parameters order)");
				}

				# Normalize type names
				$type = 'integer' if $type eq 'int';
				$type = 'number' if $type eq 'num' || $type eq 'float';
				$type = 'boolean' if $type eq 'bool';
				$type = 'arrayref' if $type eq 'array';
				$type = 'hashref' if $type eq 'hash';

				$params{$name}{type} = $type;

				# Parse constraints
				if($constraint) {
					$self->_parse_constraints($params{$name}, $constraint);
				}

				# Check for optional/required in description OR constraint
				my $full_text = ($constraint || '') . ' ' . ($desc || '');
				if ($full_text =~ /optional/i) {
					$params{$name}{optional} = 1;
					$self->_log("  POD: $name marked as optional");
				} elsif ($full_text =~ /required|mandatory/i) {
					$params{$name}{optional} = 0;
					$self->_log("  POD: $name marked as required");
				}

				# Detect semantic types:
				if ($desc =~ /\b(email|url|uri|path|filename)\b/i) {
					# TODO: ensure properties is set to 1 in $config
					carp('Manually set config->properties to 1 in ', $self->{'input_file'});
					$params{$name}{semantic} = lc($1);
				}

				# Look for regex patterns
				if ($desc && $desc =~ m{matches?\s+(/[^/]+/|qr/.+?/)}i) {
					$params{$name}{matches} = $1;
				}

				$self->_log("  POD: Found parameter '$name' in parameters section, type=$type" .
						($constraint ? " ($constraint)" : '') .
						($desc ? " - $desc" : ''));
			}
		}
	}

	# Pattern 2: Also try the inline format in case Parameters: section wasn't found
	while ($pod =~ /\$(\w+)\s*-\s*(string|integer|int|number|num|float|boolean|bool|arrayref|array|hashref|hash|object)(?:\s*\(([^)]+)\))?\s*,?\s*(.*)$/gim) {
		my ($name, $type, $constraint, $desc) = ($1, lc($2), $3, $4);

		# Only process if we haven't already found this param in the Parameters section
		next if exists $params{$name};

		# Clean up description - remove leading/trailing whitespace
		$desc =~ s/^\s+|\s+$//g if $desc;

		# Skip common words that aren't parameters
		next if $name =~ /^(self|class|return|returns?)$/i;

		$params{$name} ||= { _source => 'pod' };

		# Normalize type names
		$type = 'integer' if $type eq 'int';
		$type = 'number' if $type eq 'num' || $type eq 'float';
		$type = 'boolean' if $type eq 'bool';
		$type = 'arrayref' if $type eq 'array';
		$type = 'hashref' if $type eq 'hash';

		$params{$name}{type} = $type;

		# Parse constraints
		if ($constraint) {
			$self->_parse_constraints($params{$name}, $constraint);
		}

		# Check for optional/required in description
		if ($desc) {
			if ($desc =~ /optional/i) {
				$params{$name}{optional} = 1;
			} elsif ($desc =~ /required|mandatory/i) {
				$params{$name}{optional} = 0;
			}

			# Look for regex patterns in description
			if ($desc =~ m{matches?\s+(/[^/]+/|qr/.+?/)}i) {
				$params{$name}{matches} = $1;
			}
		}

		$self->_log("  POD: Found parameter '$name' in the inline documentation, type=$type" .
					($constraint ? " ($constraint)" : ''));
	}

	# Pattern 3: Parse =over /=item list (supports bullets and C<>)
	while ($pod =~ /=item\s+(?:\*\s*)?(?:C<)?\$(\w+)\b(?:>)?\s*(?:-.*)?\n?(.*?)(?==item|\=back|\=head)/sig) {
		my $name = $1;
		my $desc = $2;

		# Never allow empty or undefined parameter names
		next unless defined $name && length $name;

		$desc =~ s/^\s+|\s+$//g;

		# Skip common non-parameters
		next if $name =~ /^(self|class|return|returns?)$/i;

		$params{$name} ||= { _source => 'pod' };

		# Explicit typed form only:
		#	$param - type (constraints)
		if ($desc =~ /^\s*(string|integer|int|number|num|float|boolean|bool|array|arrayref|hash|hashref)\b(?:\s*\(([^)]+)\))?/i) {
			my $type = lc($1);
			my $constraint = $2;

			# Normalize type names
			$type = 'integer' if $type eq 'int';
			$type = 'number' if $type eq 'num' || $type eq 'float';
			$type = 'boolean' if $type eq 'bool';
			$type = 'arrayref' if $type eq 'array';
			$type = 'hashref' if $type eq 'hash';

			$params{$name}{type} = $type;

			if ($constraint) {
				$self->_parse_constraints($params{$name}, $constraint);
			}

			$self->_log("  POD: Explicit type '$type' for $name");
		} else {
			# Heuristic inference from description text
			if ($desc =~ /\bstring\b/i) {
				$params{$name}{type} = 'string';
			} elsif ($desc =~ /\b(int|integer)\b/i) {
				$params{$name}{type} = 'integer';
			} elsif ($desc =~ /\b(num|number|float)\b/i) {
				$params{$name}{type} = 'number';
			} elsif ($desc =~ /\b(bool|boolean)\b/i) {
				$params{$name}{type} = 'boolean';
			}
		}

		# Check for optional/required in description
		if ($desc =~ /optional/i) {
			$params{$name}{optional} = 1;
		} elsif ($desc =~ /required|mandatory/i) {
			$params{$name}{optional} = 0;
		}

		# Look for regex patterns
		if ($desc =~ m{matches?\s+(/[^/]+/|qr/.+?/)}i) {
			$params{$name}{matches} = $1;
		}

		$self->_log("  POD: Found parameter '$name' from =item list");
	}

	# Extract default values from POD
	my $pod_defaults = $self->_extract_defaults_from_pod($pod);
	foreach my $param (keys %$pod_defaults) {
		if (exists $params{$param}) {
			$params{$param}{_default} = $pod_defaults->{$param};
			$params{$param}{optional} = 1 unless defined $params{$param}{optional};
			$self->_log(sprintf("  POD: %s has default value: %s",
				$param,
				defined($pod_defaults->{$param}) ? $pod_defaults->{$param} : 'undef'
			));
		}
	}

	# Default undocumented optionality: documented params are REQUIRED unless stated otherwise
	for my $name (keys %params) {
		next if $name =~ /^(self|class)$/i;

		# TODO: if optionality was never explicitly set, assume required.
		# Currently disabled as it breaks some schemas — revisit in a future pass.
		# if (!exists $params{$name}{optional}) {
			# $params{$name}{optional} = 0;
			# $self->_log("  POD: $name assumed required (no optional/default specified)");
		# }
	}

	return \%params;
}

# --------------------------------------------------
# _analyze_output
#
# Purpose:    Orchestrate analysis of a method's
#             return value by combining POD return
#             section parsing, code return statement
#             analysis, boolean detection, context
#             detection, void detection, chaining
#             detection, and error convention
#             detection.
#
# Entry:      $pod         - POD string for the method.
#             $code        - method body source string.
#             $method_name - name of the method being
#                            analysed, used for
#                            boolean heuristics.
#
# Exit:       Returns a hashref describing the
#             output type and behaviour, or an empty
#             hashref if nothing could be determined.
#             Keys include: type, value, isa, and
#             various _* metadata keys.
#
# Side effects: Logs progress to stdout when
#               verbose is set.
# --------------------------------------------------
sub _analyze_output {
	my ($self, $pod, $code, $method_name) = @_;

	my %output;

	$self->_analyze_output_from_pod(\%output, $pod);
	$self->_analyze_output_from_code(\%output, $code, $method_name);
	$self->_enhance_boolean_detection(\%output, $pod, $code, $method_name);
	$self->_detect_list_context(\%output, $code);
	$self->_detect_void_context(\%output, $code, $method_name);
	$self->_detect_chaining_pattern(\%output, $code);
	$self->_detect_error_conventions(\%output, $code);

	$self->_validate_output(\%output) if keys %output;

	# Don't return empty output
	return (keys %output) ? \%output : {};
}

# --------------------------------------------------
# _analyze_output_from_pod
#
# Purpose:    Parse the POD documentation for a
#             method's return value and populate
#             an output hashref with type, value,
#             and behaviour information.
#
# Entry:      $output - hashref to populate
#                       (modified in place).
#             $pod    - POD string for the method.
#
# Exit:       Returns nothing. Modifies $output
#             in place.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
#
# Notes:      Two patterns are tried: (1) a
#             'Returns:' section of up to 3 lines,
#             and (2) an inline 'returns X' phrase.
#             The section pattern takes precedence.
# --------------------------------------------------
sub _analyze_output_from_pod {
	my ($self, $output, $pod) = @_;
	my %VALID_OUTPUT_TYPES = map { $_ => 1 }
		qw(string integer number float boolean arrayref hashref object coderef void undef);

	if ($pod) {
		# Pattern 1: Returns: section
		# Up to 3 lines
		if ($pod =~ /Returns?:\s+([^\n]+(?:\n[^\n]+){0,2})/si) {
			my $returns_desc = $1;
			$returns_desc =~ s/^\s+|\s+$//g;

			$self->_log("  OUTPUT: Found Returns section: $returns_desc");

			# Try to infer type from description
			if ($returns_desc =~ /\b(string|text)\b/i) {
				$output->{type} = 'string';
			} elsif ($returns_desc =~ /\b(integer|int|count)\b/i) {
				$output->{type} = 'integer';
			} elsif ($returns_desc =~ /\b(float|decimal|number)\b/i) {
				$output->{type} = 'number';
			} elsif ($returns_desc =~ /\b(boolean|true|false)\b/i) {
				$output->{type} = 'boolean';
			} elsif ($returns_desc =~ /\b(array|list)\b/i) {
				$output->{type} = 'arrayref';
			} elsif ($returns_desc =~ /\b(hash|hashref|dictionary)\b/i) {
				$output->{type} = 'hashref';
			} elsif ($returns_desc =~ /\b(object|instance)\b/i) {
				$output->{type} = 'object';
			} elsif ($returns_desc =~ /\bundef\b/i) {
				$output->{type} = 'undef';
			}

			# Look for specific values
			if ($returns_desc =~ /\b1\s+(?:on\s+success|if\s+successful)\b/i) {
				$output->{value} = 1;
				if(defined($output->{'type'}) && ($output->{type} eq 'scalar')) {
					$output->{type} = 'boolean';
				} else {
					$output->{type} ||= 'boolean';
				}
				$self->_log("  OUTPUT: Returns 1 on success");
			} elsif ($returns_desc =~ /\b0\s+(?:on\s+failure|if\s+fail)\b/i) {
				$output->{alt_value} = 0;
			} elsif ($returns_desc =~ /dies\s+on\s+(?:error|failure)/i) {
				$output->{_STATUS} = 'LIVES';
				$self->_log('  OUTPUT: Should not die on success');
			}
			if ($returns_desc =~ /\b(true|false)\b/i) {
				$output->{type} ||= 'boolean';
			}
			if ($returns_desc =~ /\bundef\b/i) {
				$output->{optional} = 1;
			}
		}

		# Pattern 2: Inline "returns X"
		if((!$output->{type}) && ($pod =~ /returns?\s+(?:an?\s+)?(\w+)/i)) {
			my $type = lc($1);

			$type = 'boolean' if $type =~ /^(true|false|bool)$/;
			# Skip if it's just a number (like "returns 1")
			$type = 'integer' if $type eq 'int';
			$type = 'number' if $type =~ /^(num|float)$/;
			$type = 'arrayref' if $type eq 'array';
			$type = 'hashref' if $type eq 'hash';

			if($type =~ /^\d+$/) {
				if($type eq '1' || $type eq '0') {
					# Try hard to guess if the result is a boolean
					if($pod =~ /1 on success.+0 (on|if) /i) {
						$type = 'boolean';
					} elsif($pod =~ /return 0 .+ 1 on success/) {
						$type = 'boolean';
					} else {
						$type = 'integer';
					}
				} else {
					$type = 'integer';
				}
			}

			$type = 'arrayref' if !$type && $pod =~ /returns?\s+.+\slist\b/i;
			# $output->{type} = $type if $type && $type !~ /^\d+$/;
			if ($VALID_OUTPUT_TYPES{$type}) {
				$output->{type} = $type;
				$self->_log("  OUTPUT: Inferred type from POD: $type");
			} else {
				$self->_log("  OUTPUT: POD return type '$type' is not a valid type, ignoring");
			}
		}
	}
}

# --------------------------------------------------
# _extract_defaults_from_pod
#
# Purpose:    Extract default values for parameters
#             from POD documentation using multiple
#             pattern strategies.
#
# Entry:      $pod - POD string for the method.
#                    May be undef or empty.
#
# Exit:       Returns a hashref of parameter name
#             to cleaned default value. Returns an
#             empty hashref if no POD is provided
#             or no defaults are found.
#
# Side effects: None.
#
# Notes:      Three strategies are tried: (1) lines
#             containing 'Default:' or 'Defaults to:',
#             (2) lines containing 'Optional, default',
#             (3) inline $name - type, default value
#             format. Parameter names are inferred
#             by scanning backwards from the default
#             phrase to the nearest $variable.
# --------------------------------------------------
sub _extract_defaults_from_pod {
	my ($self, $pod) = @_;

	return {} unless $pod;

	my %defaults;

	# Pattern 1: Default: 'value' or Defaults to: 'value'
	while ($pod =~ /(?:Default(?:s? to)?|default(?:s? to)?)[:]\s*([^\n\r]+)/gi) {
		my $default_text = $1;
		my $match_pos = pos($pod);
		$default_text =~ s/^\s+|\s+$//g;

		# Look backwards in the POD to find the parameter name
		my $context = substr($pod, 0, $match_pos);
		my @param_matches = ($context =~ /\$(\w+)/g);
		my $param = $param_matches[-1] if @param_matches;  # Last parameter before default

		if ($param) {
			# Always clean the default value - let _clean_default_value handle everything
			if ($default_text =~ /(\w+)\s*=\s*(.+)$/) {
				# Has explicit param = value format in the default text
				my ($p, $value) = ($1, $2);
				$defaults{$p} = $self->_clean_default_value($value);
			} else {
				# Just a value, associate with the found param
				$defaults{$param} = $self->_clean_default_value($default_text, 0);  # NOT from code
			}
		}
	}

	# Pattern 2: Optional, default 'value'
	while ($pod =~ /Optional(?:,)?\s+(?:default|value)\s*[:=]?\s*([^\n\r,;]+)/gi) {
		my $default_text = $1;
		my $match_pos = pos($pod);
		$default_text =~ s/^\s+|\s+$//g;

		# Look backwards for parameter name
		my $context = substr($pod, 0, $match_pos);
		my @param_matches = ($context =~ /\$(\w+)/g);
		if (@param_matches) {
			my $param = $param_matches[-1];  # Last parameter before the default
			$defaults{$param} = $self->_clean_default_value($default_text, 0);
		}
	}

	# Pattern 3: In parameter descriptions: $param - type, default 'value'
	while ($pod =~ /\$(\w+)\s*-\s*\w+(?:\([^)]*\))?[,\s]+default\s+['"]?([^'",\n]+)['"]?/gi) {
		my ($param, $value) = ($1, $2);
		$defaults{$param} = $self->_clean_default_value($value, 0);
	}

	return \%defaults;
}

# --------------------------------------------------
# _analyze_output_from_code
#
# Purpose:    Analyse return statements in a method
#             body to infer the output type by
#             counting and classifying each return
#             expression.
#
# Entry:      $output      - hashref to populate
#                            (modified in place).
#             $code        - method body source string.
#             $method_name - method name string.
#
# Exit:       Returns nothing. Modifies $output
#             in place.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _analyze_output_from_code
{
	my ($self, $output, $code, $method_name) = @_;

	if ($code) {
		# Early boolean detection - check for consistent 1/0 returns
		my @all_returns = $code =~ /return\s+([^;]+);/g;
		if (@all_returns) {
			my $boolean_count = 0;
			my $total_count = scalar(@all_returns);

			foreach my $ret (@all_returns) {
				$ret =~ s/^\s+|\s+$//g;
				# Match 0 or 1, even with conditions
				$boolean_count++ if ($ret =~ /^(?:0|1)(?:\s|$)/);
			}

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

		my @return_statements;

		if ($code =~ /return\s+bless\s*\{[^}]*\}\s*,\s*['"]?(\w+)['"]?/s) {
			# Detect blessed refs
			$output->{type} = 'object';
			if($method_name eq 'new') {
				# If we found the new() method, the object we're returning should be a sensible one
				if($self->{_document} && (my $package_stmt = $self->{_document}->find_first('PPI::Statement::Package'))) {
					$output->{isa} = $package_stmt->namespace();
					$self->{_package_name} //= $output->{isa};
				}
			} else {
				$output->{isa} = $1;
			}
			$self->_log("  OUTPUT: Bless found, inferring type from code is $output->{isa}");
		} elsif ($code =~ /return\s+bless/s) {
			$output->{type} = 'object';
			if($method_name eq 'new') {
				$output->{isa} = $self->_extract_package_name();
				$self->_log("  OUTPUT: Bless found, inferring type from code is $output->{isa}");
			} else {
				$self->_log('  OUTPUT: Bless found, inferring type from code is object');
			}
		} elsif ($code =~ /return\s*\(\s*[^)]+\s*,\s*[^)]+\s*\)\s*;/) {
			# Detect array context returns - must end with semicolon to be actual return
			$output->{type} = 'array';	# Not arrayref - actual array
			$self->_log('  OUTPUT: Found array contect return');
		} elsif ($code =~ /return\s+bless[^,]+,\s*__PACKAGE__/) {
			# Detect: bless {}, __PACKAGE__
			$output->{type} = 'object';
			# Get package name from the extractor's stored document
			if ($self->{_document}) {
				my $pkg = $self->{_document}->find_first('PPI::Statement::Package');
				$output->{isa} = $pkg ? $pkg->namespace : 'UNKNOWN';
				$self->_log('  OUTPUT: Object blessed into __PACKAGE__: ' . ($output->{isa} || 'UNKNOWN'));
				$self->{_package_name} //= $output->{isa};
			}
		} elsif ($code =~ /return\s*\(([^)]+)\)/) {
			my $content = $1;
			if ($content =~ /,/) {	# Has comma = multiple values
				$output->{type} = 'array';
			}
		} elsif ($code =~ /return\s+\$self\s*;/ && $code =~ /\$self\s*->\s*\{[^}]+\}\s*=/) {
			# Returns $self for chaining
			$output->{type} = 'object';
			if ($self->{_document}) {
				my $pkg = $self->{_document}->find_first('PPI::Statement::Package');
				$output->{isa} = $pkg ? $pkg->namespace : 'UNKNOWN';
				$self->_log('  OUTPUT: Object chained into __PACKAGE__: ' . ($output->{isa} || 'UNKNOWN'));
				$self->{_package_name} //= $output->{isa};
			}
		}

		# Find all return statements
		while ($code =~ /return\s+([^;]+);/g) {
			my $return_expr = $1;
			push @return_statements, $return_expr;
		}

		if (@return_statements) {
			$self->_log('  OUTPUT: Found ' . scalar(@return_statements) . ' return statement(s)');

			# Analyze return patterns
			my %return_types;

			if($output->{'type'}) {
				$return_types{$output->{'type'}} += 3;	# Add weighting to what's already been found
			}
			my $min;
			foreach my $ret (@return_statements) {
				$ret =~ s/^\s+|\s+$//g;

				# Literal values
				if ($ret eq '1' || $ret eq '0') {
					$return_types{boolean}++;
				} elsif ($ret =~ /^['"]/) {
					$return_types{string}++;
				} elsif ($ret =~ /^-?\d+$/) {
					$return_types{integer}++;
				} elsif ($ret =~ /^-?\d+\.\d+$/) {
					$return_types{number}++;
				} elsif ($ret eq 'undef') {
					$return_types{undef}++;
				} elsif ($ret =~ /^\[/) {
				# Data structures
					$return_types{arrayref}++;
				} elsif ($ret =~ /^\{/) {
					$return_types{hashref}++;
				} elsif ($ret =~ m{
					# Numeric expressions (heuristic, medium confidence)
					# Don't match ->
				    (?:
					\+ | -\b | \* | / | %
				      | \+\+ | --
				    )
				}x) {
					$return_types{number} += 2;
				} elsif ($ret =~ /\|\|\s*\d+\b/) {
					# Logical-or fallback with numeric literal (e.g. $x || 200)
					$return_types{integer} += 2;
					$self->_log("  OUTPUT: Numeric fallback expression detected");
				} elsif($ret =~ /^length[\s\(]/) {
					$return_types{integer}++;
					$min = 0;
				} elsif($ret =~ /^pos[\s\(]/) {
					$return_types{integer}++;
					$min = 0;
				} elsif($ret =~ /^index[\s\(]/) {
					$return_types{integer}++;
					$min = -1;
				} elsif($ret =~ /^rindex[\s\(]/) {
					$return_types{integer}++;
					$min = -1;
				} elsif($ret =~ /^ord[\s\(]/) {
					$return_types{integer}++;
				} elsif ($ret =~ /=/ && $ret =~ /\$\w+/) {
					# Assignment returning a value (e.g. $self->{status} = $status)
					# If assignment involves a numeric literal or variable, assume numeric intent
					if ($ret =~ /\b\d+\b/) {
						$return_types{integer} += 2;
						$self->_log("  OUTPUT: Assignment with numeric value detected");
					} else {
						$return_types{scalar}++;
					}
				}
				# Variables/expressions
				elsif ($ret =~ /\$\w+/) {
					if ($ret =~ /\\\@/) {
						$return_types{arrayref}++;
					} elsif ($ret =~ /\\\%/) {
						$return_types{hashref}++;
					} elsif ($ret =~ /bless/) {
						$return_types{object} += 2;	# Heigher weight
					} elsif ($ret =~ /^\{[^}]*\}$/) {
						$return_types{hashref}++;
					} elsif ($ret =~ /^\[[^\]]*\]$/) {
						$return_types{arrayref}++;
					} else {
						$return_types{scalar}++;
					}
				}
			}

			# Determine most common return type
			if (keys %return_types) {
				my ($most_common) = sort { $return_types{$b} <=> $return_types{$a} } keys %return_types;
				# Prefer integer over scalar if numeric returns dominate
				if ($return_types{integer} && (!$return_types{string})) {
					if (!$output->{type} || $output->{type} eq 'scalar') {
						$output->{type} = 'integer';
						$self->_log("  OUTPUT: Numeric returns dominate, forcing integer");
						$output->{_type_confidence} ||= 'low';
						if(defined($min)) {
							$output->{min} = $min;
						}
					}
				}
				unless ($output->{type}) {
					$output->{type} = $most_common;

					# Assign confidence for inferred numeric expressions
					if ($most_common eq 'number') {
						$output->{_type_confidence} ||= 'medium';
						if(defined($min)) {
							$output->{min} = $min;
						}
					}

					$self->_log("  OUTPUT: Inferred type from code: $most_common");
				}
			}

			# Check for consistent single value returns
			if (@return_statements == 1 && $return_statements[0] eq '1') {
				$output->{value} = 1;
				$output->{type} = 'boolean' if !$output->{type} || $output->{type} eq 'scalar';
				$self->_log("  OUTPUT: Type already set to '$output->{type}', overriding with boolean") if($output->{'type'});
			}
		} else {
			# No explicit return - might return nothing or implicit undef
			$self->_log("  OUTPUT: No explicit return statement found");
		}
	}
}

# --------------------------------------------------
# _enhance_boolean_detection
#
# Purpose:    Apply additional boolean-specific
#             detection heuristics using a weighted
#             scoring system, to override weak
#             type assignments when there is strong
#             evidence of a boolean return.
#
# Entry:      $output      - output hashref
#                            (modified in place).
#             $pod         - POD string.
#             $code        - method body source string.
#             $method_name - method name string.
#
# Exit:       Returns nothing. Modifies $output
#             in place, setting type to 'boolean'
#             if the score reaches
#             $BOOLEAN_SCORE_THRESHOLD.
#
# Side effects: Logs scoring details to stdout when
#               verbose is set.
#
# Notes:      Only fires when output type is
#             not yet set or is 'unknown'. Does not
#             override explicitly set types.
# --------------------------------------------------
sub _enhance_boolean_detection {
	my ($self, $output, $pod, $code, $method_name) = @_;

	my $boolean_score = 0;	# Track evidence for boolean return

	return unless !$output->{type} || $output->{type} eq 'unknown';

	# Look for stronger boolean indicators
	if ($pod && !$output->{type}) {
		# Common boolean return patterns in POD
		if ($pod =~ /returns?\s+(true|false|true|false|1|0)\s+(?:on|for|upon)\s+(success|failure|error|valid|invalid)/i) {
			$boolean_score += 30;
			$self->_log('  OUTPUT: Strong boolean indicator in POD (+30)');
		}

		# Check for method names that suggest boolean returns
		if ($pod =~ /(?:method|sub)\s+(\w+)/) {
			my $inferred_method_name = $1;
			if ($inferred_method_name =~ /^(is_|has_|can_|should_|contains_|exists_)/) {
				$boolean_score += 20;
				$self->_log("  OUTPUT: Inferred method name '$inferred_method_name' suggests boolean return (+20)");
			}
		}
	}

	# Analyze code for boolean patterns
	if ($code) {
		# Count boolean return idioms
		my $true_returns = () = $code =~ /return\s+1\s*;/g;
		my $false_returns = () = $code =~ /return\s+0\s*;/g;

		if ($true_returns + $false_returns >= 2) {
			$boolean_score += 40;
			$self->_log('  OUTPUT: Multiple 1/0 returns suggest boolean (+40)');
		} elsif ($true_returns + $false_returns == 1) {
			$boolean_score += 10;
			$self->_log('  OUTPUT: Single 1/0 return (+10)');
		}

		# Ternary operators that return booleans
		if ($code =~ /return\s+(?:\w+\s*[!=]=\s*\w+|\w+\s*>\s*\w+|\w+\s*<\s*\w+)\s*\?\s*(?:1|0)\s*:\s*(?:1|0)/) {
			$boolean_score += 25;
			$self->_log('  OUTPUT: Ternary with 1/0 suggests boolean (+25)');
		}

		# Check for common boolean method patterns
		if ($code =~ /return\s+[!\$\@\%]/) {
			# Returns negation or existence check
			$boolean_score += 15;
			$self->_log('  OUTPUT: Returns negation/existence check (+15)');
		}
	}

	# Check method name for boolean indicators
	if ($method_name) {
		if ($method_name =~ /^(is_|has_|can_|should_|contains_|exists_|check_|verify_|validate_)/) {
			$boolean_score += 25;
			$self->_log("  OUTPUT: Method name '$method_name' suggests boolean return (+25)");
		}
		if ($method_name =~ /_ok$/) {
			$boolean_score += 30;
			$self->_log("  OUTPUT: Method name '$method_name' ends with '_ok' (+30)");
		}
	}

	# Apply boolean type if we have strong evidence
	# Override weak type assignments (like 'array' from false positive)
	if($boolean_score >= $BOOLEAN_SCORE_THRESHOLD) {
		if (!$output->{type} || $output->{type} eq 'scalar' || $output->{type} eq 'array' || $output->{type} eq 'undef') {
			my $old_type = $output->{type} || 'none';
			$output->{type} = 'boolean';
			$self->_log("  OUTPUT: Boolean score $boolean_score >= $BOOLEAN_SCORE_THRESHOLD, setting type to boolean (was: $old_type)");
		}
	}
}

# --------------------------------------------------
# _detect_list_context
#
# Purpose:    Detect methods that return different
#             values depending on calling context
#             via wantarray, and methods that
#             return explicit lists.
#
# Entry:      $output - output hashref (modified
#                       in place).
#             $code   - method body source string.
#
# Exit:       Returns nothing. Modifies $output
#             in place, setting _context_aware,
#             _list_context, _scalar_context,
#             _list_return, and/or type keys.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _detect_list_context {
	my ($self, $output, $code) = @_;
	return unless $code;

	# Check for wantarray usage
	if ($code =~ /wantarray/) {
		$output->{_context_aware} = 1;
		$self->_log('  OUTPUT: Method uses wantarray - context sensitive');

		# Debug: show what we're matching against
		if ($code =~ /(wantarray[^;]+;)/s) {
			$self->_log("  DEBUG wantarray line: $1");
		}

		if ($code =~ /wantarray\s*\?\s*\(([^)]+)\)\s*:\s*([^;]+)/s) {
			# Pattern 1: wantarray ? (list, items) : scalar_value (with parens)
			my ($list_return, $scalar_return) = ($1, $2);
			$self->_log("  DEBUG list (with parens): [$list_return], scalar: [$scalar_return]");

			$output->{_list_context} = $self->_infer_type_from_expression($list_return);
			$output->{_scalar_context} = $self->_infer_type_from_expression($scalar_return);
			$self->_log('  OUTPUT: Detected context-dependent returns (parenthesized)');
		} elsif ($code =~ /wantarray\s*\?\s*([^:]+?)\s*:\s*([^;]+)/s) {
			# Pattern 2: wantarray ? @array : scalar (no parens around list)
			my ($list_return, $scalar_return) = ($1, $2);
			# Clean up
			$list_return =~ s/^\s+|\s+$//g;
			$scalar_return =~ s/^\s+|\s+$//g;

			$self->_log("  DEBUG list (no parens): [$list_return], scalar: [$scalar_return]");

			$output->{_list_context} = $self->_infer_type_from_expression($list_return);
			$output->{_scalar_context} = $self->_infer_type_from_expression($scalar_return);
			$self->_log('  OUTPUT: Detected context-dependent returns (non-parenthesized)');
		} elsif ($code =~ /return[^;]*unless\s+wantarray.*?return\s*\(([^)]+)\)/s) {
			# Pattern 3: return unless wantarray; return (list);
			$output->{_list_context} = { type => 'array' };
			$self->_log('  OUTPUT: Detected list context return after wantarray check');
		}
	}

	# Detect explicit list returns (multiple values in parentheses)
	# Avoid false positives from function calls
	if ($code =~ /return\s*\(\s*([^)]+)\s*\)\s*;/) {
		my $content = $1;
		# Count commas outside of nested structures
		my $comma_count = 0;
		my $depth = 0;
		for my $char (split //, $content) {
			$depth++ if $char eq '(' || $char eq '[' || $char eq '{';
			$depth-- if $char eq ')' || $char eq ']' || $char eq '}';
			$comma_count++ if $char eq ',' && $depth == 0;
		}

		if ($comma_count > 0 && $content !~ /\b(?:bless|new)\b/) {
			# Multiple values returned
			unless ($output->{type} && $output->{type} eq 'boolean') {
				$output->{type} = 'array';
				$output->{_list_return} = $comma_count + 1;
				$self->_log('  OUTPUT: Returns list of ' . ($comma_count + 1) . ' values');
			}
		}
	}
}

# --------------------------------------------------
# _detect_void_context
#
# Purpose:    Detect methods that return nothing
#             meaningful (void context), methods
#             that always return 1 as a success
#             indicator, and methods whose name
#             suggests void context (setters,
#             mutators, loggers).
#
# Entry:      $output      - output hashref
#                            (modified in place).
#             $code        - method body source string.
#             $method_name - method name string.
#
# Exit:       Returns nothing. Modifies $output
#             in place, setting _void_context,
#             _success_indicator, and/or type.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _detect_void_context {
	my ($self, $output, $code, $method_name) = @_;
	return unless $code;

	$self->_log("  DEBUG _detect_void_context called for $method_name");

	# Methods that typically don't return meaningful values
	my $void_patterns = {
		'setter' => qr/^set_\w+$/,
		'mutator' => qr/^(?:add|remove|delete|clear|reset|update)_/,
		'logger' => qr/^(?:log|debug|warn|error|info)$/,
		'printer' => qr/^(?:print|say|dump)_/,
	};

	# Check if method name suggests void context
	foreach my $type (keys %$void_patterns) {
		if ($method_name =~ $void_patterns->{$type}) {
			$output->{_void_context_hint} = $type;
			$self->_log("  OUTPUT: Method name suggests $type (typically void context)");
			last;
		}
	}

	# Analyze return statements
	my @returns = $code =~ /return\s*([^;]*);/g;

	$self->_log('  DEBUG Found ' . scalar(@returns) . ' return statements');

	# Count different return patterns
	my $no_value_returns = 0;
	my $true_returns = 0;
	my $self_returns = 0;

	foreach my $ret (@returns) {
		$ret =~ s/^\s+|\s+$//g;
		$self->_log("  DEBUG return value: [$ret]");
		$no_value_returns++ if $ret eq '';
		$no_value_returns++ if($ret =~ /^(if|unless)\s/);
		$true_returns++ if $ret eq '1';
		$self_returns++ if $ret eq '$self';
		if ($ret =~ /\?\s*1\s*:\s*0\b/) {
			# Strong boolean signal: ternary returning 1/0
			$true_returns++;
			# $self->_log("  OUTPUT: Ternary 1:0 return detected, treating as boolean (+40)");
			$self->_log('  OUTPUT: Ternary 1:0 return detected, treating as boolean');
		}
	}

	my $total_returns = scalar(@returns);

	$self->_log("  DEBUG no_value=$no_value_returns, true=$true_returns, self=$self_returns, total=$total_returns");

	# Void context indicators
	if ($no_value_returns > 0 && $no_value_returns == $total_returns) {
		$output->{_void_context} = 1;
		$output->{type} = 'void';  # This should override any previous type
		$self->_log('  OUTPUT: All returns are empty - void context method');
	} elsif ($true_returns > 0 && $true_returns == $total_returns && $total_returns >= 1) {
		# Methods that always return true (success indicator)
		$output->{_success_indicator} = 1;
		# Don't override type if already set to boolean
		unless ($output->{type} && $output->{type} eq 'boolean') {
			$output->{type} = 'boolean';
		}
		$self->_log('  OUTPUT: Always returns 1 - success indicator pattern');
	}
}

# --------------------------------------------------
# _detect_chaining_pattern
#
# Purpose:    Detect methods that return $self for
#             fluent interface chaining, by counting
#             the proportion of return statements
#             that return $self.
#
# Entry:      $output - output hashref (modified
#                       in place).
#             $code   - method body source string.
#
# Exit:       Returns nothing. Modifies $output
#             in place, setting type to 'object',
#             _returns_self to 1, and isa to the
#             current package name when the
#             proportion of $self returns is >= 0.8.
#
# Side effects: Logs detection to stdout when
#               verbose is set.
# --------------------------------------------------
sub _detect_chaining_pattern {
	my ($self, $output, $code) = @_;
	return unless $code;

	# Count returns of $self
	my $self_returns = 0;
	my $total_returns = 0;

	while ($code =~ /return\s+([^;]+);/g) {
		my $ret = $1;
		$ret =~ s/^\s+|\s+$//g;
		$total_returns++;
		$self_returns++ if $ret eq '$self';
	}

	# If most/all returns are $self, it's a chaining method
	if ($self_returns > 0 && $total_returns > 0) {
		my $ratio = $self_returns / $total_returns;

		if ($ratio >= 0.8) {
			$output->{type} = 'object';
			$output->{_returns_self} = 1;

			# Get the class name
			if ($self->{_document}) {
				my $pkg = $self->{_document}->find_first('PPI::Statement::Package');
				$output->{isa} = $pkg ? $pkg->namespace : 'UNKNOWN';
				$self->{_package_name} //= $output->{isa};
			}

			$self->_log("  OUTPUT: Chainable method - returns \$self ($self_returns/$total_returns returns)");
		}
	}
}

# --------------------------------------------------
# _detect_error_conventions
#
# Purpose:    Analyse how a method signals errors
#             by detecting patterns such as
#             'return undef if', implicit bare
#             returns, empty list returns, 0/1
#             boolean error patterns, and eval
#             exception handling.
#
# Entry:      $output - output hashref (modified
#                       in place).
#             $code   - method body source string.
#
# Exit:       Returns nothing. Modifies $output
#             in place, setting _error_handling,
#             _error_return, and
#             _success_failure_pattern keys.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _detect_error_conventions {
	my ($self, $output, $code) = @_;

	return unless $code;

	$self->_log('  DEBUG _detect_error_conventions called');

	my %error_patterns;

	# Pattern 1: return undef if/unless condition
	while ($code =~ /return\s+undef\s+(?:if|unless)\s+([^;]+);/g) {
		push @{$error_patterns{undef_on_error}}, $1;
		$self->_log("  DEBUG Found 'return undef' pattern");
	}

	# Pattern 2: return if/unless (implicit undef)
	while ($code =~ /return\s+(?:if|unless)\s+([^;]+);/g) {
		push @{$error_patterns{implicit_undef}}, $1;
		$self->_log("  DEBUG Found implicit undef pattern");
	}

	# Pattern 3: return () - matches with or without conditions
	if ($code =~ /return\s*\(\s*\)\s*(?:if|unless|;)/) {
		$error_patterns{empty_list} = 1;
		$self->_log("  DEBUG Found empty list return");
	}

	# Pattern 4: return 0/1 pattern (indicates boolean with error handling)
	my $zero_returns = 0;
	my $one_returns = 0;
	# Match "return 0" or "return 1" followed by anything (condition or semicolon)
	while ($code =~ /return\s+(0|1)\s*(?:;|if|unless)/g) {
		if ($1 eq '0') {
			$zero_returns++;
		} else {
			$one_returns++;
		}
	}

	if ($zero_returns > 0 && $one_returns > 0) {
		$error_patterns{zero_on_error} = 1;
		$self->_log("  DEBUG Found 0/1 return pattern ($zero_returns zeros, $one_returns ones)");
	}

	# Pattern 5: Exception handling with eval
	if ($code =~ /eval\s*\{/) {
		# Check if there's error handling after eval
		if ($code =~ /eval\s*\{.*?\}[^}]*(?:if\s*\(\s*\$\@|catch|return\s+undef)/s) {
			$error_patterns{exception_handling} = 1;
			$self->_log('  DEBUG Found exception handling with eval');
		}
	}

	# Detect success/failure return pattern
	my @all_returns = $code =~ /return\s+([^;]+);/g;
	my $has_undef = grep { /^\s*undef\s*(?:if|unless|$)/ } @all_returns;
	my $has_value = grep { !/^\s*undef\s*$/ && !/^\s*$/ } @all_returns;

	if ($has_undef && $has_value && scalar(@all_returns) >= 2) {
		$output->{_success_failure_pattern} = 1;
		$self->_log("  OUTPUT: Uses success/failure return pattern");
	}

	# Store error conventions in output
	if(scalar(keys %error_patterns)) {
		$output->{_error_handling} = \%error_patterns;

		# Determine primary error convention
		if ($error_patterns{undef_on_error}) {
			$output->{_error_return} = 'undef';
			$self->_log("  OUTPUT: Returns undef on error");
		} elsif ($error_patterns{implicit_undef}) {
			$output->{_error_return} = 'undef';
			$self->_log("  OUTPUT: Returns implicit undef on error");
		} elsif ($error_patterns{empty_list}) {
			$output->{_error_return} = 'empty_list';
			$self->_log("  OUTPUT: Returns empty list on error");
		} elsif ($error_patterns{zero_on_error}) {
			$output->{_error_return} = 'false';
			$self->_log("  OUTPUT: Returns 0/false on error");
		}

		if ($error_patterns{exception_handling}) {
			$self->_log("  OUTPUT: Has exception handling");
		}
	} else {
		delete $output->{_error_handling};
	}
}

# --------------------------------------------------
# _infer_type_from_expression
#
# Purpose:    Infer the data type of a return
#             expression string by matching it
#             against common Perl literal and
#             variable patterns.
#
# Entry:      $expr - return expression string,
#                     trimmed of leading and
#                     trailing whitespace.
#                     May be undef.
#
# Exit:       Returns a type hashref of the form
#             { type => '...' } and optionally
#             { min => N }. Defaults to
#             { type => 'scalar' } when no
#             pattern matches.
#
# Side effects: None.
# --------------------------------------------------
sub _infer_type_from_expression {
	my ($self, $expr) = @_;

	return { type => 'scalar' } unless defined $expr;

	$expr =~ s/^\s+|\s+$//g;

	# Check for multiple comma-separated values (indicates array/list)
	if ($expr =~ /,/) {
		my $comma_count = 0;
		my $depth = 0;
		for my $char (split //, $expr) {
			$depth++ if $char =~ /[\(\[\{]/;
			$depth-- if $char =~ /[\)\]\}]/;
			$comma_count++ if $char eq ',' && $depth == 0;
		}

		if ($comma_count > 0) {
			return { type => 'array' };
		}
	}

	# Check for @ prefix (array)
	if ($expr =~ /^\@\w+/ || $expr =~ /^qw\(/ || $expr =~ /^\@\{/) {
		return { type => 'array' };
	}

	# Check for scalar() function - returns count
	if ($expr =~ /scalar\s*\(/) {
		return { type => 'integer', min => 0 };
	}

	# Check for array reference
	if ($expr =~ /^\[/ || $expr =~ /^\\\@/) {
		return { type => 'arrayref' };
	}

	# Check for hash reference
	if ($expr =~ /^\{/ || $expr =~ /^\\\%/) {
		return { type => 'hashref' };
	}

	# Check for hash
	if ($expr =~ /^\%\w+/ || $expr =~ /^\%\{/) {
		return { type => 'hash' };
	}

	# Check for strings
	if ($expr =~ /^['"]/ || $expr =~ /['"]$/) {
		return { type => 'string' };
	}

	# Check for booleans first — must come before the integer check
	# since /^-?\d+$/ would otherwise match 0 and 1 as integers
	if($expr =~ /^[01]$/) {
		return { type => 'boolean' };
	}

	# Check for integers
	if($expr =~ /^-?\d+$/) {
		return { type => 'integer' };
	}

	if ($expr =~ /^-?\d+\.\d+$/) {
		return { type => 'number' };
	}

	# Check for objects
	if ($expr =~ /bless/) {
		return { type => 'object' };
	}

	if($expr =~ /\blength\s*\(/) {
		return { type => 'integer', min => 0 };
	}

	# Default to scalar
	return { type => 'scalar' };
}

# --------------------------------------------------
# _detect_chaining_from_pod
#
# Purpose:    Check POD documentation for explicit
#             indications that a method is chainable
#             or part of a fluent interface.
#
# Entry:      $output - output hashref (modified
#                       in place).
#             $pod    - POD string for the method.
#
# Exit:       Returns nothing. Sets _returns_self
#             in $output if chaining keywords are
#             found.
#
# Side effects: Logs detection to stdout when
#               verbose is set.
# --------------------------------------------------
sub _detect_chaining_from_pod {
	my ($self, $output, $pod) = @_;
	return unless $pod;

	# Look for explicit chaining documentation
	if ($pod =~ /returns?\s+(?:\$)?self\b/i ||
		$pod =~ /chainable/i ||
		$pod =~ /fluent\s+interface/i ||
		$pod =~ /method\s+chaining/i) {

		$output->{_returns_self} = 1;
		$self->_log("  OUTPUT: POD indicates chainable/fluent interface");
	}
}

# --------------------------------------------------
# _validate_output
#
# Purpose:    Apply basic sanity checks to the
#             assembled output hashref and warn
#             about suspicious type combinations,
#             normalising clearly invalid types to
#             'string'.
#
# Entry:      $output - output hashref (modified
#                       in place).
#
# Exit:       Returns nothing. May modify type key
#             in $output. Logs warnings to stdout
#             when verbose is set.
#
# Side effects: None.
# --------------------------------------------------
sub _validate_output {
	my ($self, $output) = @_;

	# Warn about suspicious combinations
	if (defined $output->{type} && $output->{type} eq 'boolean' && !defined($output->{value})) {
		$self->_log('  WARNING Boolean type without value - may want to set value: 1');
	}
	if ($output->{value} && defined $output->{type} && $output->{type} ne 'boolean') {
		$self->_log("  WARNING Value set but type is not boolean: $output->{type}");
	}
	my %valid_types = map { $_ => 1 } qw(string integer number boolean arrayref hashref object void);
	if(exists $output->{type}) {
		if(!$valid_types{$output->{type}}) {
			$self->_log("  WARNING Output value type is unknown: '$output->{type}', setting to string");
			$output->{type} = 'string';
		}
	}
}

# --------------------------------------------------
# _parse_constraints
#
# Purpose:    Parse a constraint string extracted
#             from POD documentation and populate
#             min, max, or other constraint fields
#             in a parameter hashref.
#
# Entry:      $param      - hashref for the parameter
#                           being annotated (modified
#                           in place).
#             $constraint - the constraint string,
#                           e.g. '3-50', 'positive',
#                           '>= 0', 'min 3'.
#
# Exit:       Returns nothing. Modifies $param in
#             place by setting min and/or max keys.
#
# Side effects: Logs min/max values to stdout when
#               verbose is set.
# --------------------------------------------------
sub _parse_constraints {
	my ($self, $param, $constraint) = @_;

	# Range: "3-50" or "1-100 chars"
	if ($constraint =~ /(\d+)\s*-\s*(\d+)/) {
		$param->{min} = $1;
		$param->{max} = $2;
	}
	elsif ($constraint =~ /(\d+)\s*\.\.\s*(\d+)/) {
		# Range: 0..19
		$param->{min} = $1;
		$param->{max} = $2;
	}
	# Minimum: "min 3" or "at least 5"
	elsif ($constraint =~ /(?:min|minimum|at least)\s*(\d+)/i) {
		$param->{min} = $1;
	}
	# Maximum: "max 50" or "up to 100"
	elsif ($constraint =~ /(?:max|maximum|up to)\s*(\d+)/i) {
		$param->{max} = $1;
	}
	# Positive
	elsif ($constraint =~ /positive/i) {
		$param->{min} = 1 if $param->{type} && $param->{type} eq 'integer';
		$param->{min} = 0.01 if $param->{type} && $param->{type} eq 'number';
	}
	# Non-negative
	elsif ($constraint =~ /non-negative/i) {
		$param->{min} = 0;
	} elsif($constraint =~ /(.+)?\s(.+)/) {
		my ($op, $val) = ($1, $2);
		if(looks_like_number($val)) {
			if ($op eq '<') {
				$param->{max} = $val - 1;
			} elsif ($op eq '<=') {
				$param->{max} = $val;
			} elsif ($op eq '>') {
				$param->{min} = $val + 1;
			} elsif ($op eq '>=') {
				$param->{min} = $val;
			}
		}
	}

	if(defined($param->{max})) {
		$self->_log("  Set max to $param->{max}");
	}
	if(defined($param->{min})) {
		$self->_log("  Set min to $param->{min}");
	}
}

# --------------------------------------------------
# _analyze_code
#
# Purpose:    Analyse a method's source code using
#             pattern matching to infer parameter
#             names, types, constraints, defaults,
#             and optionality. Orchestrates all
#             per-parameter code analysis helpers.
#
# Entry:      $code   - method body source string.
#             $method - method hashref (used for
#                       constructor-specific logic
#                       when extracting parameters
#                       from @_ patterns).
#
# Exit:       Returns a hashref of parameter name
#             to parameter spec hashref, with as
#             much type and constraint information
#             as could be inferred from the code.
#
# Side effects: Logs progress and warnings to stdout
#               when verbose is set.
#
# Notes:      Analysis is capped at max_parameters
#             to prevent runaway processing on
#             pathological methods. Falls back to
#             classic @_ extraction if signature
#             extraction found no parameters.
# --------------------------------------------------
sub _analyze_code {
	my ($self, $code, $method) = @_;

	my %params;

	# Safety check - limit parameter analysis to prevent runaway processing
	my $param_count = 0;

	# Extract parameter names from various signature styles
	$self->_extract_parameters_from_signature(\%params, $code);

	$self->_extract_defaults_from_code(\%params, $code, $method);

	# Infer types from defaults
	foreach my $param (keys %params) {
		if ($params{$param}{_default} && !$params{$param}{type}) {
			my $default = $params{$param}{_default};
			if (ref($default) eq 'HASH') {
				$params{$param}{type} = 'hashref';
				$self->_log("  CODE: $param type inferred as hashref from default");
			} elsif (ref($default) eq 'ARRAY') {
				$params{$param}{type} = 'arrayref';
				$self->_log("  CODE: $param type inferred as arrayref from default");
			}
		}
	}

	if($code =~ /(croak|die)\(.*\)\s+if\s*\(\s*scalar\(\@_\)\s*<\s*(\d+)\s*\)/s) {
		my $required_count = $2;
		my @param_names = sort { $params{$a}{position} <=> $params{$b}{position} } keys %params;
		for my $i (0 .. $required_count-1) {
			$params{$param_names[$i]}{optional} = 0;
			$self->_log("  CODE: $param_names[$i] marked required due to croak scalar check");
		}
	} elsif ($code =~ /(croak|die)\(.*\)\s+if\s*\(\s*scalar\(\@_\)\s*==\s*(0)\s*\)/s) {
		foreach my $param (keys %params) {
			$params{$param}{optional} = 0;
			$self->_log("  CODE: $param: all parameters are required due to 'scalar(@_) == 0' check");
		}
	}

	# Analyze each parameter (with safety limit)
	foreach my $param (keys %params) {
		if ($param_count++ > $self->{max_parameters}) {
			$self->_log("  WARNING: Max parameters ($self->{max_parameters}) exceeded, skipping remaining");
			last;
		}

		my $p = \$params{$param};

		$self->_analyze_parameter_type($p, $param, $code);
		$self->_analyze_parameter_constraints($p, $param, $code);
		$self->_analyze_parameter_validation($p, $param, $code);
		$self->_analyze_advanced_types($p, $param, $code);

		# Defined checks
		if ($code =~ /defined\s*\(\s*\$$param\s*\)/) {
			$$p->{optional} = 0;
			$self->_log("  CODE: $param is required (defined check)");
		}

		# Determine optional/required and numeric type from code
		if ($code =~ /\s*\$$param\s*(?:\/\/|\|\|)=/) {
			# e.g. $var //= 5; or $var ||= 5;
			$$p->{optional} = 1;
			$self->_log("  CODE: $param is optional (default value assigned in code)");
		} elsif ($code =~ /\s*\$$param\s*(?:[\+\-\*\/%]|(?:\+\+)|(?:--)|(?:[\+\-\*\/%]=)|\+\$|\$[+-])/ ) {
			# Covers arithmetic usage:
			# $x + $param, $param++, $param--, $x += $param, $x -= $param, etc.
			$$p->{optional} = 0;
			$$p->{type} //= 'number';
			$self->_log("  CODE: $param is required (used in arithmetic context)");
		} elsif ($code =~ /\$\b$param\b\s*(?:\+0|\*1)/) {
			# Forces numeric context, e.g., "$param + 0" or "$param * 1"
			$$p->{optional} = 0;
			$$p->{type} //= 'number';
			$self->_log("  CODE: $param is required (numeric context)");
		}

		# Required parameter checks (undef causes error)

		# Style 1: block form
		if ($code =~ /if\s*\(\s*!\s*defined\s*\(\s*\$$param\s*\)\s*\)\s*\{([^}]+)\}/s) {
			my $block = $1;
			if ($block =~ /\b(croak|die|confess)\b/) {
				$$p->{optional} = 0;
				$self->_log("  CODE: $param is required (undef causes error)");
			}
		}

		# Style 2: postfix unless
		if ($code =~ /\b(croak|die|confess)\b[^;]*\bunless\s+defined\s*\(\s*\$$param\s*\)/) {
			$$p->{optional} = 0;
			$self->_log("  CODE: $param is required (postfix undef check)");
		}

		# Exists checks for hash keys
		if ($code =~ /exists\s*\(\s*\$$param\s*\)/) {
			$$p->{type} = 'hashkey';
			$self->_log("  CODE: $param is a hash key");
		}

		# Scalar context for arrays
		if ($code =~ /scalar\s*\(\s*\@?\$$param\s*\)/) {
			$$p->{type} = 'array';
			$self->_log("  CODE: $param used in scalar context (array)");
		}

		$self->_extract_error_constraints($p, $param, $code);
	}

	return \%params;
}

# --------------------------------------------------
# _analyze_parameter_type
#
# Purpose:    Infer the type of a single parameter
#             from ref() checks, isa() calls,
#             bless patterns, array/hash operations,
#             and numeric operator usage in the
#             method body.
#
# Entry:      $p_ref - reference to the parameter
#                      hashref (modified in place
#                      via the referenced hash).
#             $param - parameter name string.
#             $code  - method body source string.
#
# Exit:       Returns nothing. Modifies the
#             referenced parameter hashref.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _analyze_parameter_type {
	my ($self, $p_ref, $param, $code) = @_;
	my $p = $$p_ref;

	# Type inference from ref() checks
	if ($code =~ /ref\s*\(\s*\$$param\s*\)\s*eq\s*['"](ARRAY|HASH|SCALAR)['"]/gi) {
		my $reftype = lc($1);
		$p->{type} = $reftype eq 'array' ? 'arrayref' :
					 $reftype eq 'hash' ? 'hashref' :
					 'scalar';
		$self->_log("  CODE: $param is $p->{type} (ref check)");
	}
	# ISA checks for objects
	elsif ($code =~ /\$$param\s*->\s*isa\s*\(\s*['"]([^'"]+)['"]\s*\)/i) {
		$p->{type} = 'object';
		$p->{isa} = $1;
		$self->_log("  CODE: $param is object of class $1");
	}
	# Blessed references
	elsif ($code =~ /bless\s+.*\$$param/) {
		$p->{type} = 'object';
		$self->_log("  CODE: $param is blessed object");
	}
	# Array/hash operations
	if (!$p->{type}) {
		if ($code =~ /\@\{\s*\$$param\s*\}/ || $code =~ /push\s*\(\s*\@?\$$param/) {
			$p->{type} = 'arrayref';
		} elsif ($code =~ /\%\{\s*\$$param\s*\}/ || $code =~ /\$$param\s*->\s*\{/) {
			$p->{type} = 'hashref';
		}
	}

	# Infer type from the default value if type is unknown
	if (!$p->{type} && exists $p->{_default}) {
		my $default = $p->{_default};
		if (ref($default) eq 'HASH') {
			$p->{type} = 'hashref';
			$self->_log("  CODE: $param type inferred as hashref from default");
		} elsif (ref($default) eq 'ARRAY') {
			$p->{type} = 'arrayref';
			$self->_log("  CODE: $param type inferred as arrayref from default");
		}
	}

	# ------------------------------------------------------------
	# Heuristic numeric inference (low confidence)
	# ------------------------------------------------------------
	if (!$p->{type}) {
		# Numeric operators: + - * / % **
		if (
			$code =~ /\$$param\s*[\+\-\*\/%]/ ||
			$code =~ /[\+\-\*\/%]\s*\$$param/ ||
			$code =~ /\bint\s*\(\s*\$$param\s*\)/ ||
			$code =~ /\babs\s*\(\s*\$$param\s*\)/
		) {
			$p->{type} = 'number';
			$p->{_type_confidence} = 'heuristic';
			$self->_log("  CODE: $param inferred as number (numeric operator)");
		}
		# Numeric comparison
		elsif (
			$code =~ /\$$param\s*(?:==|!=|<=|>=|<|>)/ ||
			$code =~ /(?:==|!=|<=|>=|<|>)\s*\$$param/
		) {
			$p->{type} = 'number';
			$p->{_type_confidence} = 'heuristic';
			$self->_log("  CODE: $param inferred as number (numeric comparison)");
		}
	}
}

# --------------------------------------------------
# _analyze_advanced_types
#
# Purpose:    Apply enhanced type detection to a
#             single parameter, checking for
#             DateTime objects, file handles,
#             coderefs, and enum-like constraints
#             beyond what basic type inference
#             can determine.
#
# Entry:      $p_ref - reference to the parameter
#                      hashref (modified in place
#                      via the referenced hash).
#             $param - the parameter name string.
#             $code  - method body source string.
#
# Exit:       Returns nothing. Modifies the
#             referenced parameter hashref in place.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
#
# Notes:      Delegates to four specialised
#             detectors: _detect_datetime_type,
#             _detect_filehandle_type,
#             _detect_coderef_type, and
#             _detect_enum_type. Each detector
#             returns early on first match so
#             detectors are implicitly prioritised
#             in that order.
# --------------------------------------------------
sub _analyze_advanced_types {
	my ($self, $p_ref, $param, $code) = @_;

	# Dereference once to get the hash reference
	my $p = $$p_ref;

	# Now pass the dereferenced hash to the detection methods
	$self->_detect_datetime_type($p, $param, $code);
	$self->_detect_filehandle_type($p, $param, $code);
	$self->_detect_coderef_type($p, $param, $code);
	$self->_detect_enum_type($p, $param, $code);
}

# --------------------------------------------------
# _detect_datetime_type
#
# Purpose:    Detect DateTime objects, Time::Piece
#             objects, date strings, ISO 8601
#             strings, and UNIX timestamps by
#             analysing code patterns involving
#             the parameter.
#
# Entry:      $p     - parameter hashref (modified
#                      in place).
#             $param - parameter name string.
#             $code  - method body source string.
#
# Exit:       Returns nothing. Modifies $p in place,
#             setting type, isa, semantic, min,
#             matches, and/or format keys.
#             Returns immediately on first match.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _detect_datetime_type {
	my ($self, $p, $param, $code) = @_;

	# Validate param is just a simple word
	return unless defined $param && $param =~ /^\w+$/;

	# DateTime object detection via isa/UNIVERSAL checks
	if ($code =~ /\$$param\s*->\s*isa\s*\(\s*['"]DateTime['"]\s*\)/i) {
		$p->{type} = 'object';
		$p->{isa} = 'DateTime';
		$p->{semantic} = 'datetime_object';
		$self->_log("  ADVANCED: $param is DateTime object");
		return;
	}

	# Check for DateTime method calls
	if ($code =~ /\$$param\s*->\s*(ymd|dmy|mdy|hms|iso8601|epoch|strftime)/) {
		$p->{type} = 'object';
		$p->{isa} = 'DateTime';
		$p->{semantic} = 'datetime_object';
		$self->_log("  ADVANCED: $param uses DateTime methods");
		return;
	}

	# Time::Piece detection
	if ($code =~ /\$$param\s*->\s*isa\s*\(\s*['"]Time::Piece['"]\s*\)/i ||
	    $code =~ /\$$param\s*->\s*(strftime|epoch|year|mon|mday)/) {
		$p->{type} = 'object';
		$p->{isa} = 'Time::Piece';
		$p->{semantic} = 'timepiece_object';
		$self->_log("  ADVANCED: $param is Time::Piece object");
		return;
	}

	# String date/time patterns via regex matching
	if ($code =~ /\$$param\s*=~\s*\/.*?\\d\{4\}.*?\\d\{2\}.*?\\d\{2\}/) {
		$p->{type} = 'string';
		$p->{semantic} = 'date_string';
		$p->{format} = 'YYYY-MM-DD or similar';
		$self->_log("  ADVANCED: $param validated as date string pattern");
		return;
	}

	# ISO 8601 date pattern
	if ($code =~ /\$$param\s*=~\s*\/.*?[Tt].*?[Zz].*?\//) {
		$p->{type} = 'string';
		$p->{semantic} = 'iso8601_string';
		$p->{matches} = '/^\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}Z?$/';
		$self->_log("  ADVANCED: $param validated as ISO 8601 datetime");
		return;
	}

	# UNIX timestamp detection (numeric with specific range)
	if ($code =~ /\$$param\s*>\s*\d{9,}/ || # UNIX timestamps are 10+ digits
	    $code =~ /time\(\s*\)\s*-\s*\$$param/ ||
	    $code =~ /\$$param\s*-\s*time\(\s*\)/) {
		$p->{type} = 'integer';
		$p->{semantic} = 'unix_timestamp';
		$p->{min} = 0;
		$self->_log("  ADVANCED: $param appears to be UNIX timestamp");
		return;
	}

	# Date parsing with strptime or similar
	if ($code =~ /strptime\s*\(\s*\$$param/ ||
	    $code =~ /DateTime::Format::\w+\s*->\s*parse_datetime\s*\(\s*\$$param/) {
		$p->{type} = 'string';
		$p->{semantic} = 'datetime_parseable';
		$self->_log("  ADVANCED: $param is parsed as datetime");
		return;
	}
}

# --------------------------------------------------
# _detect_filehandle_type
#
# Purpose:    Detect file handle parameters and
#             file path string parameters by
#             analysing I/O operations, file test
#             operators, and path manipulation
#             patterns involving the parameter.
#
# Entry:      $p     - parameter hashref (modified
#                      in place).
#             $param - parameter name string.
#             $code  - method body source string.
#
# Exit:       Returns nothing. Modifies $p in place,
#             setting type, isa, and semantic keys.
#             Returns immediately on first match.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _detect_filehandle_type {
	my ($self, $p, $param, $code) = @_;

	return unless defined $param && $param =~ /^\w+$/;

	# File handle operations
	if ($code =~ /(?:open|close|read|print|say|sysread|syswrite)\s*\(?\s*\$$param/) {
		$p->{type} = 'object';
		$p->{isa} = 'IO::Handle';
		$p->{semantic} = 'filehandle';
		$self->_log("  ADVANCED: $param is a file handle");
		return;
	}

	# Filehandle-specific operations
	if ($code =~ /\$$param\s*->\s*(readline|getline|print|say|close|flush|autoflush)/) {
		$p->{type} = 'object';
		$p->{isa} = 'IO::Handle';
		$p->{semantic} = 'filehandle';
		$self->_log("  ADVANCED: $param uses filehandle methods");
		return;
	}

	# File test operators
	if ($code =~ /(?:-[frwxoOeszlpSbctugkTBMAC])\s+\$$param/) {
		$p->{type} = 'string';
		$p->{semantic} = 'filepath';
		$self->_log("  ADVANCED: $param is tested as file path");
		return;
	}

	# File::Spec operations or path manipulation
	if ($code =~ /File::(?:Spec|Basename)::\w+\s*\(\s*\$$param/ ||
	    $code =~ /(?:basename|dirname|fileparse)\s*\(\s*\$$param/) {
		$p->{type} = 'string';
		$p->{semantic} = 'filepath';
		$self->_log("  ADVANCED: $param manipulated as file path");
		return;
	}

	# Path validation patterns
	# Only match a literal path assigned or defaulted to this variable
	if(defined $p->{_default} && $p->{_default} =~ m{^([A-Za-z]:\\|/|\./|\.\./)}) {
		$p->{type} = 'string';
		$p->{semantic} = 'filepath';
		$self->_log("  ADVANCED: $param default looks like a path");
		return;
	}

	# IO::File detection
	if ($code =~ /\$$param\s*->\s*isa\s*\(\s*['"]IO::File['"]\s*\)/ ||
	    $code =~ /IO::File\s*->\s*new\s*\(\s*\$$param/) {
		$p->{type} = 'object';
		$p->{isa} = 'IO::File';
		$p->{semantic} = 'filehandle';
		$self->_log("  ADVANCED: $param is IO::File object");
		return;
	}
}

# --------------------------------------------------
# _detect_coderef_type
#
# Purpose:    Detect coderef and callback parameters
#             by analysing ref() checks, invocation
#             patterns, and parameter naming
#             conventions.
#
# Entry:      $p     - parameter hashref (modified
#                      in place).
#             $param - parameter name string.
#             $code  - method body source string.
#
# Exit:       Returns nothing. Modifies $p in place,
#             setting type and semantic keys.
#             Returns immediately on first match.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _detect_coderef_type {
	my ($self, $p, $param, $code) = @_;

	return unless defined $param && $param =~ /^\w+$/;

	# ref() check for CODE
	if ($code =~ /ref\s*\(\s*\$$param\s*\)\s*eq\s*['"]CODE['"]/i) {
		$p->{type} = 'coderef';
		$p->{semantic} = 'callback';
		$self->_log("  ADVANCED: $param is coderef (ref check)");
		return;
	}

	# Invocation as coderef - note the escaped @ in \@_
	if ($code =~ /\$$param\s*->\s*\(/ ||
	    $code =~ /\$$param\s*->\s*\(\s*\@_\s*\)/ ||
	    $code =~ /&\s*\{\s*\$$param\s*\}/) {
		$p->{type} = 'coderef';
		$p->{semantic} = 'callback';
		$self->_log("  ADVANCED: $param invoked as coderef");
		return;
	}

	# Parameter name suggests callback
	if ($param =~ /^(?:callback|cb|handler|sub|code|fn|func|on_\w+)$/i) {
		$p->{type} = 'coderef';
		$p->{semantic} = 'callback';
		$self->_log("  ADVANCED: $param name suggests coderef");
		return;
	}

	# Blessed coderef (unusual but valid)
	if ($code =~ /blessed\s*\(\s*\$$param\s*\)/ &&
	    $code =~ /ref\s*\(\s*\$$param\s*\)\s*eq\s*['"]CODE['"]/i) {
		$p->{type} = 'object';
		$p->{isa} = 'blessed_coderef';
		$p->{semantic} = 'callback';
		$self->_log("  ADVANCED: $param is blessed coderef");
		return;
	}
}

# --------------------------------------------------
# _detect_enum_type
#
# Purpose:    Detect enum-like parameters whose
#             valid values are a fixed set, by
#             analysing validation patterns
#             including regex alternations, hash
#             lookups, grep checks, given/when,
#             if/elsif chains, and smart match.
#
# Entry:      $p     - parameter hashref (modified
#                      in place).
#             $param - parameter name string.
#             $code  - method body source string.
#
# Exit:       Returns nothing. Modifies $p in place,
#             setting type, enum, and semantic keys.
#             Returns immediately on first match.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
#
# Notes:      Requires at least 3 if/elsif branches
#             for pattern 5 to avoid false positives
#             from ordinary conditional code.
# --------------------------------------------------
sub _detect_enum_type {
	my ($self, $p, $param, $code) = @_;

	return unless defined $param && $param =~ /^\w+$/;

	# Pattern 1: die/croak unless value is in list
	# die 'Invalid status' unless $status =~ /^(active|inactive|pending)$/;
	if ($code =~ /unless\s+\$$param\s*=~\s*\/\^?\(([^)]+)\)/) {
		my $values = $1;
		my @enum_values = split(/\|/, $values);
		$p->{type} = 'string' unless $p->{type};
		$p->{enum} = \@enum_values;
		$p->{semantic} = 'enum';
		$self->_log("  ADVANCED: $param is enum with values: " . join(', ', @enum_values));
		return;
	}

	# Pattern 2: Hash lookup for validation
	# my %valid = map { $_ => 1 } qw(red green blue);
	# die unless $valid{$param};
	if ($code =~ /\%(\w+)\s*=.*?qw\s*[\(\[<{]([^)\]>}]+)[\)\]>}]/) {
		my $hash_name = $1;
		my $values_str = $2;
		if (defined $values_str && $code =~ /\$$hash_name\s*\{\s*\$$param\s*\}/) {
			my @enum_values = split(/\s+/, $values_str);
			$p->{type} = 'string' unless $p->{type};
			$p->{enum} = \@enum_values;
			$p->{semantic} = 'enum';
			$self->_log("  ADVANCED: $param validated via hash lookup: " . join(', ', @enum_values));
			return;
		}
	}

	# Pattern 3: Array grep validation
	# die unless grep { $_ eq $param } qw(foo bar baz);
	if ($code =~ /grep\s*\{[^}]*\$$param[^}]*\}\s*qw\s*[\(\[<{]([^)\]>}]+)[\)\]>}]/) {
		my $values_str = $1;
		my @enum_values = split(/\s+/, $values_str);
		$p->{type} = 'string' unless $p->{type};
		$p->{enum} = \@enum_values;
		$p->{semantic} = 'enum';
		$self->_log("  ADVANCED: $param validated via grep: " . join(', ', @enum_values));
		return;
	}

	# Pattern 4: Given/when (Perl 5.10+)
	if ($code =~ /given\s*\(\s*\$$param\s*\)/) {
		my @enum_values;
		while ($code =~ /when\s*\(\s*['"]([^'"]+)['"]\s*\)/g) {
			push @enum_values, $1;
		}
		if (@enum_values >= 2) {
			$p->{type} = 'string' unless $p->{type};
			$p->{enum} = \@enum_values;
			$p->{semantic} = 'enum';
			$self->_log("  ADVANCED: $param has enum values from given/when: " .
			           join(', ', @enum_values));
			return;
		}
	}

	# Pattern 5: Multiple if/elsif checking specific values
	my @if_values;
	while ($code =~ /if\s*\(\s*\$$param\s*eq\s*['"]([^'"]+)['"]\s*\)/g) {
		push @if_values, $1;
	}
	while ($code =~ /elsif\s*\(\s*\$$param\s*eq\s*['"]([^'"]+)['"]\s*\)/g) {
		push @if_values, $1;
	}
	if (@if_values >= 3) {
		$p->{type} = 'string' unless $p->{type};
		$p->{enum} = \@if_values;
		$p->{semantic} = 'enum';
		$self->_log("  ADVANCED: $param appears to be enum from if/elsif: " .
		           join(', ', @if_values));
		return;
	}

	# Pattern 6: Smart match (~~) with array
	if ($code =~ /\$$param\s*~~\s*\[([^\]]+)\]/ ||
	    $code =~ /\$$param\s*~~\s*qw\s*[\(\[<{]([^)\]>}]+)[\)\]>}]/) {
		my $values_str = $1;
		my @enum_values;
		if ($values_str =~ /['"]/) {
			@enum_values = $values_str =~ /['"](.*?)['"]/g;
		} else {
			@enum_values = split(/\s+/, $values_str);
		}
		if (@enum_values) {
			$p->{type} = 'string' unless $p->{type};
			$p->{enum} = \@enum_values;
			$p->{semantic} = 'enum';
			$self->_log("  ADVANCED: $param validated with smart match: " .
				   join(', ', @enum_values));
			return;
		}
	}
}

# --------------------------------------------------
# _extract_error_constraints
#
# Purpose:    Extract invalid-value constraints and
#             error messages from die/croak patterns
#             referencing a specific parameter, and
#             infer numeric bounds from comparisons
#             with literals.
#
# Entry:      $p_ref - reference to the parameter
#                      hashref (modified in place).
#             $param - parameter name string.
#             $code  - method body source string.
#
# Exit:       Returns nothing. May add _invalid,
#             _errors, min, and/or max to the
#             referenced parameter hashref.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _extract_error_constraints {
	my ($self, $p, $param, $code) = @_;

	# Look for die/croak/confess with a condition involving this param
	while ($code =~ /
		(?:die|croak|confess)       # error call
		\s*
		(?:
			["']([^"']+)["']        # captured error message
		|
			q[qw]?\s*[\(\[]([^)\]]+)[\)\]]  # q(), qq(), qw()
		)?
		\s*
		if\s+
		(.+?)                      # condition
		\s*;
	/gsx) {

		my $message = $1 || $2;
		my $condition = $3;

		# Only keep conditions that reference this parameter
		next unless $condition =~ /\$$param\b/;

		# Initialize storage
		$$p->{_invalid} ||= [];
		$$p->{_errors}  ||= [];

		# Normalize condition (strip surrounding parens)
		$condition =~ s/^\(|\)$//g;
		$condition =~ s/\s+/ /g;

		# Try to extract a meaningful invalid constraint
		my $constraint;

		# Examples:
		#   $age <= 0
		#   $x eq ''
		#   length($s) < 3
		if ($condition =~ /\$$param\s*([!<>=]=?|eq|ne|lt|gt|le|ge)\s*(.+)/) {
			$constraint = "$1 $2";
		}
		elsif ($condition =~ /length\s*\(\s*\$$param\s*\)\s*([<>=!]+)\s*(\d+)/) {
			$constraint = "length $1 $2";
		}
		elsif ($condition =~ /\$$param\s*==\s*0/) {
			$constraint = '== 0';
		}

		# Store results
		push @{ $$p->{_invalid} }, $constraint if $constraint;
		push @{ $$p->{_errors}  }, $message if defined $message;

		$self->_log(
			"  ERROR: $param invalid when [$condition]" .
			(defined $message ? " => '$message'" : '')
		);
	}

	# Numeric comparison with literal
	if ($code =~ /\b\Q$param\E\s*(<=|<|>=|>)\s*(-?\d+)/) {
		my ($op, $num) = ($1, $2);

		# Mark required
		$$p->{optional} = 0;

		if ($op eq '<=') {
			$$p->{min} = $num + 1;
		} elsif ($op eq '<') {
			$$p->{min} = $num;
		} elsif ($op eq '>=') {
			$$p->{max} = $num - 1;
		} elsif ($op eq '>') {
			$$p->{max} = $num;
		}

		$self->_log("  ERROR: $param normalized constraint from '$op $num'");
	}
}

# --------------------------------------------------
# _extract_parameters_from_signature
#
# Purpose:    Extract parameter names and positions
#             from a method's signature, trying
#             modern Perl subroutine signatures
#             first and falling back to traditional
#             @_ extraction styles.
#
# Entry:      $params - hashref to populate with
#                       parameter specs (modified
#                       in place).
#             $code   - method body source string.
#
# Exit:       Returns nothing. Populates $params.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
#
# Notes:      Three traditional styles are
#             supported: (1) my ($self, ...) = @_,
#             (2) my $self = shift; my $x = shift,
#             (3) my $x = $_[N]. $self and $class
#             are always excluded from the returned
#             parameters.
# --------------------------------------------------
sub _extract_parameters_from_signature {
	my ($self, $params, $code) = @_;

	# Modern Style: Subroutine signatures with attributes
	# Handle multi-line signatures
	# sub foo :attr1 :attr2(val) (
	#     $self,
	#     $x :Type,
	#     $y = default
	# ) { }

	# Try to match signature after attributes
	# Look for the parameter list - it's the last (...) before the opening brace
	# that contains sigils ($, %, @)
	if ($code =~ /sub\s+\w+\s*(?::\w+(?:\([^)]*\))?\s*)*\(((?:[^()]|\([^)]*\))*)\)\s*\{/s) {
		my $potential_sig = $1;

		# Check if this looks like parameters (has sigils)
		if ($potential_sig =~ /[\$\%\@]/) {
			$self->_log("  SIG: Found modern signature: ($potential_sig)");
			$self->_parse_modern_signature($params, $potential_sig);
			return;
		}
	}

	# Traditional Style 1: my ($self, $arg1, $arg2) = @_;
	if ($code =~ /my\s*\(\s*([^)]+)\)\s*=\s*\@_/s) {
		my $sig = $1;
		my $pos = 0;

		while ($sig =~ /\$(\w+)/g) {
			my $name = $1;

			next if $name =~ /^(self|class)$/i;

			$params->{$name} //= {
				_source => 'code',
				optional => 1,
			};

			$params->{$name}{position} = $pos unless exists $params->{$name}{position};

			$pos++;
		}
		return;
	} elsif ($code =~ /my\s+\$self\s*=\s*shift/) {
		# Traditional Style 2: my $self = shift; my $arg1 = shift;
		my @shifts;
		while ($code =~ /my\s+\$(\w+)\s*=\s*shift/g) {
			push @shifts, $1;
		}
		shift @shifts if @shifts && $shifts[0] =~ /^(self|class)$/i;
		my $pos = 0;
		foreach my $param (@shifts) {
			$params->{$param} ||= { _source => 'code', optional => 1, position => $pos++ };
		}
		return;
	}

	# Traditional Style 3: Function parameters (no $self)
	if ($code =~ /my\s*\(\s*([^)]+)\)\s*=\s*\@_/s) {
		my $sig = $1;
		my @param_names = $sig =~ /\$(\w+)/g;
		my $pos = 0;
		foreach my $param (@param_names) {
			next if $param =~ /^(self|class)$/i;
			$params->{$param} ||= { _source => 'code', optional => 1, position => $pos++ };
		}
	}

	# De-duplicate
	my %seen;
	foreach my $param (keys %$params) {
		if ($seen{$param}++) {
			$self->_log("  WARNING: Duplicate parameter '$param' found");
		}
	}
}

# --------------------------------------------------
# _parse_modern_signature
#
# Purpose:    Parse a Perl 5.20+ subroutine
#             signature string into individual
#             parameter specs, respecting nested
#             structures when splitting on commas.
#
# Entry:      $params - hashref to populate
#                       (modified in place).
#             $sig    - signature string with outer
#                       parentheses already removed.
#
# Exit:       Returns nothing. Populates $params
#             via _parse_signature_parameter.
#
# Side effects: Logs parsing details to stdout when
#               verbose is set.
# --------------------------------------------------
sub _parse_modern_signature {
	my ($self, $params, $sig) = @_;

	$self->_log("  DEBUG: Parsing signature: [$sig]");

	# Split signature by commas, but respect nested structures
	my @parts;
	my $current = '';
	my $depth = 0;

	for my $char (split //, $sig) {
		if ($char eq '(' || $char eq '[' || $char eq '{') {
			$depth++;
			$current .= $char;
		} elsif ($char eq ')' || $char eq ']' || $char eq '}') {
			$depth--;
			$current .= $char;
		} elsif ($char eq ',' && $depth == 0) {
			push @parts, $current;
			$current = '';
		} else {
			$current .= $char;
		}
	}
	push @parts, $current if $current =~ /\S/;

	my $position = 0;

	foreach my $part (@parts) {
		$part =~ s/^\s+|\s+$//g;

		# Skip empty parts
		next unless $part;

		# Parse different parameter types
		my $param_info = $self->_parse_signature_parameter($part, $position);

		if ($param_info) {
			my $name = $param_info->{name};

			# Skip self/class
			if ($name =~ /^(self|class)$/i) {
				next;
			}

			$params->{$name} = $param_info;
			$self->_log("  SIG: $name has position $position" .
				($param_info->{optional} ? ' (optional)' : '') .
				($param_info->{_default} ? ", default: $param_info->{_default}" : ''));
			$position++;
		}
	}
}

# --------------------------------------------------
# _parse_signature_parameter
#
# Purpose:    Parse a single parameter declaration
#             from a modern Perl signature, handling
#             type constraints, default values,
#             plain scalars, and slurpy array/hash
#             parameters.
#
# Entry:      $part     - a single parameter string
#                         (one comma-separated
#                         element from the signature).
#             $position - zero-based position index
#                         of this parameter.
#
# Exit:       Returns a parameter info hashref on
#             success, or undef if the string does
#             not match any known pattern.
#
# Side effects: None.
#
# Notes:      Six patterns are tried in order:
#             (1) :Type with default,
#             (2) :Type without default,
#             (3) default without type,
#             (4) plain $name,
#             (5) slurpy @name,
#             (6) slurpy %name.
# --------------------------------------------------
sub _parse_signature_parameter {
	my ($self, $part, $position) = @_;

	my %info = (
		_source => 'signature',
		position => $position,
		optional => 0,
	);

	# Pattern 1: Type constraint WITH default: $name :Type = default
	if ($part =~ /^\$(\w+)\s*:\s*(\w+)\s*=\s*(.+)$/s) {
		my ($name, $constraint, $default) = ($1, $2, $3);
		$default =~ s/^\s+|\s+$//g;

		$info{name} = $name;
		$info{optional} = 1;
		$info{_default} = $self->_clean_default_value($default, 1);

		# Apply type constraint
		if ($constraint =~ /^(Int|Integer)$/i) {
			$info{type} = 'integer';
		} elsif ($constraint =~ /^(Num|Number)$/i) {
			$info{type} = 'number';
		} elsif ($constraint =~ /^(Str|String)$/i) {
			$info{type} = 'string';
		} elsif ($constraint =~ /^(Bool|Boolean)$/i) {
			$info{type} = 'boolean';
		} elsif ($constraint =~ /^(Array|ArrayRef)$/i) {
			$info{type} = 'arrayref';
		} elsif ($constraint =~ /^(Hash|HashRef)$/i) {
			$info{type} = 'hashref';
		} else {
			$info{type} = 'object';
			$info{isa} = $constraint;
		}

		return \%info;
	} elsif ($part =~ /^\$(\w+)\s*:\s*(\w+)\s*$/s) {
		# Pattern 2: Type constraint WITHOUT default: $name :Type
		my ($name, $constraint) = ($1, $2);
		$info{name} = $name;
		$info{optional} = 0;

		# Apply type constraint (same as above)
		if ($constraint =~ /^(Int|Integer)$/i) {
			$info{type} = 'integer';
		} elsif ($constraint =~ /^(Num|Number)$/i) {
			$info{type} = 'number';
		} elsif ($constraint =~ /^(Str|String)$/i) {
			$info{type} = 'string';
		} elsif ($constraint =~ /^(Bool|Boolean)$/i) {
			$info{type} = 'boolean';
		} elsif ($constraint =~ /^(Array|ArrayRef)$/i) {
			$info{type} = 'arrayref';
		} elsif ($constraint =~ /^(Hash|HashRef)$/i) {
			$info{type} = 'hashref';
		} else {
			$info{type} = 'object';
			$info{isa} = $constraint;
		}

		return \%info;
	} elsif ($part =~ /^\$(\w+)\s*=\s*(.+)$/s) {
		# Pattern 3: Default WITHOUT type: $name = default
		my ($name, $default) = ($1, $2);
		$default =~ s/^\s+|\s+$//g;

	$info{name} = $name;
	$info{optional} = 1;
	$info{_default} = $self->_clean_default_value($default, 1);
	$info{type} = $self->_infer_type_from_default($info{_default}) if $self->can('_infer_type_from_default');

	return \%info;
	}

    # Pattern 4: Plain parameter: $name
    elsif ($part =~ /^\$(\w+)$/s) {
        $info{name} = $1;
        $info{optional} = 0;
        return \%info;
    }

    # Pattern 5: Array parameter: @name
    elsif ($part =~ /^\@(\w+)$/s) {
        $info{name} = $1;
        $info{type} = 'array';
        $info{slurpy} = 1;
        $info{optional} = 1;
        return \%info;
    }

    # Pattern 6: Hash parameter: %name
    elsif ($part =~ /^\%(\w+)$/s) {
        $info{name} = $1;
        $info{type} = 'hash';
        $info{slurpy} = 1;
        $info{optional} = 1;
        return \%info;
    }

	return undef;
}

# --------------------------------------------------
# _infer_type_from_default
#
# Purpose:    Infer a parameter type from its
#             default value when no explicit type
#             annotation is available.
#
# Entry:      $default - the cleaned default value
#                        scalar, hashref, or
#                        arrayref. May be undef.
#
# Exit:       Returns a type string ('hashref',
#             'arrayref', 'integer', 'number',
#             'boolean', 'string'), or undef if
#             $default is undef.
#
# Side effects: None.
# --------------------------------------------------
sub _infer_type_from_default {
	my ($self, $default) = @_;

	return undef unless defined $default;

	if (ref($default) eq 'HASH') {
		return 'hashref';
	} elsif (ref($default) eq 'ARRAY') {
		return 'arrayref';
	} elsif ($default =~ /^-?\d+$/) {
		return 'integer';
	} elsif ($default =~ /^-?\d+\.\d+$/) {
		return 'number';
	} elsif ($default eq '1' || $default eq '0') {
		return 'boolean';
	} else {
		return 'string';
	}
}

# --------------------------------------------------
# _extract_subroutine_attributes
#
# Purpose:    Extract Perl subroutine attributes
#             (e.g. :lvalue, :method, :Returns(Int))
#             from a method's source string.
#
# Entry:      $code - method body source string.
#
# Exit:       Returns a hashref of attribute name
#             to value (1 for flag-only attributes,
#             the attribute argument string for
#             attributes with values).
#             Returns an empty hashref if no
#             attributes are found.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _extract_subroutine_attributes {
	my ($self, $code) = @_;

	my %attributes;

	# Extract all attributes from the sub declaration
	# Attributes are :name or :name(value) between sub name and either ( or {
	# Pattern: sub name ATTRIBUTES ( params ) { }
	# or:      sub name ATTRIBUTES { }

	# First, find the attributes section (everything between sub name and ( or { )
	my $attr_section = '';

	if($code =~ /sub\s+\w+\s+((?::\w+(?:\([^)]*\))?\s*)+)/s) {
		$attr_section = $1;
	}

	# Parse individual attributes from the section
	if($attr_section) {
		while($attr_section =~ /:(\w+)(?:\(([^)]*)\))?/g) {
			my ($name, $value) = ($1, $2);

			if (defined $value && $value ne '') {
				$attributes{$name} = $value;
				$self->_log("  ATTR: Found attribute :$name($value)");
			} else {
				$attributes{$name} = 1;
				$self->_log("  ATTR: Found attribute :$name");
			}
		}
	}

	# Process common attributes
	if ($attributes{Returns}) {
		my $return_type = $attributes{Returns};
		if ($return_type ne '1') {  # Only log if it's an actual type, not just the flag
			$self->_log("  ATTR: Method declares return type: $return_type");
		}
	}

	if ($attributes{lvalue}) {
		$self->_log("  ATTR: Method is lvalue (can be assigned to)");
	}

	if ($attributes{method}) {
		$self->_log('  ATTR: Method explicitly marked as :method');
	}

	return \%attributes;
}

# --------------------------------------------------
# _analyze_postfix_dereferencing
#
# Purpose:    Detect usage of Perl 5.20+ postfix
#             dereferencing syntax in a method body
#             and record which dereference forms
#             are used.
#
# Entry:      $code - method body source string.
#
# Exit:       Returns a hashref whose keys are
#             dereference form names (array_deref,
#             hash_deref, scalar_deref, code_deref,
#             array_slice, hash_slice) with value 1
#             when detected.
#             Returns an empty hashref if no
#             postfix dereferencing is found.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _analyze_postfix_dereferencing {
	my ($self, $code) = @_;

	my %derefs;

	# Array dereference: $ref->@*
	if ($code =~ /\$\w+\s*->\s*\@\*/) {
		$derefs{array_deref} = 1;
		$self->_log("  MODERN: Uses postfix array dereferencing (->@*)");
	}

	# Hash dereference: $ref->%*
	if ($code =~ /\$\w+\s*->\s*\%\*/) {
		$derefs{hash_deref} = 1;
		$self->_log("  MODERN: Uses postfix hash dereferencing (->%*)");
	}

	# Scalar dereference: $ref->$*
	if ($code =~ /\$\w+\s*->\s*\$\*/) {
		$derefs{scalar_deref} = 1;
		$self->_log('  MODERN: Uses postfix scalar dereferencing (->$*)');
	}

	# Code dereference: $ref->&*
	if ($code =~ /\$\w+\s*->\s*\&\*/) {
		$derefs{code_deref} = 1;
		$self->_log("  MODERN: Uses postfix code dereferencing (->&*)");
	}

	# Array element: $ref->@[0,2,4]
	if ($code =~ /\$\w+\s*->\s*\@\[/) {
		$derefs{array_slice} = 1;
		$self->_log("  MODERN: Uses postfix array slice (->@[...])");
	}

	# Hash element: $ref->%{key1,key2}
	if ($code =~ /\$\w+\s*->\s*\%\{/) {
		$derefs{hash_slice} = 1;
		$self->_log("  MODERN: Uses postfix hash slice (->%{...})");
	}

	return \%derefs;
}

# --------------------------------------------------
# _extract_field_declarations
#
# Purpose:    Extract Perl 5.38 field declarations
#             from a class body or method source
#             string, capturing field names,
#             :param attributes, default values,
#             and :isa type constraints.
#
# Entry:      $code - source string potentially
#                     containing 'field $name ...'
#                     declarations.
#
# Exit:       Returns a hashref of field name to
#             field_info hashref. Returns an empty
#             hashref if no field declarations
#             are found.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _extract_field_declarations {
	my ($self, $code) = @_;

	my %fields;

	# Pattern: field $name :param;
	# Pattern: field $name :param(name);
	# Pattern: field $name = default;
	# More lenient pattern to catch various formats
	while ($code =~ /^\s*field\s+\$(\w+)\s*([^;]*);/gm) {
		my ($name, $modifiers) = ($1, $2);

		$self->_log("  FIELD: Found field \$$name with modifiers: [$modifiers]");

		my %field_info = (
			name => $name,
			_source => 'field'
		);

		# Check for :param attribute
		if ($modifiers =~ /:param(?:\(([^)]+)\))?/) {
			$field_info{is_param} = 1;

			if (defined $1) {
				# Explicit parameter name
				$field_info{param_name} = $1;
			} else {
				# Implicit - field name is param name
				$field_info{param_name} = $name;
			}

			$self->_log("  FIELD: $name maps to parameter: $field_info{param_name}");
		}

        # Check for default value - must come before type constraint check
	if ($modifiers =~ /=\s*([^:;]+)(?::|;|$)/) {
		my $default = $1;
		$default =~ s/\s+$//;
		$field_info{_default} = $self->_clean_default_value($default, 1);
		$field_info{optional} = 1;
		$self->_log("  FIELD: $name has default: " . (defined $field_info{_default} ? $field_info{_default} : 'undef'));
	}

	# Check for type constraints
	if ($modifiers =~ /:isa\(([^)]+)\)/) {
	    $field_info{isa} = $1;
	    $field_info{type} = 'object';
	    $self->_log("  FIELD: $name has type constraint: $1");
	}

		$fields{$name} = \%field_info;
	}

	return \%fields;
}

# --------------------------------------------------
# _merge_field_declarations
#
# Purpose:    Integrate Perl 5.38 field declarations
#             that carry the :param attribute into
#             the code parameter hashref, so they
#             appear as constructor parameters in
#             the generated schema.
#
# Entry:      $params - hashref of parameters
#                       extracted from code analysis
#                       (modified in place).
#             $fields - hashref of field declarations
#                       as returned by
#                       _extract_field_declarations.
#
# Exit:       Returns nothing. Modifies $params
#             in place.
#
# Side effects: Logs merges to stdout when verbose
#               is set.
#
# Notes:      Only fields with is_param => 1 are
#             merged. The param_name key in the
#             field (which may differ from the
#             field name if :param(name) was used)
#             determines the parameter key.
# --------------------------------------------------
sub _merge_field_declarations {
	my ($self, $params, $fields) = @_;

	foreach my $field_name (keys %$fields) {
		my $field = $fields->{$field_name};

		# Only process fields that are parameters
		next unless $field->{is_param};

		my $param_name = $field->{param_name};

		# Create or update parameter info
		$params->{$param_name} ||= {};
		my $p = $params->{$param_name};

		# Merge field information into parameter
		$p->{_source} = 'field' unless $p->{_source};
		$p->{field_name} = $field_name if $field_name ne $param_name;

		if ($field->{_default}) {
			$p->{_default} = $field->{_default};
			$p->{optional} = 1;
		}

		if ($field->{isa}) {
			$p->{isa} = $field->{isa};
			$p->{type} = 'object';
		}

		$self->_log("  MERGED: Field $field_name -> parameter $param_name");
	}
}

# --------------------------------------------------
# _extract_defaults_from_code
#
# Purpose:    Scan a method body for default value
#             assignment patterns and populate the
#             optional and _default fields of
#             known parameters.
#
# Entry:      $params - hashref of parameters
#                       (modified in place).
#             $code   - method body source string.
#             $method - method hashref, used for
#                       constructor-specific
#                       exclusions of $class and
#                       $self.
#
# Exit:       Returns nothing. Modifies $params
#             in place.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
#
# Notes:      Eight default patterns are tried.
#             Only parameters already present in
#             $params are updated — this method
#             does not add new parameters.
#             Falls back to extracting all @_
#             assignments if $params is empty
#             after the main pass.
# --------------------------------------------------
sub _extract_defaults_from_code {
	my ($self, $params, $code, $method) = @_;

	# Pattern 1: my $param = value;
	while ($code =~ /my\s+\$(\w+)\s*=\s*([^;]+);/g) {
		my ($param, $value) = ($1, $2);
		next unless exists $params->{$param};

		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
		$params->{$param}{optional} = 1;
		$self->_log("  CODE: $param has default: " . $self->_format_default($params->{$param}{_default}));
	}

	# Pattern 2: $param = value unless defined $param;
	while ($code =~ /\$(\w+)\s*=\s*([^;]+?)\s+unless\s+(?:defined\s+)?\$\1/g) {
		my ($param, $value) = ($1, $2);
		next unless exists $params->{$param};

		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
		$params->{$param}{optional} = 1;
		$self->_log("  CODE: $param has default (unless): " . $self->_format_default($params->{$param}{_default}));
	}

	# Pattern 3: $param = value unless $param;
	while ($code =~ /\$(\w+)\s*=\s*([^;]+?)\s+unless\s+\$\1/g) {
		my ($param, $value) = ($1, $2);
		next unless exists $params->{$param};

		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
		$params->{$param}{optional} = 1;
		$self->_log("  CODE: $param has default (unless): " . $self->_format_default($params->{$param}{_default}));
	}

	# Pattern 4: $param = $param || 'default';
	while ($code =~ /\$(\w+)\s*=\s*\$\1\s*\|\|\s*([^;]+);/g) {
		my ($param, $value) = ($1, $2);
		next unless exists $params->{$param};

		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
		$params->{$param}{optional} = 1;
		$self->_log("  CODE: $param has default (||): " . $self->_format_default($params->{$param}{_default}));
	}

	# Pattern 5: $param ||= 'default';
	while ($code =~ /\$(\w+)\s*\|\|=\s*([^;]+);/g) {
		my ($param, $value) = ($1, $2);
		next unless exists $params->{$param};

		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
		$params->{$param}{optional} = 1;
		$self->_log("  CODE: $param has default (||=): " . $self->_format_default($params->{$param}{_default}));
	}

	# Pattern 6: $param //= 'default';
	while ($code =~ /\$(\w+)\s*\/\/=\s*([^;]+);/g) {
		my ($param, $value) = ($1, $2);
		next unless exists $params->{$param};  # Using -> because $params is a reference

		$params->{$param}{_default} = $self->_clean_default_value($value, 1);

		$params->{$param}{optional} = 1;
		$self->_log("  CODE: $param has default (//=): " . $self->_format_default($params->{$param}{_default}));
	}

	# Pattern 7: $param = defined $param ? $param : 'default';
	while ($code =~ /\$(\w+)\s*=\s*defined\s+\$\1\s*\?\s*\$\1\s*:\s*([^;]+);/g) {
		my ($param, $value) = ($1, $2);

		# Create param entry if it doesn't exist
		$params->{$param} ||= {};

		my $cleaned = $self->_clean_default_value($value, 1);

		$params->{$param}{_default} = $cleaned;
		$params->{$param}{optional} = 1;
		$self->_log("  CODE: $param has default (ternary): " . $self->_format_default($params->{$param}{_default}));
	}

	# Pattern 8: $param = $args{param} || 'default';
	while ($code =~ /\$(\w+)\s*=\s*\$args\{['"]?\w+['"]?\}\s*\|\|\s*([^;]+);/g) {
		my ($param, $value) = ($1, $2);
		next unless exists $params->{$param};

		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
		$params->{$param}{optional} = 1;
		$self->_log("  CODE: $param has default (from args): " . $self->_format_default($params->{$param}{_default}));
	}

	# Pattern for non-empty hashref
	while ($code =~ /\$(\w+)\s*\|\|=\s*\{[^}]+\}/gs) {
		my $param = $1;
		next unless exists $params->{$param};

		# Return empty hashref as placeholder (can't evaluate complex hashrefs)
		$params->{$param}{_default} = {};
		$params->{$param}{optional} = 1;
		$self->_log("  CODE: $param has hashref default (||=)");
	}

	# Fallback: extract parameters from classic Perl body styles
	# Only run if signature extraction found nothing
	# TODO:  On constructors, use $class to help to determine the output type
	if (!keys %{$params}) {
		my $position = 0;

		# Style 1: my ($a, $b) = @_;
		while ($code =~ /my\s*\(\s*([^)]+)\s*\)\s*=\s*\@_/g) {
			my @vars = $1 =~ /\$(\w+)/g;
			foreach my $var (@vars) {
				if(($var eq 'class') && ($position == 0) && ($method->{name} eq 'new')) {
					# Don't include "class" in the variable names of the constructor
					delete $params->{'class'};
				} elsif(($var eq 'self') && ($position == 0) && ($method->{name} ne 'new')) {
					# Don't include "self" in the variable names
					delete $params->{'self'};
				} else {
					$params->{$var} ||= { position => $position++ };
					$self->_log("  CODE: $var extracted from \@_ list assignment");
				}
			}
		}

		# Style 2: my $x = shift;
		while ($code =~ /my\s+\$(\w+)\s*=\s*shift\b/g) {
			my $var = $1;
			if(($var eq 'class') && ($position == 0) && ($method->{name} eq 'new')) {
				# Don't include "class" in the variable names of the constructor
				delete $params->{'class'};
			} elsif(($var eq 'self') && ($position == 0) && ($method->{name} ne 'new')) {
				# Don't include "self" in the variable names
				delete $params->{'self'};
			} else {
				$params->{$var} ||= { position => $position++ };
				$self->_log("  CODE: $var is extracted from shift");
			}
		}

		# Style 3: my $x = $_[0];
		while ($code =~ /my\s+\$(\w+)\s*=\s*\$_\[(\d+)\]/g) {
			my ($var, $index) = ($1, $2);
			if(($var ne 'class') || ($position > 0) || ($method->{name} ne 'new')) {
				$params->{$var} ||= { position => $index };
				$self->_log("  CODE: $var is extracted from \$_\[$index\]");
			}
		}
	}
}

# --------------------------------------------------
# _format_default
#
# Purpose:    Format a default value for display
#             in verbose log output.
#
# Entry:      $default - the default value to
#                        format. May be undef,
#                        a scalar, a hashref, or
#                        an arrayref.
#
# Exit:       Returns a display string: 'undef'
#             for undef, 'HASH ref' / 'ARRAY ref'
#             for references, or the value itself
#             for scalars.
#
# Side effects: None.
# --------------------------------------------------
sub _format_default {
	my ($self, $default) = @_;
	return 'undef' unless defined $default;
	return ref($default) . ' ref' if ref($default);
	return $default;
}

# --------------------------------------------------
# _analyze_parameter_constraints
#
# Purpose:    Infer min, max, and regex match
#             constraints for a single parameter
#             from length checks, numeric
#             comparisons, and regex match
#             patterns in the method body.
#
# Entry:      $p_ref - reference to the parameter
#                      hashref (modified in place).
#             $param - parameter name string.
#             $code  - method body source string.
#
# Exit:       Returns nothing. Modifies the
#             referenced parameter hashref.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
#
# Notes:      Numeric comparisons that appear
#             inside die/croak guard conditions
#             are excluded to avoid inferring
#             invalid-input ranges as valid
#             constraints.
# --------------------------------------------------
sub _analyze_parameter_constraints {
	my ($self, $p_ref, $param, $code) = @_;
	my $p = $$p_ref;

	# Do not treat comparisons inside die/croak/confess as valid constraints
	my $guarded = 0;
		if ($code =~ /(die|croak|confess)\b[^{;]*\bif\b[^{;]*\$$param\b/s) {
		$guarded = 1;
	}

	# Length checks for strings
	if ($code =~ /length\s*\(\s*\$$param\s*\)\s*([<>]=?)\s*(\d+)/) {
		my ($op, $val) = ($1, $2);
		$p->{type} ||= 'string';
		if ($op eq '<') {
			$p->{max} = $val - 1;
		} elsif ($op eq '<=') {
			$p->{max} = $val;
		} elsif ($op eq '>') {
			$p->{min} = $val + 1;
		} elsif ($op eq '>=') {
			$p->{min} = $val;
		}
		$self->_log("  CODE: $param length constraint $op $val");
	}

	# Numeric range checks (only if NOT part of error guard)
	if (
		!$guarded
		&& $code =~ /\$$param\s*([<>]=?)\s*([+-]?(?:\d+\.?\d*|\.\d+))/
	) {
		my ($op, $val) = ($1, $2);
		$p->{type} ||= looks_like_number($val) ? 'number' : 'integer';

		if ($op eq '<' || $op eq '<=') {
			# Only set max if it tightens the range
			my $max = ($op eq '<') ? $val - 1 : $val;
			$p->{max} = $max if !defined($p->{max}) || $max < $p->{max};
		} elsif ($op eq '>' || $op eq '>=') {
			my $min = ($op eq '>') ? $val + 1 : $val;
			$p->{min} = $min if !defined($p->{min}) || $min > $p->{min};
		}
	}

	# Regex pattern matching with better capture
	if ($code =~ /\$$param\s*=~\s*((?:qr?\/[^\/]+\/|\$[\w:]+|\$\{\w+\}))/) {
		my $pattern = $1;
		$p->{type} ||= 'string';

		# Clean up the pattern if it's a straightforward regex
		if ($pattern =~ /^qr?\/([^\/]+)\/$/) {
			$p->{matches} = "/$1/";
		} else {
			$p->{matches} = $pattern;
		}
		$self->_log("  CODE: $param matches pattern: $p->{matches}");
	}
}

# --------------------------------------------------
# _analyze_parameter_validation
#
# Purpose:    Determine optionality and extract
#             default values for a single parameter
#             by analysing explicit required checks
#             (die/croak unless defined) and default
#             assignment patterns in the method body.
#
# Entry:      $p_ref - reference to the parameter
#                      hashref (modified in place).
#             $param - parameter name string.
#             $code  - method body source string.
#
# Exit:       Returns nothing. Modifies the
#             referenced parameter hashref.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
#
# Notes:      Explicit required checks take highest
#             priority and override any default
#             value detected earlier.
# --------------------------------------------------
sub _analyze_parameter_validation {
	my ($self, $p_ref, $param, $code) = @_;
	my $p = $$p_ref;

	# Required/optional checks
	my $is_required = 0;

	# Die/croak if not defined
	if ($code =~ /(?:die|croak|confess)\s+[^;]*unless\s+(?:defined\s+)?\$$param/s) {
		$is_required = 1;
	}

	# Extract default values with the new method
	my $default_value = $self->_extract_default_value($param, $code);
	if (defined $default_value && !exists $p->{_default}) {
		$p->{optional} = 1;
		$p->{_default} = $default_value;

		# Try to infer type from default value if not already set
		unless ($p->{type}) {
			if (looks_like_number($default_value)) {
				$p->{type} = $default_value =~ /\./ ? 'number' : 'integer';
			} elsif (ref($default_value) eq 'ARRAY') {
				$p->{type} = 'arrayref';
			} elsif (ref($default_value) eq 'HASH') {
				$p->{type} = 'hashref';
			} elsif ($default_value eq 'undef') {
				$p->{type} = 'scalar';	# undef can be any scalar
			} elsif (defined $default_value && !ref($default_value)) {
				$p->{type} = 'string';
			}
		}

		$self->_log("  CODE: $param has default value: " . (ref($default_value) ? ref($default_value) . ' ref' : $default_value));
	}

	# Also check for simple default assignment without condition
	# Pattern: $param = 'value';
	if (!$default_value && !exists $p->{_default} && $code =~ /\$$param\s*=\s*([^;{}]+?)(?:\s*[;}])/s) {
		my $assignment = $1;
		# Make sure it's not part of a larger expression
		if ($assignment !~ /\$$param/ && $assignment !~ /^shift/) {
			my $possible_default = $assignment;
			$possible_default =~ s/\s*;\s*$//;
			$possible_default = $self->_clean_default_value($possible_default);
			if (defined $possible_default) {
				$p->{_default} = $possible_default;
				$p->{optional} = 1;
				$self->_log("  CODE: $param has unconditional default: $possible_default");
			}
		}
	}

	# Explicit required check overrides default detection
	if ($is_required) {
		$p->{optional} = 0;
		delete $p->{_default} if exists $p->{_default};
		$self->_log("  CODE: $param is required (validation check)");
	}
}

# --------------------------------------------------
# _merge_parameter_analyses
#
# Purpose:    Merge parameter information from POD,
#             code, and signature analysis into a
#             single authoritative parameter hashref
#             for each parameter.
#
# Entry:      $pod - hashref of parameters from POD
#                    analysis.
#             $code - hashref of parameters from
#                     code analysis.
#             $sig  - hashref of parameters from
#                     signature analysis (optional,
#                     defaults to empty hashref).
#
# Exit:       Returns a merged hashref of parameter
#             name to spec hashref. Each spec has
#             all available information combined,
#             with POD taking highest priority,
#             code second, and signature filling
#             remaining gaps.
#
# Side effects: Logs merged parameter details to
#               stdout when verbose is set.
#
# Notes:      Position is determined by majority
#             vote across all sources, with the
#             lowest position winning ties. Optional
#             status is determined by
#             _determine_optional_status. Internal
#             _source keys are stripped from the
#             merged result.
# --------------------------------------------------
sub _merge_parameter_analyses {
	my ($self, $pod, $code, $sig) = @_;

	my %merged;

	# Start with all parameters from all sources
	my %all_params = map { $_ => 1 } (keys %$pod, keys %$code, keys %$sig);

	foreach my $param (keys %all_params) {
		my $p = $merged{$param} = {};

		# Collect position from all sources
		my @positions;
		push @positions, $pod->{$param}{position} if $pod->{$param} && defined $pod->{$param}{position};
		push @positions, $sig->{$param}{position} if $sig->{$param} && defined $sig->{$param}{position};
		push @positions, $code->{$param}{position} if $code->{$param} && defined $code->{$param}{position};

		# Use the most common position, or lowest if tie
		if (@positions) {
			my %pos_count;
			$pos_count{$_}++ for @positions;
			my ($best_pos) = sort { $pos_count{$b} <=> $pos_count{$a} || $a <=> $b } keys %pos_count;
			$p->{position} = $best_pos unless(exists($p->{position}));
		}

		# POD has highest priority for type info and explicit declarations
		if ($pod->{$param}) {
			%$p = (%$p, %{$pod->{$param}});
		}

		# Code analysis adds concrete evidence (but doesn't override POD explicit types)
		if ($code->{$param}) {
			foreach my $key (keys %{$code->{$param}}) {
				next if $key eq '_source';
				next if $key eq 'position';

				# Only override if POD didn't provide this info or it's a stronger signal
				my $from_pod = exists $pod->{$param};
				if (!exists $p->{$key} ||
				   ($key eq 'type' && $from_pod && $p->{type} eq 'string' &&
				   $code->{$param}{$key} ne 'string')) {
					$p->{$key} = $code->{$param}{$key};
				}
			}
		}

		# Signature fills in remaining gaps
		if ($sig->{$param}) {
			foreach my $key (keys %{$sig->{$param}}) {
				next if $key eq '_source';
				next if $key eq 'position';
				$p->{$key} //= $sig->{$param}{$key};
			}
		}

		# Handle optional field with better logic
		$self->_determine_optional_status($p, $pod->{$param}, $code->{$param});

		# Clean up internal fields
		delete $p->{_source};
	}

	# Debug logging
	if ($self->{verbose}) {
		foreach my $param (sort { ($merged{$a}{position} || 999) <=> ($merged{$b}{position} || 999) } keys %merged) {
			my $p = $merged{$param};
			$self->_log("  MERGED $param: " .
					'pos=' . ($p->{position} || 'none') .
					", type=" . ($p->{type} || 'none') .
					", optional=" . (defined($p->{optional}) ? $p->{optional} : 'undef'));
		}
	}

	return \%merged;
}

# --------------------------------------------------
# _determine_optional_status
#
# Purpose:    Set the optional field on a merged
#             parameter spec based on evidence from
#             POD and code analysis, with POD taking
#             highest priority.
#
# Entry:      $merged_param - the merged parameter
#                             hashref (modified in
#                             place).
#             $pod_param    - parameter spec from
#                             POD analysis, or undef.
#             $code_param   - parameter spec from
#                             code analysis, or undef.
#
# Exit:       Returns nothing. Sets or leaves
#             $merged_param->{optional}.
#
# Side effects: None.
# --------------------------------------------------
sub _determine_optional_status {
	my ($self, $merged_param, $pod_param, $code_param) = @_;

	my $pod_optional = $pod_param ? $pod_param->{optional} : undef;
	my $code_optional = $code_param ? $code_param->{optional} : undef;

	# Explicit POD declaration wins
	if (defined $pod_optional) {
		$merged_param->{optional} = $pod_optional;
	}
	# Code validation evidence
	elsif (defined $code_optional) {
		$merged_param->{optional} = $code_optional;
	}
	# Default: if we have any info about the param, assume required
	elsif (keys %$merged_param > 0) {
		$merged_param->{optional} = 0;
	}
	# Otherwise leave undef (unknown)
}


# --------------------------------------------------
# _calculate_input_confidence
#
# Purpose:    Calculate a confidence score and level
#             for the input parameter analysis,
#             based on how much type, constraint,
#             and semantic information was inferred
#             for each parameter.
#
# Entry:      $params - hashref of merged parameter
#                       specs as produced by
#                       _merge_parameter_analyses.
#
# Exit:       Returns a hashref with keys:
#               level         - one of: none,
#                               very_low, low,
#                               medium, high
#               score         - numeric average
#                               across all params
#               factors       - arrayref of
#                               human-readable
#                               factor strings
#               per_parameter - hashref of per-
#                               parameter score
#                               and factor detail
#             Returns { level => 'none', ... } if
#             no parameters were found.
#
# Side effects: None.
# --------------------------------------------------
sub _calculate_input_confidence {
	my ($self, $params) = @_;

	my @factors;  # Track all confidence factors

	return { level => 'none', factors => ['No parameters found'] } unless keys %$params;

	my $total_score = 0;
	my $count = 0;
	my %param_details;	# Store per-parameter analysis

	foreach my $param (keys %$params) {
		my $p = $params->{$param};
		my $score = 0;
		my @param_factors;

		# Type information
		if ($p->{type}) {
			if ($p->{type} eq 'string' && ($p->{min} || $p->{max} || $p->{matches})) {
				$score += 25;
				push @param_factors, "Type: constrained string (+25)";
			} elsif ($p->{type} eq 'string') {
				$score += 10;
				push @param_factors, "Type: plain string (+10)";
			} else {
				$score += 30;
				push @param_factors, "Type: $p->{type} (+30)";
			}
		} else {
			push @param_factors, "No type information (-0)";
		}

		# Constraints
		if (defined $p->{min}) {
			$score += 15;
			push @param_factors, 'Has min constraint (+15)';
		}
		if (defined $p->{max}) {
			$score += 15;
			push @param_factors, "Has max constraint (+15)";
		}
		if (defined $p->{optional}) {
			$score += 20;
			push @param_factors, "Optional/required explicitly defined (+20)";
		}
		if ($p->{matches}) {
			$score += 20;
			push @param_factors, 'Has regex pattern constraint (+20)';
		}
		if ($p->{isa}) {
			$score += 25;
			push @param_factors, "Specific class constraint: $p->{isa} (+25)";
		}

		# Position information
		if (defined $p->{position}) {
			$score += 10;
			push @param_factors, "Position defined: $p->{position} (+10)";
		}

		# Default value
		if (exists $p->{_default}) {
			$score += 10;
			push @param_factors, "Has default value (+10)";
		}

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

		$param_details{$param} = {
			score => $score,
			factors => \@param_factors
		};

		$total_score += $score;
		$count++;
	}

	my $avg = $count ? ($total_score / $count) : 0;

	# Build summary factors
	push @factors, sprintf("Analyzed %d parameter%s", $count, $count == 1 ? '' : 's');
	push @factors, sprintf("Average confidence score: %.1f", $avg);

	# Add top contributing factors
	my @sorted_params = sort { $param_details{$b}{score} <=> $param_details{$a}{score} } keys %param_details;

	if (@sorted_params) {
		my $highest = $sorted_params[0];
		my $highest_score = $param_details{$highest}{score};
		push @factors, sprintf("Highest scoring parameter: \$$highest (score: %d)", $highest_score);

		if (@sorted_params > 1) {
			my $lowest = $sorted_params[-1];
			my $lowest_score = $param_details{$lowest}{score};
			push @factors, sprintf("Lowest scoring parameter: \$$lowest (score: %d)", $lowest_score);
		}
	}

	# Determine confidence level
	my $level;
	if ($avg >= $CONFIDENCE_HIGH_THRESHOLD) {
		$level = $LEVEL_HIGH;
		push @factors, "High confidence: comprehensive type and constraint information";
	} elsif ($avg >= $CONFIDENCE_MEDIUM_THRESHOLD) {
		$level = $LEVEL_MEDIUM;
		push @factors, "Medium confidence: some type or constraint information present";
	} elsif ($avg >= $CONFIDENCE_LOW_THRESHOLD) {
		$level = $LEVEL_LOW;
		push @factors, "Low confidence: minimal type information";
	} else {
		$level = $LEVEL_VERY_LOW;
		push @factors, "Very low confidence: little to no type information";
	}

	return {
		level => $level,
		score => $avg,
		factors => \@factors,
		per_parameter => \%param_details
	};
}

# --------------------------------------------------
# _calculate_output_confidence
#
# Purpose:    Calculate a confidence score and level
#             for the output analysis based on how
#             much return type, value, class,
#             context, and error convention
#             information was determined.
#
# Entry:      $output - the output hashref as built
#                       by _analyze_output.
#
# Exit:       Returns a hashref with keys:
#               level   - one of: none, very_low,
#                         low, medium, high
#               score   - numeric confidence score
#               factors - arrayref of factor strings
#             Returns { level => 'none', ... } if
#             output is empty.
#
# Side effects: None.
# --------------------------------------------------
sub _calculate_output_confidence {
	my ($self, $output) = @_;

	my @factors;

	return { level => 'none', factors => ['No return information found'] } unless keys %$output;

	my $score = 0;

	# Type information
	if ($output->{type}) {
		$score += 30;
		push @factors, "Return type defined: $output->{type} (+30)";
	} else {
		push @factors, 'No return type information (-0)';
	}

	# Specific value known
	if (defined $output->{value}) {
		$score += 30;
		push @factors, "Specific return value: $output->{value} (+30)";
	}

	# Class information for objects
	if ($output->{isa}) {
		$score += 30;
		push @factors, "Returns specific class: $output->{isa} (+30)";
	}

	# Context-aware returns
	if ($output->{_context_aware}) {
		$score += 20;
		push @factors, "Context-aware return (wantarray) (+20)";

		if ($output->{_list_context}) {
			push @factors, "  List context: $output->{_list_context}{type}";
		}
		if ($output->{_scalar_context}) {
			push @factors, "  Scalar context: $output->{_scalar_context}{type}";
		}
	}

	# Error handling information
	if ($output->{_error_return}) {
		$score += 15;
		push @factors, "Error return convention documented: $output->{_error_return} (+15)";
	}

	# Success/failure pattern
	if ($output->{_success_failure_pattern}) {
		$score += 10;
		push @factors, 'Success/failure pattern detected (+10)';
	}

	# Chainable methods
	if ($output->{_returns_self}) {
		$score += 15;
		push @factors, "Chainable method (fluent interface) (+15)";
	}

	# Void context
	if ($output->{_void_context}) {
		$score += 20;
		push @factors, "Void context method (no meaningful return) (+20)";
	}

	# Exception handling
	if ($output->{_error_handling} && $output->{_error_handling}{exception_handling}) {
		$score += 10;
		push @factors, 'Exception handling present (+10)';
	}

	push @factors, sprintf("Total output confidence score: %d", $score);

	# Determine confidence level
	my $level;
	if ($score >= $CONFIDENCE_HIGH_THRESHOLD) {
		$level = $LEVEL_HIGH;
		push @factors, "High confidence: detailed return type and behavior";
	} elsif ($score >= $CONFIDENCE_MEDIUM_THRESHOLD) {
		$level = $LEVEL_MEDIUM;
		push @factors, "Medium confidence: return type defined";
	} elsif ($score >= $CONFIDENCE_LOW_THRESHOLD) {
		$level = $LEVEL_LOW;
		push @factors, "Low confidence: minimal return information";
	} else {
		$level = $LEVEL_VERY_LOW;
		push @factors, 'Very low confidence: little return information';
	}

	return {
		level => $level,
		score => $score,
		factors => \@factors
	};
}

# --------------------------------------------------
# _generate_confidence_report
#
# Purpose:    Generate a human-readable text report
#             of all confidence factors for a
#             schema, for debugging and review
#             purposes.
#
# Entry:      $schema - schema hashref containing
#                       a populated _analysis key.
#
# Exit:       Returns a multi-line string report,
#             or nothing if $schema->{_analysis}
#             is absent.
#
# Side effects: None.
# --------------------------------------------------
sub _generate_confidence_report
{
	my ($self, $schema) = @_;

	return unless $schema->{_analysis};

	my $analysis = $schema->{_analysis};
	my @report;

	push @report, "Confidence Analysis for " . ($schema->{method_name} || 'method');
	push @report, '=' x 60;
	push @report, '';

	push @report, "Overall Confidence: " . uc($analysis->{overall_confidence});
	push @report, '';

	if ($analysis->{confidence_factors}{input}) {
		push @report, (
			"Input Parameters:",
			 "  Confidence Level: " . uc($analysis->{input_confidence})
		);
		foreach my $factor (@{$analysis->{confidence_factors}{input}}) {
			push @report, "  - $factor";
		}
		push @report, '';
	}

	if ($analysis->{confidence_factors}{output}) {
		push @report, 'Return Value:',
			"  Confidence Level: " . uc($analysis->{output_confidence});
		foreach my $factor (@{$analysis->{confidence_factors}{output}}) {
			push @report, "  - $factor";
		}
		push @report, '';
	}

	if ($analysis->{per_parameter_scores}) {
		push @report, 'Per-Parameter Analysis:';
		foreach my $param (sort keys %{$analysis->{per_parameter_scores}}) {
			my $details = $analysis->{per_parameter_scores}{$param};
			push @report, "  \$$param (score: $details->{score}):";
			foreach my $factor (@{$details->{factors}}) {
				push @report, "    - $factor";
			}
		}
		push @report, '';
	}

	return join("\n", @report);
}

# --------------------------------------------------
# _generate_notes
#
# Purpose:    Generate human-readable advisory notes
#             about parameters whose type or
#             optionality could not be determined,
#             to guide manual schema review.
#
# Entry:      $params - hashref of merged parameter
#                       specs.
#
# Exit:       Returns an arrayref of note strings.
#             Returns an empty arrayref if all
#             parameters have known types and
#             optionality.
#
# Side effects: None.
# --------------------------------------------------
sub _generate_notes {
	my ($self, $params) = @_;

	my @notes;

	foreach my $param (keys %$params) {
		my $p = $params->{$param};

		unless ($p->{type}) {
			push @notes, "$param: type unknown - please review - will set to 'string' as a default";
		}

		unless (defined $p->{optional}) {
			push @notes, "$param: optional status unknown";
			# Don't automatically set - let it be undef if we don't know
		}
	}

	return \@notes;
}

# --------------------------------------------------
# _set_defaults
#
# Purpose:    Apply default type values to any
#             parameters in a schema mode (input
#             or output) whose type was not set
#             during analysis, setting them to
#             'string' as a conservative fallback.
#
# Entry:      $schema - the schema hashref being
#                       built by _analyze_method.
#             $mode   - either 'input' or 'output'.
#
# Exit:       Returns nothing. Modifies $schema in
#             place by setting type => 'string' on
#             any parameter that lacks a type, and
#             downgrading input confidence to 'low'.
#
# Side effects: Logs type defaulting to stdout when
#               verbose is set.
#
# Notes:      Called after all analysis is complete
#             so that genuine type unknowns can be
#             distinguished from analysis gaps.
# --------------------------------------------------
sub _set_defaults {
	my ($self, $schema, $mode) = @_;

	my $params = $schema->{$mode};

	foreach my $param (keys %$params) {
		my $p = $params->{$param};

		next unless(ref($p) eq 'HASH');
		unless ($p->{type}) {
			$self->_log("  DEBUG {$mode}{$param}: Setting to 'string' as a default");
			$p->{'type'} = 'string';
			$schema->{_confidence}{$mode}->{level} = 'low';	# Setting a default means it's a guess
		}
	}
}

# --------------------------------------------------
# _analyze_relationships
#
# Purpose:    Detect inter-parameter relationships
#             in a method's source code, including
#             mutually exclusive parameters, required
#             groups, conditional requirements,
#             dependencies, and value-based
#             constraints.
#
# Entry:      $method - method hashref containing
#                       at minimum a 'body' key
#                       with the source string.
#
# Exit:       Returns an arrayref of relationship
#             hashrefs. Returns an empty arrayref
#             if no parameters or no relationships
#             are found.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
#
# Notes:      Parameter names are extracted from
#             the my (...) = @_ pattern only —
#             shift-style parameters are not
#             currently analysed for relationships.
# --------------------------------------------------
sub _analyze_relationships {
	my ($self, $method) = @_;

	my $code = $method->{body};
	my @relationships;

	# Extract all parameter names from the method
	my @param_names;
	if ($code =~ /my\s*\(\s*\$\w+\s*,\s*(.+?)\)\s*=\s*\@_/s) {
		my $params = $1;
		@param_names = $params =~ /\$(\w+)/g;
	}

	return [] unless @param_names;

	# Detect mutually exclusive parameters
	push @relationships, @{$self->_detect_mutually_exclusive($code, \@param_names)};

	# Detect required groups (OR logic)
	push @relationships, @{$self->_detect_required_groups($code, \@param_names)};

	# Detect conditional requirements (IF-THEN)
	push @relationships, @{$self->_detect_conditional_requirements($code, \@param_names)};

	# Detect dependencies
	push @relationships, @{$self->_detect_dependencies($code, \@param_names)};

	# Detect value-based constraints
	push @relationships, @{$self->_detect_value_constraints($code, \@param_names)};

	# Deduplicate relationships
	my @unique = $self->_deduplicate_relationships(\@relationships);

	return \@unique;
}

# --------------------------------------------------
# _deduplicate_relationships
#
# Purpose:    Remove duplicate relationship entries
#             from the relationships list by
#             computing a canonical signature for
#             each relationship type.
#
# Entry:      $relationships - arrayref of
#                              relationship hashrefs.
#
# Exit:       Returns a deduplicated list of
#             relationship hashrefs.
#
# Side effects: None.
# --------------------------------------------------
sub _deduplicate_relationships {
	my ($self, $relationships) = @_;

	my @unique;
	my %seen;

	foreach my $rel (@$relationships) {
		# Create a signature for this relationship
		my $sig;
		if ($rel->{type} eq 'mutually_exclusive') {
			$sig = join(':', 'mutex', sort @{$rel->{params}});
		} elsif ($rel->{type} eq 'required_group') {
			$sig = join(':', 'reqgroup', sort @{$rel->{params}});
		} elsif ($rel->{type} eq 'conditional_requirement') {
			$sig = join(':', 'condreq', $rel->{if}, $rel->{then_required});
		} elsif ($rel->{type} eq 'dependency') {
			$sig = join(':', 'dep', $rel->{param}, $rel->{requires});
		} elsif ($rel->{type} eq 'value_constraint') {
			$sig = join(':', 'valcon', $rel->{if}, $rel->{then}, $rel->{operator}, $rel->{value});
		} elsif ($rel->{type} eq 'value_conditional') {
			$sig = join(':', 'valcond', $rel->{if}, $rel->{equals}, $rel->{then_required});
		} else {
			$sig = join(':', $rel->{type}, %$rel);
		}

		unless ($seen{$sig}++) {
			push @unique, $rel;
		}
	}

	return @unique;
}

# --------------------------------------------------
# _detect_mutually_exclusive
#
# Purpose:    Detect pairs of parameters that cannot
#             be specified together, by searching
#             for die/croak/confess patterns
#             that fire when both are truthy.
#
# Entry:      $code        - method body source string.
#             $param_names - arrayref of parameter
#                            name strings.
#
# Exit:       Returns an arrayref of relationship
#             hashrefs of type 'mutually_exclusive'.
#             Returns an empty arrayref if none found.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _detect_mutually_exclusive {
	my ($self, $code, $param_names) = @_;

	my @relationships;

	# Pattern 1: die/croak if $x && $y
	# Look for: die/croak ... if $param1 && $param2
	foreach my $param1 (@$param_names) {
		foreach my $param2 (@$param_names) {
			next if $param1 eq $param2;

			# Check various patterns
			if ($code =~ /(?:die|croak|confess)[^;]*if\s+\$$param1\s+&&\s+\$$param2/ ||
			    $code =~ /(?:die|croak|confess)[^;]*if\s+\$$param2\s+&&\s+\$$param1/) {

				# Avoid duplicates (param1,param2 vs param2,param1)
				my $found_reverse = 0;
				foreach my $rel (@relationships) {
					if ($rel->{type} eq 'mutually_exclusive' &&
					    (($rel->{params}[0] eq $param2 && $rel->{params}[1] eq $param1))) {
						$found_reverse = 1;
						last;
					}
				}

				next if $found_reverse;

				push @relationships, {
					type => 'mutually_exclusive',
					params => [$param1, $param2],
					description => "Cannot specify both $param1 and $param2"
				};

				$self->_log("  RELATIONSHIP: $param1 and $param2 are mutually exclusive");
			}

			# Pattern 2: die "Cannot specify both X and Y"
			if ($code =~ /(?:die|croak|confess)\s+['"](Cannot|Can't)[^'"]*both[^'"]*$param1[^'"]*$param2/i ||
			    $code =~ /(?:die|croak|confess)\s+['"](Cannot|Can't)[^'"]*both[^'"]*$param2[^'"]*$param1/i) {

				my $found_reverse = 0;
				foreach my $rel (@relationships) {
					if ($rel->{type} eq 'mutually_exclusive' &&
					    (($rel->{params}[0] eq $param2 && $rel->{params}[1] eq $param1))) {
						$found_reverse = 1;
						last;
					}
				}

				next if $found_reverse;

				push @relationships, {
					type => 'mutually_exclusive',
					params => [$param1, $param2],
					description => "Cannot specify both $param1 and $param2"
				};

				$self->_log("  RELATIONSHIP: $param1 and $param2 are mutually exclusive (from error message)");
			}
		}
	}

	return \@relationships;
}

# --------------------------------------------------
# _detect_required_groups
#
# Purpose:    Detect parameter groups where at least
#             one parameter must be specified (OR
#             logic), by searching for die/croak
#             patterns that fire unless any of the
#             group is truthy.
#
# Entry:      $code        - method body source string.
#             $param_names - arrayref of parameter
#                            name strings.
#
# Exit:       Returns an arrayref of relationship
#             hashrefs of type 'required_group'.
#             Returns an empty arrayref if none found.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _detect_required_groups {
	my ($self, $code, $param_names) = @_;

	my @relationships;

	# Pattern 1: die/croak unless $x || $y
	foreach my $param1 (@$param_names) {
		foreach my $param2 (@$param_names) {
			next if $param1 eq $param2;

			if ($code =~ /(?:die|croak|confess)[^;]*unless\s+\$$param1\s+\|\|\s+\$$param2/ ||
			    $code =~ /(?:die|croak|confess)[^;]*unless\s+\$$param2\s+\|\|\s+\$$param1/) {

				# Avoid duplicates
				my $found_reverse = 0;
				foreach my $rel (@relationships) {
					if ($rel->{type} eq 'required_group' &&
					    (($rel->{params}[0] eq $param2 && $rel->{params}[1] eq $param1))) {
						$found_reverse = 1;
						last;
					}
				}

				next if $found_reverse;

				push @relationships, {
					type => 'required_group',
					params => [$param1, $param2],
					logic => 'or',
					description => "Must specify either $param1 or $param2"
				};

				$self->_log("  RELATIONSHIP: Must specify either $param1 or $param2");
			}

			# Pattern 2: die "Must specify either X or Y"
			if ($code =~ /(?:die|croak|confess)\s+['"]Must\s+specify\s+either[^'"]*$param1[^'"]*or[^'"]*$param2/i ||
			    $code =~ /(?:die|croak|confess)\s+['"]Must\s+specify\s+either[^'"]*$param2[^'"]*or[^'"]*$param1/i) {

				my $found_reverse = 0;
				foreach my $rel (@relationships) {
					if ($rel->{type} eq 'required_group' &&
					    (($rel->{params}[0] eq $param2 && $rel->{params}[1] eq $param1))) {
						$found_reverse = 1;
						last;
					}
				}

				next if $found_reverse;

				push @relationships, {
					type => 'required_group',
					params => [$param1, $param2],
					logic => 'or',
					description => "Must specify either $param1 or $param2"
				};

				$self->_log("  RELATIONSHIP: Must specify either $param1 or $param2 (from error message)");
			}
		}
	}

	return \@relationships;
}

# --------------------------------------------------
# _detect_conditional_requirements
#
# Purpose:    Detect IF-THEN parameter relationships
#             where one parameter being present
#             makes another required, by searching
#             for die/croak patterns of the form
#             'die if $x && !$y'.
#
# Entry:      $code        - method body source string.
#             $param_names - arrayref of parameter
#                            name strings.
#
# Exit:       Returns an arrayref of relationship
#             hashrefs of type
#             'conditional_requirement'.
#             Returns an empty arrayref if none found.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _detect_conditional_requirements {
	my ($self, $code, $param_names) = @_;

	my @relationships;

	foreach my $param1 (@$param_names) {
		foreach my $param2 (@$param_names) {
			next if $param1 eq $param2;

			# Pattern 1: die if $x && !$y  (if x then y required)
			if ($code =~ /(?:die|croak|confess)[^;]*if\s+\$$param1\s+&&\s+!\$$param2/) {
				push @relationships, {
					type => 'conditional_requirement',
					if => $param1,
					then_required => $param2,
					description => "When $param1 is specified, $param2 is required"
				};

				$self->_log("  RELATIONSHIP: $param1 requires $param2");
			}

			# Pattern 2: die if $x && !defined($y)
			if ($code =~ /(?:die|croak|confess)[^;]*if\s+\$$param1\s+&&\s+!defined\s*\(\s*\$$param2\s*\)/) {
				push @relationships, {
					type => 'conditional_requirement',
					if => $param1,
					then_required => $param2,
					description => "When $param1 is specified, $param2 is required"
				};

				$self->_log("  RELATIONSHIP: $param1 requires $param2 (defined check)");
			}

			# Pattern 3: Error message "X requires Y"
			if ($code =~ /(?:die|croak|confess)\s+['"]\w*$param1[^'"]*requires[^'"]*$param2/i) {
				push @relationships, {
					type => 'conditional_requirement',
					if => $param1,
					then_required => $param2,
					description => "When $param1 is specified, $param2 is required"
				};

				$self->_log("  RELATIONSHIP: $param1 requires $param2 (from error message)");
			}
		}
	}

	return \@relationships;
}

# --------------------------------------------------
# _detect_dependencies
#
# Purpose:    Detect simple parameter dependencies
#             where one parameter requires another
#             to also be present, by combining
#             error message pattern matching with
#             code condition matching.
#
# Entry:      $code        - method body source string.
#             $param_names - arrayref of parameter
#                            name strings.
#
# Exit:       Returns an arrayref of relationship
#             hashrefs of type 'dependency'.
#             Returns an empty arrayref if none found.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _detect_dependencies {
	my ($self, $code, $param_names) = @_;

	my @relationships;

	foreach my $param1 (@$param_names) {
		foreach my $param2 (@$param_names) {
			next if $param1 eq $param2;

			# Pattern 1: Error message mentions "X requires Y" AND code checks $x && !$y
			# Split into two checks to be more flexible
			if (($code =~ /(?:die|croak|confess)\s+['"]\w*$param1[^'"]*requires[^'"]*$param2/i) &&
			    ($code =~ /if\s+\$param1\s+&&\s+!\$param2/)) {

				push @relationships, {
					type => 'dependency',
					param => $param1,
					requires => $param2,
					description => "$param1 requires $param2 to be specified"
				};

				$self->_log("  RELATIONSHIP: $param1 depends on $param2");
			}
		}
	}

	return \@relationships;
}

# --------------------------------------------------
# _detect_value_constraints
#
# Purpose:    Detect value-based constraints between
#             parameters, such as 'if $ssl then
#             $port must equal 443' or 'if $mode
#             eq secure then $key is required'.
#
# Entry:      $code        - method body source string.
#             $param_names - arrayref of parameter
#                            name strings.
#
# Exit:       Returns an arrayref of relationship
#             hashrefs of type 'value_constraint'
#             or 'value_conditional'.
#             Returns an empty arrayref if none found.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
# --------------------------------------------------
sub _detect_value_constraints {
	my ($self, $code, $param_names) = @_;

	my @relationships;

	foreach my $param1 (@$param_names) {
		foreach my $param2 (@$param_names) {
			next if $param1 eq $param2;

			# Pattern 1: die if $x && $y != value
			if ($code =~ /(?:die|croak|confess)[^;]*if\s+\$$param1\s+&&\s+\$$param2\s*!=\s*(\d+)/) {
				my $value = $1;
				push @relationships, {
					type => 'value_constraint',
					if => $param1,
					then => $param2,
					operator => '==',
					value => $value,
					description => "When $param1 is specified, $param2 must equal $value"
				};

				$self->_log("  RELATIONSHIP: $param1 requires $param2 == $value");
			}

			# Pattern 2: die if $x && $y < value
			if ($code =~ /(?:die|croak|confess)[^;]*if\s+\$$param1\s+&&\s+\$$param2\s*<\s*(\d+)/) {
				my $value = $1;
				push @relationships, {
					type => 'value_constraint',
					if => $param1,
					then => $param2,
					operator => '>=',
					value => $value,
					description => "When $param1 is specified, $param2 must be >= $value"
				};

				$self->_log("  RELATIONSHIP: $param1 requires $param2 >= $value");
			}

			# Pattern 3: die if $x eq 'value' && !$y
			if ($code =~ /(?:die|croak|confess)[^;]*if\s+\$$param1\s+eq\s+['"]([^'"]+)['"]\s+&&\s+!\$$param2/) {
				my $value = $1;
				push @relationships, {
					type => 'value_conditional',
					if => $param1,
					equals => $value,
					then_required => $param2,
					description => "When $param1 equals '$value', $param2 is required"
				};

				$self->_log("  RELATIONSHIP: $param1='$value' requires $param2");
			}
		}
	}

	return \@relationships;
}

# Write a single method schema to a YAML file in output_dir.
#
# Entry:      $method_name is a non-empty string; $schema is a hashref.
# Exit:       YAML file written to output_dir/$method_name.yml.
# Side effects: Creates output_dir if it does not exist.
# Notes:      Croaks if output_dir was not set in new().

sub _write_schema {
	my ($self, $method_name, $schema) = @_;

	# output_dir is required here — croak early with a clear message
	# rather than letting make_path fail with a cryptic error
	croak(__PACKAGE__, ': output_dir must be provided to new() when writing schema files') unless defined $self->{output_dir};

	make_path($self->{output_dir}) unless -d $self->{output_dir};

	my $filename = "$self->{output_dir}/${method_name}.yml";

	# Configure YAML::XS to not quote numeric strings
	local $YAML::XS::QuoteNumericStrings = 0;

	# Extract package name for module field
	my $package_name = '';
	if ($self->{_document}) {
		my $package_stmt = $self->{_document}->find_first('PPI::Statement::Package');
		$package_name = $package_stmt ? $package_stmt->namespace : '';
		$self->{_package_name} //= $package_name;
	}

	# Clean up schema for output - use the format expected by App::Test::Generator::Template
	my $output = {
		function => $method_name,
		module => $package_name,
		config => {
			close_stdin => 0,
			dedup => 1,
			test_nuls => 0,
			test_undef => 0,
			test_empty => 1,
			test_non_ascii => 0,
			test_security => 0
		}
	};

	# Process input parameters with advanced type handling
	if($schema->{'input'}) {
		if(scalar(keys %{$schema->{'input'}})) {
			$output->{'input'} = {};

			foreach my $param_name (keys %{$schema->{'input'}}) {
				my $param = $schema->{'input'}{$param_name};
				if($param->{name}) {
					my $name = delete $param->{name};
					if($name ne $param_name) {
						# Sanity check
						croak("BUG: Parameter name - expected $param_name, got $name");
					}
				}
				my $cleaned_param = $self->_serialize_parameter_for_yaml($param);
				$output->{'input'}{$param_name} = $cleaned_param;
			}
		} else {
			delete $output->{input};
		}
	}

	# Process output
	if($schema->{'output'} && (scalar(keys %{$schema->{'output'}}))) {
		if((ref($schema->{output}{_error_handling}) eq 'HASH') && (scalar(keys %{$schema->{output}{_error_handling}}) == 0)) {
			delete $schema->{output}{_error_handling};
		}
		$output->{'output'} = $schema->{'output'};
	}

	if($schema->{'output'}{'type'} && ($schema->{'output'}{'type'} eq 'scalar')) {
		$schema->{'output'}{'type'} = 'string';
		$schema->{_confidence}{output}->{level} = 'low';	# A guess
	}

	# Add 'new' field if object instantiation is needed
	if ($schema->{new}) {
		# TODO: consider allowing parent class packages up the ISA chain
		if(ref($schema->{new}) || ($schema->{new} eq $package_name)) {
			$output->{new} = $schema->{new} eq $package_name ? undef : $schema->{'new'};
		} else {
			$self->_log("  NEW: Don't use $schema->{new} for object insantiation");
			delete $schema->{new};
			delete $output->{new};
		}
	}

	if(!defined($schema->{_confidence}{input}->{level})) {
		$schema->{_confidence}{input} = $self->_calculate_input_confidence($schema->{input});
	}
	if(!defined($schema->{_confidence}{output}->{level})) {
		$schema->{_confidence}{output} = $self->_calculate_output_confidence($schema->{output});
	}

	# Add relationships if detected
	if ($schema->{relationships} && @{$schema->{relationships}}) {
		$output->{relationships} = $schema->{relationships};
	}

	if($schema->{accessor} && scalar(keys %{$schema->{accessor}})) {
		$output->{accessor} = $schema->{accessor};
	}

	open my $fh, '>', $filename;
	print $fh YAML::XS::Dump($output);
	print $fh $self->_generate_schema_comments($schema, $method_name);
	close $fh;

	my $rel_info = $schema->{relationships} ?
		' [' . scalar(@{$schema->{relationships}}) . ' relationships]' : '';
	$self->_log("  Wrote: $filename (input confidence: $schema->{_confidence}{input}->{level})" .
				($schema->{new} ? " [requires: $schema->{new}]" : '') . $rel_info);
}

# --------------------------------------------------
# _generate_schema_comments
#
# Purpose:    Generate the YAML comment block
#             appended to the end of each written
#             schema file, containing provenance,
#             confidence levels, parameter type
#             notes, relationship summaries, and
#             warnings about types requiring
#             special test setup.
#
# Entry:      $schema      - the schema hashref as
#                            built by _analyze_method.
#             $method_name - the method name string,
#                            used in the fuzz
#                            command hint.
#
# Exit:       Returns a string of YAML comment lines
#             beginning with a blank line and ending
#             with a trailing newline.
#
# Side effects: None.
# --------------------------------------------------
sub _generate_schema_comments {
	my ($self, $schema, $method_name) = @_;

	my @comments;

	push @comments, '';
	push @comments, '# Generated by ' . ref($self);
	push @comments, "# Run: fuzz-harness-generator -r $self->{output_dir}/${method_name}.yml";
	push @comments, '#';
	push @comments, "# Input confidence: $schema->{_confidence}{input}->{level}";
	push @comments, "# Output confidence: $schema->{_confidence}{output}->{level}";

	# Add notes about parameters
	if ($schema->{input}) {
		my @param_notes;
		foreach my $param_name (sort keys %{$schema->{input}}) {
			my $p = $schema->{input}{$param_name};

			if ($p->{semantic}) {
				push @param_notes, "$param_name: $p->{semantic}";
			}

			if ($p->{enum}) {
				push @param_notes, "$param_name: enum with " . scalar(@{$p->{enum}}) . " values";
			}

			if ($p->{isa}) {
				push @param_notes, "$param_name: requires $p->{isa} object";
			}
		}

		if (@param_notes) {
			push @comments, '#';
			push @comments, '# Parameter types detected:';
			foreach my $note (@param_notes) {
				push @comments, "#   - $note";
			}
		}
	}

	# Add relationship notes
	if ($schema->{relationships} && @{$schema->{relationships}}) {
		push @comments, (
			'#',
			'# Parameter relationships detected:'
		);
		foreach my $rel (@{$schema->{relationships}}) {
			my $desc = $rel->{description} || _format_relationship($rel);
			push @comments, "#   - $desc";
		}
	}

	# Add general notes
	if ($schema->{_notes} && scalar(@{$schema->{_notes}})) {
		push @comments, '#';
		push @comments, '# Notes:';
		foreach my $note (@{$schema->{_notes}}) {
			push @comments, "#   - $note";
		}
	}

	if($schema->{_analysis}) {
		push @comments, (
			'#',
			'# Analysis:',
			'# TODO:',
		);
		# confidence_factors:
		#   input:
		#   - No parameters found
		#   output:
		#   - 'Return type defined: object (+30)'
		#   - 'Total output confidence score: 30'
		#   - 'Medium confidence: return type defined'
		#   input_confidence: none
		#   output_confidence: medium
		#   overall_confidence: none
	}

	# Add warnings for complex types
	my @warnings;
	if ($schema->{input}) {
		foreach my $param_name (keys %{$schema->{input}}) {
			my $p = $schema->{input}{$param_name};

			if ($p->{type} && $p->{type} eq 'coderef') {
				push @warnings, "Parameter '$param_name' is a coderef - you'll need to provide a sub {} in tests";
			}

			if ($p->{semantic} && $p->{semantic} eq 'filehandle') {
				push @warnings, "Parameter '$param_name' is a filehandle - consider using IO::String or mock";
			}

			if ($p->{isa} && $p->{isa} =~ /DateTime/) {
				push @warnings, "Parameter '$param_name' requires DateTime - ensure DateTime is loaded";
			}
		}
	}

	if (@warnings) {
		push @comments, '#';
		push @comments, '# WARNINGS - Manual test setup may be required:';
		foreach my $warning (@warnings) {
			push @comments, "#   ! $warning";
		}
	}

	push @comments, '';

	return join("\n", @comments);
}

# --------------------------------------------------
# _serialize_parameter_for_yaml
#
# Purpose:    Convert a parameter spec hashref into
#             a cleaned, YAML-serialisable form
#             suitable for App::Test::Generator
#             consumption, handling semantic type
#             mappings, enum values, and object
#             class annotations.
#
# Entry:      $param - parameter spec hashref as
#                      produced by the merge and
#                      analysis pipeline.
#
# Exit:       Returns a new hashref containing only
#             the fields App::Test::Generator
#             understands, with internal _ keys
#             and semantic keys removed or converted.
#
# Side effects: None.
#
# Notes:      Semantic types are mapped to
#             appropriate base types with additional
#             constraint and note fields.
#             The original $param hashref is not
#             modified.
# --------------------------------------------------
sub _serialize_parameter_for_yaml {
	my ($self, $param) = @_;

	my %cleaned;

	# Copy basic fields that App::Test::Generator expects
	foreach my $field (qw(type position optional min max matches default)) {
		$cleaned{$field} = $param->{$field} if defined $param->{$field};
	}

	# Handle advanced type mappings
	if(my $semantic = $param->{semantic}) {
		if ($semantic eq 'datetime_object') {
			# DateTime objects: test generator needs to know how to create them
			$cleaned{type} = 'object';
			$cleaned{isa} = $param->{isa} || 'DateTime';
			$cleaned{_note} = 'Requires DateTime object';
		} elsif ($semantic eq 'timepiece_object') {
			$cleaned{type} = 'object';
			$cleaned{isa} = $param->{isa} || 'Time::Piece';
			$cleaned{_note} = 'Requires Time::Piece object';
		} elsif ($semantic eq 'date_string') {
			# Date strings: provide regex pattern
			$cleaned{type} = 'string';
			$cleaned{matches} ||= '/^\d{4}-\d{2}-\d{2}$/';
			$cleaned{_example} = '2024-12-12';
		} elsif ($semantic eq 'iso8601_string') {
			$cleaned{type} = 'string';
			$cleaned{matches} ||= '/^\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}Z?$/';
			$cleaned{_example} = '2024-12-12T10:30:00Z';
		} elsif ($semantic eq 'unix_timestamp') {
			$cleaned{type} = 'integer';
			$cleaned{min} ||= 0;
			$cleaned{max} ||= $INT32_MAX;	# 32-bit max
			$cleaned{_note} = 'UNIX timestamp';
		} elsif ($semantic eq 'datetime_parseable') {
			$cleaned{type} = 'string';
			$cleaned{_note} = 'Must be parseable as datetime';
		} elsif ($semantic eq 'filehandle') {
			# File handles: special handling needed
			$cleaned{type} = 'object';
			$cleaned{isa} = $param->{isa} || 'IO::Handle';
			$cleaned{_note} = 'File handle - may need mock in tests';
		} elsif ($semantic eq 'filepath') {
			# File paths: string with path pattern
			$cleaned{type} = 'string';
			$cleaned{matches} ||= '/^[\\w\\/.\\-_]+$/';
			$cleaned{_note} = 'File path';
		} elsif ($semantic eq 'callback') {
			# Coderefs: mark as special type
			$cleaned{type} = 'coderef';
			$cleaned{_note} = 'CODE reference - provide sub { } in tests';
		} elsif ($semantic eq 'enum') {
			# Enum: keep as string but add valid values
			$cleaned{type} = 'string';
			if ($param->{enum} && ref($param->{enum}) eq 'ARRAY') {
				$cleaned{enum} = $param->{enum};
				$cleaned{_note} = 'Must be one of: ' . join(', ', @{$param->{enum}});
			}
		}
	}

	# Handle memberof even if not marked with semantic
	if($param->{enum} && ref($param->{enum}) eq 'ARRAY') {
		$cleaned{memberof} = $param->{enum};
	}
	if($param->{memberof} && ref($param->{memberof}) eq 'ARRAY') {
		$cleaned{memberof} = $param->{memberof};
	}

	# Handle object class
	if ($param->{isa} && !$cleaned{isa}) {
		$cleaned{isa} = $param->{isa};
	}

	# Add format hints where available
	if ($param->{format}) {
		$cleaned{_format} = $param->{format};
	}

	# Remove internal fields
	delete $cleaned{_source};
	delete $cleaned{semantic};

	return \%cleaned;
}

# --------------------------------------------------
# _format_relationship
#
# Purpose:    Format a relationship hashref as a
#             short human-readable description
#             string for use in YAML comments.
#
# Entry:      $rel - relationship hashref as
#                    produced by the relationship
#                    detection methods.
#
# Exit:       Returns a description string.
#             Returns 'Unknown relationship' for
#             unrecognised types.
#
# Side effects: None.
# --------------------------------------------------
sub _format_relationship {
	my $rel = $_[0];

	if ($rel->{type} eq 'mutually_exclusive') {
		return 'Mutually exclusive: ' . join(', ', @{$rel->{params}});
	} elsif ($rel->{type} eq 'required_group') {
		return "Required group (OR): " . join(', ', @{$rel->{params}});
	} elsif ($rel->{type} eq 'conditional_requirement') {
		return "If $rel->{if} then $rel->{then_required} required";
	} elsif ($rel->{type} eq 'dependency') {
		return "$rel->{param} depends on $rel->{requires}";
	} elsif ($rel->{type} eq 'value_constraint') {
		return "If $rel->{if} then $rel->{then} $rel->{operator} $rel->{value}";
	} elsif ($rel->{type} eq 'value_conditional') {
		return "If $rel->{if}='$rel->{equals}' then $rel->{then_required} required";
	}
	return 'Unknown relationship';
}

# --------------------------------------------------
# _needs_object_instantiation
#
# Purpose:    Determine whether a method requires
#             an object to be instantiated before
#             it can be called, and if so return
#             the package name to instantiate.
#
# Entry:      $method_name - name of the method.
#             $method_body - method source string.
#             $method_info - method hashref from
#                            _find_methods (optional,
#                            for backward compat).
#
# Exit:       Returns the package name string if
#             object instantiation is required.
#             Returns undef if the method is a
#             constructor, factory, singleton, or
#             pure class method.
#
# Side effects: Logs analysis decisions to stdout
#               when verbose is set.
#
# Notes:      Orchestrates five detection sub-steps:
#             factory detection, singleton detection,
#             instance method detection, inheritance
#             check, and constructor requirements.
#             Instance method detection overrides
#             factory detection when both fire.
# --------------------------------------------------
sub _needs_object_instantiation {
	my ($self, $method_name, $method_body, $method_info) = @_;

	# Allow method_info to be optional for backward compatibility
	$method_info ||= {};

	my $doc = $self->{_document};
	return undef unless $doc;

	# Get the current package name
	my $package_stmt = $doc->find_first('PPI::Statement::Package');
	my $current_package = $package_stmt ? $package_stmt->namespace : 'UNKNOWN';
	$self->{_package_name} //= $current_package;

	# Initialize result structure
	my $result = {
		package => $current_package,
		needs_object => 0,
		type => 'unknown',
		details => {},
		constructor_params => undef,
	};

	# Track whether we should explicitly skip object instantiation
	my $skip_object = 0;

	# Skip constructors and destructors
	if ($method_name eq 'new') {
		$self->_log("  OBJECT: Constructor '$method_name' detected; skipping instantiation analysis");
		return undef;
	}
	if($method_name =~ /^(create|build|construct|init|DESTROY)$/i) {
		$skip_object = 1;
	}

	# 1. Check for factory methods that return instances
	my $is_factory = $self->_detect_factory_method(
		$method_name, $method_body, $current_package, $method_info
	);

	# 2. Check for singleton patterns
	my $is_singleton = $self->_detect_singleton_pattern($method_name, $method_body);
	if ($is_singleton) {
		$result->{needs_object} = 0;	# Singleton methods return the singleton instance
		$result->{type} = 'singleton_accessor';
		$result->{details} = $is_singleton;
		$self->_log("  OBJECT: Detected singleton accessor '$method_name'");
		# Singleton accessors typically don't need object creation in tests
		# as they're called on the class, not instance
		$skip_object = 1;
	}

	# 3. Check if this is an instance method that needs an object
	my $is_instance_method = $self->_detect_instance_method($method_name, $method_body);
	if ($is_instance_method &&
	    ($is_instance_method->{explicit_self} ||
	     $is_instance_method->{shift_self} ||
	     $is_instance_method->{accesses_object_data})) {

		# Instance-only methods override factory detection
		if ($is_factory) {
			$self->_log(
				"  OBJECT: Instance-only method '$method_name' overrides factory detection"
			);
		}

		$result->{needs_object} = 1;
		$result->{type} = 'instance_method';
		$result->{details} = $is_instance_method;

		# 4. Check for inheritance - if parent class constructor should be used
		my $inheritance_info = $self->_check_inheritance_for_constructor(
			$current_package, $method_body
		);
		if ($inheritance_info && $inheritance_info->{use_parent_constructor}) {
			$result->{package} = $inheritance_info->{parent_class};
			$result->{details}{inheritance} = $inheritance_info;
			$self->_log(
				"  OBJECT: Method '$method_name' uses parent class constructor: $inheritance_info->{parent_class}"
			);
		}

		# 5. Check if constructor needs specific parameters
		my $constructor_needs = $self->_detect_constructor_requirements(
			$current_package, $result->{package}
		);
		if ($constructor_needs) {
			$result->{constructor_params} = $constructor_needs;
			$result->{details}{constructor_requirements} = $constructor_needs;
			$self->_log(
				"  OBJECT: Constructor for $result->{package} requires parameters"
			);
		}

		# Return the package name (or parent package) that needs instantiation
		return $result->{package};
	}

	# 6. Check for class methods that might need objects from other classes
	my $needs_other_object = $self->_detect_external_object_dependency($method_body);
	if ($needs_other_object) {
		$result->{needs_object} = 1;
		$result->{type} = 'external_dependency';
		$result->{package} = $needs_other_object->{package}
			if $needs_other_object->{package};
		$result->{details} = $needs_other_object;

		$self->_log(
			"  OBJECT: Method '$method_name' depends on external object: $needs_other_object->{package}"
		);
		return $result->{package} if $result->{package};
	}

	# Factory method only if NOT instance-based
	if ($is_factory && !$skip_object) {
		$result->{needs_object} = 0;
		$result->{type} = 'factory';
		$result->{details} = $is_factory;
		$self->_log(
			"  OBJECT: Detected factory method '$method_name' returns $is_factory->{returns_class} objects"
		) if $is_factory->{returns_class};
	}

	return undef;
}

# --------------------------------------------------
# _detect_factory_method
#
# Purpose:    Detect whether a method is a factory
#             that creates and returns object
#             instances rather than operating on
#             an existing instance.
#
# Entry:      $method_name     - method name string.
#             $method_body     - method source string.
#             $current_package - current package name.
#             $method_info     - method hashref
#                                (optional).
#
# Exit:       Returns a factory_info hashref on
#             detection, or undef if the method
#             is not a factory.
#             The hashref includes: returns_class,
#             confidence, and one of:
#             returns_blessed, returns_new,
#             returns_factory_result, pod_hint.
#
# Side effects: None.
# --------------------------------------------------
sub _detect_factory_method {
	my ($self, $method_name, $method_body, $current_package, $method_info) = @_;

	my %factory_info;

	# Check method name patterns
	if ($method_name =~ /^(create_|make_|build_|get_)/i) {
		$factory_info{name_pattern} = 1;
	}

	# Look for object creation patterns in the method body
	if ($method_body) {
		# Pattern 1: Returns a blessed reference
		if ($method_body =~ /return\s+bless\s*\{[^}]*\},\s*['"]?(\w+(?:::\w+)*|\$\w+)['"]?/s ||
			$method_body =~ /bless\s*\{[^}]*\},\s*['"]?(\w+(?:::\w+)*|\$\w+)['"]?.*return/s) {
			my $class_name = $1;

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

			$factory_info{returns_blessed} = 1;
			$factory_info{confidence} = 'high';
			return \%factory_info;
		}

		# Pattern 2: Returns ->new() call on class or $self
		if ($method_body =~ /return\s+([\$\w:]+)->new\(/s ||
			$method_body =~ /([\$\w:]+)->new\(.*return/s) {
			my $target = $1;

			# Determine what class is being instantiated
			if ($target eq '$self' || $target eq 'shift' || $target =~ /^\$/) {
				$factory_info{returns_class} = $current_package;
				$factory_info{self_new} = 1;
			} elsif ($target =~ /::/) {
				$factory_info{returns_class} = $target;
				$factory_info{external_class} = 1;
			} else {
				$factory_info{returns_class} = $target;
			}

			$factory_info{returns_new} = 1;
			$factory_info{confidence} = 'medium';
			return \%factory_info;
		}

		# Pattern 3: Returns an object from another factory method
		if ($method_body =~ /return\s+([\$\w:]+)->(create_|make_|build_|get_)/i ||
			$method_body =~ /([\$\w:]+)->(create_|make_|build_|get_).*return/si) {
			$factory_info{returns_factory_result} = 1;
			$factory_info{confidence} = 'low';
			return \%factory_info;
		}
	}

	# Check for return type hints in POD if available
	if ($method_info && ref($method_info) eq 'HASH' && $method_info->{pod}) {
		my $pod = $method_info->{pod};
		if ($pod =~ /returns?\s+(?:an?\s+)?(object|instance|new\s+\w+)/i) {
			$factory_info{pod_hint} = 1;
			$factory_info{confidence} = 'low';
			return \%factory_info;
		}
	}

	return undef;
}

# --------------------------------------------------
# _detect_singleton_pattern
#
# Purpose:    Detect singleton accessor methods
#             that return a shared instance rather
#             than creating a new object, by
#             checking the method name and body
#             for singleton patterns.
#
# Entry:      $method_name - method name string.
#             $method_body - method source string.
#
# Exit:       Returns a singleton_info hashref on
#             detection (always contains at least
#             name_pattern => 1), or undef if the
#             method name does not match the
#             singleton accessor pattern.
#
# Side effects: None.
#
# Notes:      Only fires for methods named
#             instance, get_instance, singleton,
#             or shared_instance. Methods not
#             matching these names always return
#             undef regardless of body content.
# --------------------------------------------------
sub _detect_singleton_pattern {
	my ($self, $method_name, $method_body) = @_;

	# Check method name patterns
	return undef unless $method_name =~ /^(instance|get_instance|singleton|shared_instance)$/i;

	my %singleton_info = (
		name_pattern => 1,
	);

	# Look for singleton patterns in code
	if ($method_body) {
		# Pattern 1: Static/state variable holding instance
		if ($method_body =~ /(?:my\s+)?(?:our\s+)?\$(?:instance|_instance|singleton)\b/s ||
			$method_body =~ /state\s+\$(?:instance|_instance|singleton)\b/s) {
			$singleton_info{static_variable} = 1;
			$singleton_info{confidence} = 'high';
		}

		# Pattern 2: Returns $instance if defined (with better regex)
		if ($method_body =~ /return\s+\$instance\s+if\s+(?:defined\s+)?\$instance/ ||
			$method_body =~ /unless\s+\$instance.*?=\s*.*?new/) {
			$singleton_info{returns_instance} = 1;
			$singleton_info{confidence} = 'high';
		}

		# Pattern 3: ||= new() pattern (with better regex)
		if ($method_body =~ /\$instance\s*\|\|=\s*.*?new/ ||
			$method_body =~ /\$instance\s*=\s*.*?new\s+unless\s+(?:defined\s+)?\$instance/) {
			$singleton_info{lazy_initialization} = 1;
			$singleton_info{confidence} = 'medium';
		}

		# Pattern 4: Direct return of $instance variable
		if ($method_body =~ /return\s+\$instance;/) {
			$singleton_info{returns_instance} = 1;
			$singleton_info{confidence} = 'high' unless $singleton_info{confidence};
		}
	}

	return \%singleton_info if keys %singleton_info > 0;	# Need at least name pattern

	return undef;
}

# --------------------------------------------------
# _detect_instance_method
#
# Purpose:    Detect whether a method is an
#             instance method that requires a
#             blessed object ($self) to be called,
#             through multiple detection patterns
#             of varying confidence.
#
# Entry:      $method_name - method name string.
#             $method_body - method source string.
#
# Exit:       Returns an instance_info hashref if
#             any instance method signal is found.
#             Returns undef if no signals are
#             detected.
#             The hashref may contain: explicit_self,
#             shift_self, uses_self,
#             accesses_object_data,
#             calls_instance_methods,
#             private_method, and confidence.
#
# Side effects: None.
# --------------------------------------------------
sub _detect_instance_method {
	my ($self, $method_name, $method_body) = @_;

	my %instance_info;

	# Pattern 1: my ($self, ...) = @_;
	if ($method_body =~ /my\s*\(\s*\$self\s*[,)]/) {
		$instance_info{explicit_self} = 1;
		$instance_info{confidence} = 'high';
	}

	# Pattern 2: my $self = shift;
	elsif ($method_body =~ /my\s+\$self\s*=\s*shift/) {
		$instance_info{shift_self} = 1;
		$instance_info{confidence} = 'high';
	}

	# Pattern 3: Uses $self->something (including hash/array access)
	# This catches $self->{value} and $self->[0] as well as $self->method()
	elsif ($method_body =~ /\$self\s*->\s*(\w+|[\{\[])/) {
		$instance_info{uses_self} = 1;
		$instance_info{confidence} = 'medium';
	}

	# Pattern 4: Accesses object data: $self->{...}, $self->[...]
	if ($method_body =~ /\$self\s*->\s*[\{\[]/) {
		$instance_info{accesses_object_data} = 1;
		$instance_info{confidence} = 'high' unless $instance_info{confidence} eq 'high';
	}

	# Pattern 5: Calls other instance methods on $self
	if ($method_body =~ /\$self\s*->\s*(\w+)\s*\(/s) {
		$instance_info{calls_instance_methods} = [];
		while ($method_body =~ /\$self\s*->\s*(\w+)\s*\(/g) {
			push @{$instance_info{calls_instance_methods}}, $1;
		}
		$instance_info{confidence} = 'high' if @{$instance_info{calls_instance_methods}};
	}

	# Pattern 6: Method name suggests instance method (not perfect but helpful)
	if ($method_name =~ /^_/ && $method_name !~ /^_new/) {
		# Private methods are usually instance methods
		$instance_info{private_method} = 1;
		$instance_info{confidence} = 'low' unless exists $instance_info{confidence};
	}

	return \%instance_info if keys %instance_info;
	return undef;
}

# --------------------------------------------------
# _check_inheritance_for_constructor
#
# Purpose:    Determine whether the current package
#             uses an inherited constructor from a
#             parent class, by examining use parent,
#             use base, and @ISA declarations.
#
# Entry:      $current_package - current package
#                                name string.
#             $method_body     - method source string
#                                (checked for SUPER::
#                                calls).
#
# Exit:       Returns an inheritance_info hashref
#             if any inheritance information is
#             found, or undef otherwise.
#             The hashref may contain:
#             parent_statements, isa_array,
#             uses_super, calls_super_new,
#             has_own_constructor,
#             use_parent_constructor, parent_class.
#
# Side effects: None.
# --------------------------------------------------
sub _check_inheritance_for_constructor {
	my ($self, $current_package, $method_body) = @_;

	my $doc = $self->{_document};
	return undef unless $doc;

	my %inheritance_info;

	# 1. Look for parent/base statements
	my @parent_classes;

	# Find all 'use parent' or 'use base' statements
	my $includes = $doc->find('PPI::Statement::Include') || [];
	foreach my $inc (@$includes) {
		my $content = $inc->content;
		if ($content =~ /use\s+(parent|base)\s+['"]?([\w:]+)['"]?/) {
			push @parent_classes, $2;
			$inheritance_info{parent_statements} = \@parent_classes;
		}
		# Also check for multiple parents: use parent qw(Class1 Class2)
		if ($content =~ /use\s+(parent|base)\s+qw?[\(\[]?(.+?)[\)\]]?;/) {
			my $parents = $2;
			my @multi_parents = split /\s+/, $parents;
			push @parent_classes, @multi_parents;
			$inheritance_info{parent_statements} = \@parent_classes;
		}
	}

	# 2. Look for @ISA assignments (with or without 'our')
	my $isas = $doc->find('PPI::Statement::Variable') || [];
	foreach my $isa (@$isas) {
		my $content = $isa->content();
		# Match both "our @ISA = qw(...)" and "@ISA = qw(...)"
		if ($content =~ /(?:our\s+)?\@ISA\s*=\s*qw?[\(\[]?(.+?)[\)\]]?/) {
			my $parents = $1;
			my @isa_parents = split(/\s+/, $parents);
			push @parent_classes, @isa_parents;
			$inheritance_info{isa_array} = \@isa_parents;
		}
	}

	# Also look for @ISA in regular statements
	my $statements = $doc->find('PPI::Statement') || [];
	foreach my $stmt (@$statements) {
		my $content = $stmt->content;
		if ($content =~ /\@ISA\s*=\s*qw?[\(\[]?(.+?)[\)\]]?/) {
			my $parents = $1;
			my @isa_parents = split(/\s+/, $parents);
			push @parent_classes, @isa_parents;
			$inheritance_info{isa_array} = \@isa_parents;
		}
	}

	# 3. Check if method uses SUPER:: calls
	if ($method_body && $method_body =~ /SUPER::/) {
		$inheritance_info{uses_super} = 1;
		if ($method_body =~ /SUPER::new/) {
			$inheritance_info{calls_super_new} = 1;
		}
	}

	# 4. Check if current package has its own new method
	my $has_own_new = $doc->find(sub {
		$_[1]->isa('PPI::Statement::Sub') &&
		$_[1]->name eq 'new'
	});

	if ($has_own_new) {
		$inheritance_info{has_own_constructor} = 1;
	} elsif (@parent_classes) {
		# No own constructor, but has parents - might need parent constructor
		$inheritance_info{use_parent_constructor} = 1;
		$inheritance_info{parent_class} = $parent_classes[0];	# Use first parent
	}

	return \%inheritance_info if keys %inheritance_info;
	return undef;
}

# --------------------------------------------------
# _detect_constructor_requirements
#
# Purpose:    Analyse the new() method of the
#             current or target package to determine
#             what parameters the constructor
#             requires, including required and
#             optional parameters and their defaults.
#
# Entry:      $current_package - the package being
#                                analysed.
#             $target_package  - the package whose
#                                constructor will
#                                be called (may
#                                differ from current
#                                for inherited
#                                constructors).
#
# Exit:       Returns a requirements hashref on
#             success, or undef if no new() method
#             is found. For external classes,
#             returns a minimal hashref with
#             external_class => 1.
#
# Side effects: None.
# --------------------------------------------------
sub _detect_constructor_requirements {
	my ($self, $current_package, $target_package) = @_;

	my $doc = $self->{_document};
	return undef unless $doc;

	# If target is different from current, we can't analyze it
	# (external class, parent class in different file)
	if ($target_package ne $current_package) {
		return {
			external_class => 1,
			package => $target_package,
			note => "Constructor for external class $target_package - parameters unknown"
		};
	}

	# Find the new method in current package
	my $new_method = $doc->find_first(sub {
		$_[1]->isa('PPI::Statement::Sub') &&
		$_[1]->name eq 'new'
	});

	return undef unless $new_method;

	my %requirements;

	# Get method body
	my $body = $new_method->content;

	# Look for parameter extraction patterns - handle both $self and $class
	if ($body =~ /my\s*\(\s*\$(self|class)\s*,\s*(.+?)\)\s*=\s*\@_/s) {
		my $params = $2;
		my @param_names = $params =~ /\$(\w+)/g;

		if (@param_names) {
			$requirements{parameters} = \@param_names;
			$requirements{parameter_count} = scalar @param_names;
		}
	}

	# Look for shift patterns
	my @shift_params;
	while ($body =~ /my\s+\$(\w+)\s*=\s*shift/g) {
		push @shift_params, $1;
	}
	# Remove $self or $class if present
	@shift_params = grep { $_ !~ /^(self|class)$/i } @shift_params;

	if (@shift_params) {
		$requirements{parameters} = \@shift_params;
		$requirements{parameter_count} = scalar @shift_params;
		$requirements{shift_pattern} = 1;
	}

	# Look for validation of parameters (more flexible pattern)
	my @required_params;
	if ($body =~ /croak.*unless.*(?:defined\s+)?\$(\w+)/g) {
		push @required_params, $1;
	}
	if ($body =~ /die.*unless.*(?:defined\s+)?\$(\w+)/g) {
		push @required_params, $1;
	}

	if (@required_params) {
		$requirements{required_parameters} = \@required_params;
	}

	# Look for default values (optional parameters)
	my @optional_params;
	my %default_values;

	# Use the new _extract_default_value method
	# Check for each parameter in the constructor body
	if ($requirements{parameters}) {
		foreach my $param (@{$requirements{parameters}}) {
			my $default = $self->_extract_default_value($param, $body);
			if (defined $default) {
				push @optional_params, $param;
				$default_values{$param} = $default;
			}
		}
	}

	if (@optional_params) {
		$requirements{optional_parameters} = \@optional_params;
		$requirements{default_values} = \%default_values;
	}

	return \%requirements if keys %requirements;
	return undef;
}


# --------------------------------------------------
# _detect_external_object_dependency
#
# Purpose:    Detect whether a method creates or
#             depends on objects from classes other
#             than the current package, by scanning
#             for ->new() calls on named classes
#             and method calls on typed variables.
#
# Entry:      $method_body - method source string.
#                            May be undef.
#
# Exit:       Returns a dependency_info hashref if
#             external object usage is found, or
#             undef otherwise.
#             The hashref may contain:
#             creates_objects (arrayref of class
#             names), uses_objects (arrayref of
#             class names), and package (the primary
#             dependency class).
#
# Side effects: None.
# --------------------------------------------------
sub _detect_external_object_dependency {
	my ($self, $method_body) = @_;

	return undef unless $method_body;

	my %dependency_info;

	# Pattern 1: Creates objects of other classes with ->new() or ->create()
	# Reset pos for global match
	pos($method_body) = 0;
	while ($method_body =~ /(\w+(?:::\w+)*)->(?:new|create)\(/g) {
		my $class = $1;
		next if $class eq 'main' || $class eq '__PACKAGE__' || $class =~ /^\$/;
		push @{$dependency_info{creates_objects}}, $class;
	}

	if ($dependency_info{creates_objects}) {
		# Remove duplicates
		my %seen;
		$dependency_info{creates_objects} = [grep { !$seen{$_}++ } @{$dependency_info{creates_objects}}];
		$dependency_info{package} = $dependency_info{creates_objects}[0];
	}

	# Pattern 2: Calls methods on objects from other classes
	if ($method_body =~ /\$(\w+)->\w+\(/g) {
		my %object_vars;
		while ($method_body =~ /\$(\w+)->\w+\(/g) {
			$object_vars{$1}++;
		}

		# Try to determine type of object variables
		my @object_classes;
		foreach my $var (keys %object_vars) {
			# Look for type declarations or assignments
			if ($method_body =~ /my\s+\$$var\s*=\s*(\w+(?:::\w+)+)->(?:new|create)/) {
				push @object_classes, $1;
			} elsif ($method_body =~ /my\s+\$$var\s*=\s*(\w+(?:::\w+)+)->/) {
				push @object_classes, $1;
			}
		}

		if (@object_classes) {
			$dependency_info{uses_objects} = \@object_classes;
			$dependency_info{package} = $object_classes[0] unless $dependency_info{package};
		}
	}

	# Pattern 3: Receives objects as parameters (type hints in comments/POD)
	# This would need integration with parameter analysis

	return \%dependency_info if keys %dependency_info;
	return undef;
}

# --------------------------------------------------
# _get_parent_class
#
# Purpose:    Find the first parent class of the
#             current package by searching the
#             PPI document for use parent, use base,
#             or our @ISA declarations.
#
# Entry:      None (operates on $self->{_document}).
#
# Exit:       Returns the parent class name string,
#             or undef if no parent is found.
#
# Side effects: None.
# --------------------------------------------------
sub _get_parent_class {
	my $self = $_[0];

	my $doc = $self->{_document};
	return unless $doc;

	# Look for use parent statements
	my $parent_stmt = $doc->find_first(sub {
		$_[1]->isa('PPI::Statement::Include') &&
		$_[1]->type eq 'use' &&
		$_[1]->module =~ /^(parent|base)$/ &&
		$_[1]->arguments =~ /['"](\w+(?:::\w+)*)['"]/
	});
	if ($parent_stmt) {
		my $parent = $1;
		return $parent;
	}

	# Look for @ISA assignment
	my $isa_stmt = $doc->find_first(sub {
		$_[1]->isa('PPI::Statement') &&
		$_[1]->content =~ /our\s+\@ISA\s*=\s*\(\s*['"](\w+(?:::\w+)*)['"]\s*\)/
	});
	if ($isa_stmt && $isa_stmt->content =~ /['"](\w+(?:::\w+)*)['"]/) {
		return $1;
	}

	return;
}

# --------------------------------------------------
# _get_class_for_instance_method
#
# Purpose:    Determine which class should be used
#             for object instantiation when testing
#             an instance method, preferring the
#             current package if it has a new()
#             method, falling back to the parent
#             class otherwise.
#
# Entry:      None (operates on $self->{_document}).
#
# Exit:       Returns the package name string to
#             use for instantiation. Returns
#             'UNKNOWN_PACKAGE' if no package
#             statement is found.
#
# Side effects: Stores the package name in
#               $self->{_package_name} if not
#               already set.
# --------------------------------------------------
sub _get_class_for_instance_method {
	my $self = $_[0];

	# Get the current package
	my $doc = $self->{_document};
	my $package_stmt = $doc->find_first('PPI::Statement::Package');
	return 'UNKNOWN_PACKAGE' unless $package_stmt;
	my $package_name = $package_stmt->namespace;
	$self->{_package_name} //= $package_name;

	# Check if the current package has a 'new' method
	my $has_new = $doc->find(sub {
		$_[1]->isa('PPI::Statement::Sub') && $_[1]->name eq 'new'
	});

	if ($has_new) {
		return $package_name;
	}

	# Otherwise, try to get the parent class
	my $parent = $self->_get_parent_class();
	return $parent if $parent;

	# Fallback to current package
	return $package_name;
}

# --------------------------------------------------
# _extract_default_value
#
# Purpose:    Extract a default value for a named
#             parameter from a method body by
#             matching multiple common Perl default
#             assignment idioms.
#
# Entry:      $param - parameter name string.
#             $code  - method body source string.
#
# Exit:       Returns the cleaned default value
#             scalar on success, or undef if no
#             default assignment pattern is found.
#
# Side effects: None.
#
# Notes:      Eight patterns are tried in order:
#             ||, //=, defined ternary, unless
#             defined, ||=, //, multi-line if
#             !defined, unless defined block.
#             Comment lines are stripped from the
#             code before matching to avoid false
#             positives. Delegates to
#             _clean_default_value for value
#             normalisation.
# --------------------------------------------------
sub _extract_default_value {
	my ($self, $param, $code) = @_;

	return undef unless $param && $code;

	# Clean up the code for easier pattern matching
	# Remove comments to avoid false positives
	my $clean_code = $code;
	$clean_code =~ s/#.*$//gm;
	$clean_code =~ s/^\s+|\s+$//g;

	# Pattern 1: $param = $param || 'default_value'
	# Also handles: $param = $arg || 'default'
	if ($clean_code =~ /\$$param\s*=\s*(?:\$$param|\$[a-zA-Z_]\w*)\s*\|\|\s*([^;]+)/) {
		my $default = $1;
		$default =~ s/\s*;\s*$//;
		$default = $self->_clean_default_value($default);
		return $default if defined $default;
	}

	# Pattern 2: $param //= 'default_value'
	if ($clean_code =~ /\$$param\s*\/\/=\s*([^;]+)/) {
		my $default = $1;
		$default =~ s/\s*;\s*$//;
		$default = $self->_clean_default_value($default);
		return $default if defined $default;
	}

	# Pattern 3: $param = defined $param ? $param : 'default'
	# Also handles: $param = defined $arg ? $arg : 'default'
	if ($clean_code =~ /\$$param\s*=\s*defined\s+(?:\$$param|\$[a-zA-Z_]\w*)\s*\?\s*(?:\$$param|\$[a-zA-Z_]\w*)\s*:\s*([^;]+)/) {
		my $default = $1;
		$default =~ s/\s*;\s*$//;
		$default = $self->_clean_default_value($default);
		return $default if defined $default;
	}

	# Pattern 4: $param = 'default' unless defined $param;
	if ($clean_code =~ /\$$param\s*=\s*([^;]+?)\s+unless\s+defined\s+(?:\$$param|\$[a-zA-Z_]\w*)/) {
		my $default = $1;
		$default = $self->_clean_default_value($default);
		return $default if defined $default;
	}

	# Pattern 5: $param ||= 'default'
	if ($clean_code =~ /\$$param\s*\|\|=\s*([^;]+)/) {
		my $default = $1;
		$default =~ s/\s*;\s*$//;
		$default = $self->_clean_default_value($default);
		return $default if defined $default;
	}

	# Pattern 6: $param = $arg // 'default'
	if ($clean_code =~ /\$$param\s*=\s*(?:\$$param|\$[a-zA-Z_]\w*)\s*\/\/\s*([^;]+)/) {
		my $default = $1;
		$default =~ s/\s*;\s*$//;
		$default = $self->_clean_default_value($default);
		return $default if defined $default;
	}

	# Pattern 7: Multi-line: if (!defined $param) { $param = 'default'; }
	if ($clean_code =~ /if\s*\(\s*!defined\s+\$$param\s*\)\s*\{[^}]*\$$param\s*=\s*([^;]+)/s) {
		my $default = $1;
		$default =~ s/\s*;\s*$//;
		$default = $self->_clean_default_value($default);
		return $default if defined $default;
	}

	# Pattern 8: unless (defined $param) { $param = 'default'; }
	if ($clean_code =~ /unless\s*\(\s*defined\s+\$$param\s*\)\s*\{[^}]*\$$param\s*=\s*([^;]+)/s) {
		my $default = $1;
		$default =~ s/\s*;\s*$//;
		$default = $self->_clean_default_value($default);
		return $default if defined $default;
	}

	return undef;
}

# --------------------------------------------------
# _extract_test_hints
#
# Purpose:    Extract structured test hints from
#             a method's code and schema, including
#             boundary values, invalid inputs, and
#             valid input examples from POD.
#
# Entry:      $method - method hashref.
#             $schema - schema hashref as built so
#                       far by _analyze_method.
#
# Exit:       Returns a hints hashref with keys:
#             boundary_values, invalid_inputs,
#             equivalence_classes, valid_inputs.
#             Keys with empty arrays are deleted
#             before returning.
#
# Side effects: None.
# --------------------------------------------------
sub _extract_test_hints {
	my ($self, $method, $schema) = @_;

	my %hints = (
		boundary_values => [],
		invalid_inputs => [],
		equivalence_classes => [],
		valid_inputs => [],
	);

	my $code = $method->{body};
	return {} unless $code;

	$self->_extract_invalid_input_hints($code, \%hints);
	$self->_extract_boundary_value_hints($code, \%hints);

	# prune empties
	for my $k (keys %hints) {
		delete $hints{$k} unless @{$hints{$k}};
	}

	return \%hints;
}

# --------------------------------------------------
# _extract_invalid_input_hints
#
# Purpose:    Detect likely invalid input values
#             from a method body by looking for
#             defined checks, empty string checks,
#             and negative number checks.
#
# Entry:      $code  - method body source string.
#             $hints - hints hashref (modified in
#                      place via invalid_inputs key).
#
# Exit:       Returns nothing. Appends to
#             $hints->{invalid_inputs}.
#
# Side effects: None.
# --------------------------------------------------
sub _extract_invalid_input_hints {
	my ($self, $code, $hints) = @_;

	# undef invalid
	if ($code =~ /defined\s*\(\s*\$/) {
		push @{ $hints->{invalid_inputs} }, 'undef';
	}

	# empty string invalid
	if ($code =~ /\beq\s*''/ || $code =~ /\blength\s*\(/) {
		push @{ $hints->{invalid_inputs} }, '';
	}

	# negative number invalid
	if ($code =~ /\$\w+\s*<\s*0/) {
		push @{ $hints->{invalid_inputs} }, -1;
	}
}

# --------------------------------------------------
# _extract_boundary_value_hints
#
# Purpose:    Extract numeric boundary values from
#             comparison operators in a method body,
#             adding both the boundary value and
#             the value one step either side.
#
# Entry:      $code  - method body source string.
#             $hints - hints hashref (modified in
#                      place via boundary_values key).
#
# Exit:       Returns nothing. Appends to and
#             deduplicates $hints->{boundary_values}.
#
# Side effects: None.
# --------------------------------------------------
sub _extract_boundary_value_hints {
	my ($self, $code, $hints) = @_;

	while ($code =~ /\$\w+\s*(<=|<|>=|>)\s*(\d+)/g) {
		my ($op, $n) = ($1, $2);

		if ($op eq '<') {
			push @{ $hints->{boundary_values} }, $n, $n+1;
		} elsif ($op eq '<=') {
			push @{ $hints->{boundary_values} }, $n, $n+1;
		} elsif ($op eq '>') {
			push @{ $hints->{boundary_values} }, $n, $n-1;
		} elsif ($op eq '>=') {
			push @{ $hints->{boundary_values} }, $n, $n-1;
		}
	}

	# Remove duplicates
	my %seen;
	$hints->{boundary_values} = [ grep { !$seen{$_}++ } @{ $hints->{boundary_values} } ];
}

# --------------------------------------------------
# _extract_pod_examples
#
# Purpose:    Extract example method call patterns
#             from a method's SYNOPSIS POD section
#             and add them as valid_inputs hints.
#
# Entry:      $pod   - POD string for the method.
#                      May be undef.
#             $hints - hints hashref (modified in
#                      place via valid_inputs key).
#
# Exit:       Returns $hints. Appends to
#             $hints->{valid_inputs}.
#
# Side effects: Logs the number of examples found
#               to stdout when verbose is set.
# --------------------------------------------------
sub _extract_pod_examples {
	my ($self, $pod, $hints) = @_;

	return $hints unless $pod;

	my @examples;

	# Extract SYNOPSIS
	return $hints unless $pod =~ /=head2\s+SYNOPSIS\s*(.+?)(?=\n=head|\z)/s;
	my $synopsis = $1;

	# Constructor examples: ->wilma(foo => 'bar', count => 5)
	while ($synopsis =~ /->([a-z_0-9A-Z]+)\s*\(\s*(.*?)\s*\)/sg) {
		my ($method, $args) = ($1, $2);
		my %kv;

		while ($args =~ /(\w+)\s*=>\s*(?:'([^']*)'|"([^"]*)"|(\d+))/g) {
			my $key = $1;
			my $val = defined $2 ? $2 : defined $3 ? $3 : $4;
			$kv{$key} = $val;
		}

		push @examples, {
			style => 'named',
			source => 'pod',
			args => \%kv,
			function => $method,	# TODO: add a sanity check this is what we expect
		} if %kv;
	}

	unless(scalar(@examples)) {
		# Positional calls: func($a, $b)
		while ($synopsis =~ /\b(\w+)\s*\(\s*(.*?)\s*\)/sg) {
			my ($func, $argstr) = ($1, $2);

			# next if $func eq 'new';	# already handled

			my @args = map { s/^\s+|\s+$//gr } split /\s*,\s*/, $argstr;

			next unless @args;

			push @examples, {
				style	=> 'positional',
				source	=> 'pod',
				function => $func,
				args	=> \@args,
			};
		}
	}

	if (scalar(@examples)) {
		$hints->{valid_inputs} ||= [];
		push @{ $hints->{valid_inputs} }, @examples;

		$self->_log("  POD: extracted " . scalar(@examples) . " example call(s)");
	}

	for my $k (qw(boundary_values invalid_inputs valid_inputs equivalence_classes)) {
		$hints->{$k} //= [];
	}

	return $hints;
}

# --------------------------------------------------
# _clean_default_value
#
# Purpose:    Normalise a raw default value string
#             extracted from code or POD into a
#             clean Perl scalar, handling quoted
#             strings, numeric literals, boolean
#             keywords, empty containers, and
#             undef.
#
# Entry:      $value     - raw value string.
#                          May be undef.
#             $from_code - true if the value was
#                          extracted from source
#                          code (affects escape
#                          sequence handling).
#
# Exit:       Returns the cleaned value:
#               undef   for undef or unparseable
#               {}      for empty hashrefs
#               []      for empty arrayrefs
#               integer for whole numbers
#               float   for decimal numbers
#               1 or 0  for boolean keywords
#               string  for everything else
#
# Side effects: None.
# --------------------------------------------------
sub _clean_default_value {
	my ($self, $value, $from_code) = @_;

	return unless defined $value;

	# Remove leading/trailing whitespace
	$value =~ s/^\s+|\s+$//g;

	# Remove parenthetical notes like "(no password)" only if there's content before them
	$value =~ s/(\S+)\s*\([^)]+\)\s*$/$1/;
	$value =~ s/^\s+|\s+$//g;

	# Handle chained || or // operators - extract the rightmost value
	if ($value =~ /\|\||\/{2}/) {
		my @parts = split(/\s*(?:\|\||\/{2})\s*/, $value);
		$value = $parts[-1];
		$value =~ s/^\s+|\s+$//g;
	}

	# Remove trailing semicolon if present
	$value =~ s/;\s*$//;

	# Handle q{}, qq{}, qw{} quotes
	if ($value =~ /^qq?\{(.*?)\}$/s) {
		$value = $1;
	} elsif ($value =~ /^qw\{(.*?)\}$/s) {
		$value = $1;
	} elsif ($value =~ /^q[qwx]?\s*([^a-zA-Z0-9\{\[])(.*?)\1$/s) {
		$value = $2;
	}

	# Handle quoted strings
	if ($value =~ /^(['"])(.*)\1$/s) {
		$value = $2;

		if ($from_code) {
			# In regex captures from source code, escape sequences are doubled
			# \\n in capture needs to become \n for the test
			$value =~ s/\\\\/\\/g;
		}

		# Only unescape the quote characters themselves
		$value =~ s/\\"/"/g;
		$value =~ s/\\'/'/g;

		# If NOT from code (i.e., from POD), interpret escape sequences
		unless ($from_code) {
			$value =~ s/\\n/\n/g;
			$value =~ s/\\r/\r/g;
			$value =~ s/\\t/\t/g;
			$value =~ s/\\\\/\\/g;
		}
	}

	# Sometimes trailing ) is left on
	if($value !~ /^\(/) {
		$value =~ s/\)$//;
	}

	# Handle Perl empty hash (must be before numeric/boolean checks)
	if ($value =~ /^\{\s*\}$/) {
		return {};
	}

	# Handle Perl empty list/array
	if ($value =~ /^\[\s*\]$/) {
		return [];
	}

	# Handle numeric values
	if ($value =~ /^-?\d+(?:\.\d+)?$/) {
		if ($value =~ /\./) {
			return $value + 0;
		} else {
			return int($value);
		}
	}

	# Handle boolean keywords
	if ($value =~ /^(true|false)$/i) {
		return lc($1) eq 'true' ? 1 : 0;
	}

	# Handle Perl boolean constants
	if ($value eq '1') {
		return 1;
	} elsif ($value eq '0') {
		return 0;
	}

	# Handle undef
	if ($value eq 'undef') {
		return undef;
	}

	# Handle __PACKAGE__ and similar constants
	if ($value eq '__PACKAGE__') {
		return '__PACKAGE__';
	}

	# Remove surrounding parentheses
	$value =~ s/^\((.+)\)$/$1/;

	# Handle expressions we can't evaluate
	if ($value =~ /^\$[a-zA-Z_]/ || $value =~ /\(.*\)/) {
		return if($value =~ /^\$|\@|\%/);	# The default is a value, so who knows its type?
		# return $value;
	}

	return $value;
}

# --------------------------------------------------
# _validate_pod_code_agreement
#
# Purpose:    Compare POD parameter documentation
#             against code-inferred parameters and
#             return a list of disagreements when
#             strict_pod mode is enabled.
#
# Entry:      $pod_params  - hashref of parameters
#                            from POD analysis.
#             $code_params - hashref of parameters
#                            from code analysis.
#             $method_name - method name string,
#                            used for context in
#                            error messages.
#
# Exit:       Returns a list of disagreement
#             strings. Returns an empty list if
#             all parameters agree.
#
# Side effects: None.
#
# Notes:      Type mismatches are classified as
#             either 'compatible' (e.g. integer vs
#             number) or 'incompatible' via
#             _types_are_compatible. $self and
#             $class are excluded from undocumented
#             parameter warnings in appropriate
#             context.
# --------------------------------------------------
sub _validate_pod_code_agreement {
	my ($self, $pod_params, $code_params, $method_name) = @_;

	my @errors;

	# Get all parameter names from both sources
	my %all_params = map { $_ => 1 } (keys %$pod_params, keys %$code_params);

	foreach my $param (sort keys %all_params) {
		my $pod = $pod_params->{$param} || {};
		my $code = $code_params->{$param} || {};

		# Check if parameter exists in both
		if (exists $pod_params->{$param} && !exists $code_params->{$param}) {
			push @errors, "Parameter '\$$param' documented in POD but not found in code signature";
			next;
		}

		if(!exists $pod_params->{$param} && exists $code_params->{$param}) {
			if(($method_name eq 'new') && ($param eq 'class')) {
				# $class is usually not documented in new()
				next;
			}
			if(($method_name ne 'new') && ($param eq 'self')) {
				# $self is usually not documented in a method
				next;
			}
			push @errors, "Parameter '\$$param' found in code but not documented in POD";
			next;
		}

		# Compare types if both exist
		if ($pod->{type} && $code->{type} && $pod->{type} ne $code->{type}) {
			if (!$self->_types_are_compatible($pod->{type}, $code->{type})) {
				push @errors, "Type mismatch for '\$$param': POD says '$pod->{type}', code suggests '$code->{type}' (incompatible)";
			} else {
				push @errors, "Type difference for '\$$param': POD says '$pod->{type}', code suggests '$code->{type}' (compatible)";
			}
		}

		# Compare optional status if both exist
		if (exists $pod->{optional} && exists $code->{optional} &&
			$pod->{optional} != $code->{optional}) {
			my $pod_status = $pod->{optional} ? 'optional' : 'required';
			my $code_status = $code->{optional} ? 'optional' : 'required';
			push @errors, "Optional status mismatch for '\$$param': POD says '$pod_status', code suggests '$code_status'";
		}

		# Check constraints (min/max)
		if (defined $pod->{min} && defined $code->{min} && $pod->{min} != $code->{min}) {
			push @errors, "Min constraint mismatch for '\$$param': POD says '$pod->{min}', code suggests '$code->{min}'";
		}

		if (defined $pod->{max} && defined $code->{max} && $pod->{max} != $code->{max}) {
			push @errors, "Max constraint mismatch for '\$$param': POD says '$pod->{max}', code suggests '$code->{max}'";
		}

		# Check regex patterns
		if ($pod->{matches} && $code->{matches} && $pod->{matches} ne $code->{matches}) {
			push @errors, "Pattern mismatch for '\$$param': POD says '$pod->{matches}', code suggests '$code->{matches}'";
		}
	}

	# Return errors (empty array if no errors)
	return @errors;
}

# --------------------------------------------------
# _validate_strictness_level
#
# Purpose:    Validate and normalise the strict_pod
#             option value accepted by new() into
#             an integer level: 0 (off), 1 (warn),
#             or 2 (fatal).
#
# Entry:      $val - the raw value passed to
#                    strict_pod in new(). May be
#                    undef, a number, or a string.
#
# Exit:       Returns 0, 1, or 2.
#             Croaks if the value is not recognised.
#
# Side effects: None.
# --------------------------------------------------
sub _validate_strictness_level {
	my $val = $_[0];

	return 0 unless defined $val;

	# Numeric
	return 0 if $val =~ /^(0|off|none)$/i;
	return 1 if $val =~ /^(1|warn|warning)$/i;
	return 2 if $val =~ /^(2|fatal|die|error)$/i;

	croak("Invalid value for --strict-pod: '$val' (use off|warn|fatal)");
}

# --------------------------------------------------
# _types_are_compatible
#
# Purpose:    Determine whether two type strings
#             are compatible for POD/code agreement
#             checking, allowing semantically
#             equivalent types (e.g. 'integer' and
#             'number') to coexist without
#             triggering a strict POD warning.
#
# Entry:      $pod_type  - type string from POD.
#             $code_type - type string from code.
#
# Exit:       Returns 1 if compatible, 0 otherwise.
#
# Side effects: None.
# --------------------------------------------------
sub _types_are_compatible {
	my ($self, $pod_type, $code_type) = @_;

	# Exact match is always compatible
	return 1 if $pod_type eq $code_type;

	# Define compatibility matrix
	my %compatible_types = (
		'integer' => ['number', 'scalar'],
		'number' => ['scalar'],
		'string' => ['scalar'],
		'scalar' => ['string', 'integer', 'number'],
		'arrayref' => ['array'],
		'hashref' => ['hash'],
	);

	# Check if code_type is compatible with pod_type
	if (my $allowed = $compatible_types{$pod_type}) {
		return grep { $_ eq $code_type } @$allowed;
	}

	# Check if pod_type is compatible with code_type
	if (my $allowed = $compatible_types{$code_type}) {
		return grep { $_ eq $pod_type } @$allowed;
	}

	return 0;	# Not compatible
}

=head2 generate_pod_validation_report

Generate a human-readable report of all POD/code disagreements found
across a set of extracted schemas.

    my $schemas = $extractor->extract_all(no_write => 1);
    my $report  = $extractor->generate_pod_validation_report($schemas);
    print $report;

=head3 Arguments

=over 4

=item * C<$schemas>

A hashref of method name to schema hashref as returned by
C<extract_all>. Required.

=back

=head3 Returns

A string containing the full validation report, or a single line
confirming all methods passed if no disagreements were found.

=head3 Side effects

None.

=head3 Notes

Only methods whose schemas contain a C<_pod_validation_errors> key
(populated when C<strict_pod> is 1 or 2) appear in the report. If
C<strict_pod> was 0 when C<extract_all> was called, this method will
always return the all-passed message.

=head3 API specification

=head4 input

    {
        self    => { type => OBJECT,  isa => 'App::Test::Generator::SchemaExtractor' },
        schemas => { type => HASHREF },
    }

=head4 output

    { type => SCALAR }

=cut

sub generate_pod_validation_report {
	my ($self, $schemas) = @_;

	my @reports;
	foreach my $method_name (sort keys %$schemas) {
		my $schema = $schemas->{$method_name};

		if (my $errors = $schema->{_pod_validation_errors}) {
			push @reports, "Method: $method_name";
			push @reports, "  Severity: " . ($schema->{_pod_disagreement} ? 'warning' : 'fatal');
			push @reports, "  Errors:";
			push @reports, map { "    - $_" } @$errors;
			push @reports, '';
		}
	}

	if (@reports) {
		return join("\n", "POD/Code Validation Report:", '=' x 40, '', @reports);
	} else {
		return 'POD/Code Validation: All methods passed consistency checks.';
	}
}

=head2 _log

Log a message if verbose mode is on.

=cut

sub _log {
	my($self, $msg) = @_;

	print "$msg\n" if $self->{verbose};
}

=head1 NOTES

This is pre-pre-alpha proof of concept code.
Nevertheless,
it is useful for creating a template which you can modify to create a working schema to pass into L<App::Test::Generator>.

=head1 SEE ALSO

=over 4

=item * L<App::Test::Generator> - Generate fuzz and corpus-driven test harnesses

Output from this module serves as input to that module.
So with well-documented code, you can automatically create your tests.

=item * L<App::Test::Generator::Template> - Template of the file of tests created by C<App::Test::Generator>

=back

=head1 AUTHOR

Nigel Horne, C<< <njh at nigelhorne.com> >>

Portions of this module's initial design and documentation were created with the
assistance of AI.

=cut

1;
