File Coverage

File:blib/lib/Params/Validate/Strict.pm
Coverage:84.7%

linestmtbrancondsubtimecode
1package Params::Validate::Strict;
2
3# FIXME: {max} doesn't play ball with non-ascii strings
4# TODO: better use of the description parameter in error messages
5# FIXME: ensure paramaters such as min => 1 length constraint applies to all values. In this case, undef should not pass through without a croak.
6
7
27
27
27
1768632
25
344
use strict;
8
27
27
27
42
26
432
use warnings;
9
10
27
27
27
50
18
593
use Carp;
11
27
27
27
42
27
292
use Exporter qw(import);        # Required for @EXPORT_OK
12
27
27
27
5590
163903
1030
use Encode qw(decode_utf8);
13
27
27
27
68
289
727
use List::Util 1.33 qw(any);    # Required for memberof validation
14
27
27
27
4471
113273
559
use Params::Get 0.13;
15
27
27
27
4385
101020
1345
use Readonly::Values::Boolean;
16
27
27
27
65
19
360
use Scalar::Util;
17
27
27
27
4390
174985
98939
use Unicode::GCString;
18
19our @ISA = qw(Exporter);
20our @EXPORT_OK = qw(validate_strict);
21
22 - 30
=head1 NAME

Params::Validate::Strict - Validates a set of parameters against a schema

=head1 VERSION

Version 0.35

=cut
31
32our $VERSION = '0.35';
33
34 - 1006
=head1 SYNOPSIS

    my $schema = {
        username => { type => 'string', min => 3, max => 50 },
        age => { type => 'integer', min => 0, max => 150 },
    };

    my $input = {
         username => 'john_doe',
         age => '30',        # Will be coerced to integer
    };

    my $validated_input = validate_strict(schema => $schema, input => $input);

    if(defined($validated_input)) {
        print "Example 1: Validation successful!\n";
        print 'Username: ', $validated_input->{username}, "\n";
        print 'Age: ', $validated_input->{age}, "\n";      # It's an integer now
    } else {
        print "Example 1: Validation failed: $@\n";
    }

Upon first reading this may seem overly complex and full of scope creep in a sledgehammer to crack a nut sort of way,
however two use cases make use of the extensive logic that comes with this code
and I have a couple of other reasons for writing it.

=over 4

=item * Black Box Testing

The schema can be plumbed into L<App::Test::Generator> to automatically create a set of black-box test cases.

=item * WAF

The schema can be plumbed into a WAF to protect from random user input.

=item * Improved API Documentation

Even if you don't use this module,
the specification syntax can help with documentation.

=item * I like it

I find it fun to write this,
even if nobody else finds it useful,
though I hope you will.

=back

=head1  METHODS

=head2 validate_strict

Validates a set of parameters against a schema.

This function takes two mandatory arguments:

=over 4

=item * C<schema> || C<members>

A reference to a hash that defines the validation rules for each parameter.
The keys of the hash are the parameter names, and the values are either a string representing the parameter type or a reference to a hash containing more detailed rules.

As an alternative the schema may be supplied as an B<arrayref of parameter
hashrefs>, where every element describes one parameter and carries a mandatory
C<name> key:

  $schema = [
    { name => 'username', type => 'string', min => 3, max => 50 },
    { name => 'age',      type => 'integer', min => 0, max => 150 },
    { name => 'role',     type => 'string', optional => 1, default => 'user' },
  ];

The arrayref form is normalised to the standard hashref form before any further
processing.  It is particularly useful when declaration order matters (e.g.
for positional or mixed calling conventions used by some CPAN modules).  The
C<name> key is consumed during normalisation and does not appear as a
validation rule.

For some sort of compatibility with L<Data::Processor>,
it is possible to wrap the schema within a hash like this:

  $schema = {
    description => 'Describe what this schema does',
    error_msg => 'An error message',
    schema => {
      # ... schema goes here
    }
  }

=item * C<args> || C<input>

A reference to a hash containing the parameters to be validated.
The keys of the hash are the parameter names, and the values are the parameter values.

=back

It takes optional arguments:

=over 4

=item * C<description>

What the schema does,
used in error messages.

=item * C<error_msg>

Overrides the default message when something doesn't validate.

=item * C<unknown_parameter_handler>

This parameter describes what to do when a parameter is given that is not in the schema of valid parameters.
It must be one of C<die>, C<warn>, or C<ignore>.

It defaults to C<die> unless C<carp_on_warn> is given, in which case it defaults to C<warn>.

=item * C<logger>

A logging object that understands messages such as C<error> and C<warn>.

=item * C<custom_types>

A reference to a hash that defines reusable custom types.
Custom types allow you to define validation rules once and reuse them throughout your schema,
making your validation logic more maintainable and readable.

Each custom type is defined as a hash reference containing the same validation rules available for regular parameters
(C<type>, C<min>, C<max>, C<matches>, C<memberof>, C<values>, C<enum>, C<notmemberof>, C<callback>, etc.).

  my $custom_types = {
    email => {
      type => 'string',
      matches => qr/^[\w\.\-]+@[\w\.\-]+\.\w+$/,
      error_msg => 'Invalid email address format'
    }, phone => {
      type => 'string',
      matches => qr/^\+?[1-9]\d{1,14}$/,
      min => 10,
      max => 15
    }, percentage => {
      type => 'number',
      min => 0,
      max => 100
    }, status => {
      type => 'string',
      memberof => ['draft', 'published', 'archived']
    }
  };

  my $schema = {
    user_email => { type => 'email' },
    contact_number => { type => 'phone', optional => 1 },
    completion => { type => 'percentage' },
    post_status => { type => 'status' }
  };

  my $validated = validate_strict(
    schema => $schema,
    input => $input,
    custom_types => $custom_types
  );

Custom types can be extended or overridden in the schema by specifying additional constraints:

  my $schema = {
    admin_username => {
      type => 'username',  # Uses custom type definition
      min => 5,            # Overrides custom type's min value
      max => 15            # Overrides custom type's max value
    }
  };

Custom types work seamlessly with nested schema, optional parameters, and all other validation features.

=back

The schema can define the following rules for each parameter:

=over 4

=item * C<type>

The data type of the parameter.
Valid types are C<string>, C<integer>, C<number>, C<float> C<boolean>, C<scalar>, C<scalarref>, C<stringref>, C<hashref>, C<arrayref>, C<object> and C<coderef>.
C<scalar> accepts any plain scalar value (string, number, boolean, etc.) but rejects references (arrayrefs, hashrefs, coderefs, objects).
C<scalarref> accepts a reference to a scalar value (e.g. C<\$var>) but rejects plain scalars, arrayrefs, hashrefs, coderefs, and objects.
C<stringref> accepts a reference to a scalar that contains a plain string (e.g. C<\$str>) and rejects plain scalars, references-to-references, arrayrefs, hashrefs, coderefs, and objects.
The C<min>/C<max> constraints apply to the B<length> (in characters) of the referenced string.
All other string rules (C<matches>, C<nomatch>, C<memberof>, etc.) operate on the dereferenced string value.
The validated return value is the dereferenced plain string.

A type can be an arrayref when a parameter could have different types (e.g. a string or an object).

  $schema = {
    username => [
      { type => 'string', min => 3, max => 50 },       # Name
      { type => 'integer', 'min' => 1 },  # UID that isn't root
    ]
  };

As a shorthand, C<type> itself may be an arrayref of type name strings (a I<union type>)
when all other constraints are shared between the alternatives:

  $schema = {
    data => { type => ['string', 'arrayref'] },
    id   => { type => ['string', 'integer'], optional => 1 },
  };

This is equivalent to the full array-of-rules form but more concise.
Every other key in the rule hash (C<optional>, C<min>, C<max>, C<matches>, etc.)
is inherited by each candidate type and validated independently against it.
Type names are tried left-to-right; the first match wins and its coercion
(e.g. numeric types) is propagated back to the caller.
If the value fails all candidate types, validation croaks with a message
listing the union members.

=item * C<can>

The parameter must be an object that understands the method C<can>.
C<can> can be a simple scalar string of a method name,
or an arrayref of a list of method names, all of which must be supported by the object.

   $schema = {
     gedcom => { type => object, can => 'get_individual' }
   }

=item * C<isa>

The parameter must be an object of type C<isa>.

=item * C<memberof>

The parameter must be a member of the given arrayref.

  status => {
    type => 'string',
    memberof => ['draft', 'published', 'archived']
  }

  priority => {
    type => 'integer',
    memberof => [1, 2, 3, 4, 5]
  }

For string types, the comparison is case-sensitive by default. Use the C<case_sensitive>
flag to control this behavior:

  # Case-sensitive (default) - must be exact match
  code => {
    type => 'string',
    memberof => ['ABC', 'DEF', 'GHI']
    # 'abc' will fail
  }

  # Case-insensitive - any case accepted
  code => {
    type => 'string',
    memberof => ['ABC', 'DEF', 'GHI'],
    case_sensitive => 0
    # 'abc', 'Abc', 'ABC' all pass, original case preserved
  }

For numeric types (C<integer>, C<number>, C<float>), the comparison uses numeric
equality (C<==> operator):

  rating => {
    type => 'number',
    memberof => [0.5, 1.0, 1.5, 2.0]
  }

Note that C<memberof> cannot be combined with C<min> or C<max> constraints as they
serve conflicting purposes - C<memberof> defines an explicit whitelist while C<min>/C<max>
define ranges.

=item * C<enum>

Same as C<memberof>.

=item * C<values>

Same as C<memberof>.

=item * C<notmemberof>

The parameter must not be a member of the given arrayref (blacklist).
This is the inverse of C<memberof>.

  username => {
    type => 'string',
    notmemberof => ['admin', 'root', 'system', 'administrator']
  }

  port => {
    type => 'integer',
    notmemberof => [22, 23, 25, 80, 443]  # Reserved ports
  }

Like C<memberof>, string comparisons are case-sensitive by default but can be controlled
with the C<case_sensitive> flag:

  # Case-sensitive (default)
  username => {
    type => 'string',
    notmemberof => ['Admin', 'Root']
    # 'admin' would pass, 'Admin' would fail
  }

  # Case-insensitive
  username => {
    type => 'string',
    notmemberof => ['Admin', 'Root'],
    case_sensitive => 0
    # 'admin', 'ADMIN', 'Admin' all fail
  }

The blacklist is checked after any C<transform> rules are applied, allowing you to
normalize input before checking:

  username => {
    type => 'string',
    transform => sub { lc($_[0]) },  # Normalize to lowercase
    notmemberof => ['admin', 'root', 'system']
  }

C<notmemberof> can be combined with other validation rules:

  username => {
    type => 'string',
    notmemberof => ['admin', 'root', 'system'],
    min => 3,
    max => 20,
    matches => qr/^[a-z0-9_]+$/
  }

=item * C<case_sensitive>

A boolean value indicating whether string comparisons should be case-sensitive.
This flag affects the C<memberof> and C<notmemberof> validation rules.
The default value is C<1> (case-sensitive).

When set to C<0>, string comparisons are performed case-insensitively, allowing values
with different casing to match. The original case of the input value is preserved in
the validated output.

  # Case-sensitive (default)
  status => {
    type => 'string',
    memberof => ['Draft', 'Published', 'Archived'] # Input 'draft' will fail - must match exact case
  }

  # Case-insensitive
  status => {
    type => 'string',
    memberof => ['Draft', 'Published', 'Archived'],
    case_sensitive => 0 # Input 'draft', 'DRAFT', or 'DrAfT' will all pass
  }

  country_code => {
    type => 'string',
    memberof => ['US', 'UK', 'CA', 'FR'],
    case_sensitive => 0  # Accept 'us', 'US', 'Us', etc.
  }

This flag has no effect on numeric types (C<integer>, C<number>, C<float>) as numbers
do not have case.

=item * C<min>/C<minimum>

The minimum length (for strings in characters not bytes), value (for numbers) or number of keys (for hashrefs).

=item * C<max>

The maximum length (for strings in characters not bytes), value (for numbers) or number of keys (for hashrefs).

=item * C<matches>

A regular expression that the parameter value must match.
Checks all members of arrayrefs.

=item * C<nomatch>

A regular expression that the parameter value must not match.
Checks all members of arrayrefs.

=item * C<position>

For routines and methods that take positional args,
this integer value defines which position the argument will be in.
If this is set for all arguments,
C<validate_strict> will return a reference to an array, rather than a reference to a hash.

=item * C<regex>

Synonym of matches

=item * C<description>

The description of the rule

=item * C<callback>

A code reference to a subroutine that performs custom validation logic.
The subroutine should accept the parameter value, the argument list and the schema as arguments and return true if the value is valid, false otherwise.

Use this to test more complex examples:

  my $schema = {
    even_number => {
      type => 'integer',
      callback => sub { $_[0] % 2 == 0 }
  };

  # Specify the arguments for a routine which has a second, optional argument, which, if given, must be less than or equal to the first
  my $schema = {
    first => {
      type => 'integer'
    }, second => {
      type => 'integer',
      optional => 1,
      callback => sub {
        my($value, $args) = @_;
        # The 'defined' is needed in case 'second' is evaluated before 'first'
        return (defined($args->{first}) && $value <= $args->{first}) ? 1 : 0
      }
    }
  };

=item * C<optional>

A boolean value indicating whether the parameter is optional.
If true, the parameter is not required.
If false or omitted, the parameter is required.

It can be a reference to a code snippet that will return true or false,
to determine if the parameter is optional or not.
The code will be called with two arguments: the value of the parameter and hash ref of all parameters:

  my $schema = {
    optional_field => {
      type => 'string',
      optional => sub {
        my ($value, $all_params) = @_;
        return $all_params->{make_optional} ? 1 : 0;
      }
    },
    make_optional => { type => 'boolean' }
  };

  my $result = validate_strict(schema => $schema, input => { make_optional => 1 });

If the parameter is not optional, it can be passed an undef value, which will not flag an error.
This is by design.
So this will not say that the required parameter 's' is missing:

    validate_strict(
        schema => { s => { type => 'string' } },
        input  => { s => undef },
    );

=item * C<default>

Populate missing optional parameters with the specified value.
Note that this value is not validated.

  username => {
    type => 'string',
    optional => 1,
    default => 'guest'
  }

=item * C<element_type>

Extends the validation to individual elements of arrays.

  tags => {
    type => 'arrayref',
    element_type => 'number',        # Float means the same
    min => 1,        # this is the length of the array, not the min value for each of the numbers. For that, add a C<schema> rule
    max => 5
  }

=item * C<error_msg>

The custom error message to be used in the event of a validation failure.

  age => {
    type => 'integer',
    min => 18,
    error_msg => 'You must be at least 18 years old'
  }

=item * C<nullable>

Like optional,
though this cannot be a coderef,
only a flag.

=item * C<schema>

You can validate nested hashrefs and arrayrefs using the C<schema> property:

    my $schema = {
        user => {    # 'user' is a hashref
            type => 'hashref',
            schema => {      # Specify what the elements of the hash should be
                name => { type => 'string' },
                age => { type => 'integer', min => 0 },
                hobbies => { # 'hobbies' is an array ref that this user has
                    type => 'arrayref',
                    schema => { type => 'string' }, # Validate each hobby
                    min => 1 # At least one hobby
                }
            }
        }, metadata => {
            type => 'hashref',
            schema => {
                created => { type => 'string' },
                tags => {
                    type => 'arrayref',
                    schema => {
                        type => 'string',
                        matches => qr/^[a-z]+$/      # Or you can say matches => '^[a-z]+$'
                    }
                }
            }
        }
    };

=item * C<validate>

A snippet of code that validates the input.
It's passed the input arguments,
and return a string containing a reason for rejection,
or undef if it's allowed.

    my $schema = {
      user => {
        type => 'string',
        validate => sub {
          if($_[0]->{'password'} eq 'bar') {
            return undef;
          }
          return 'Invalid password, try again';
        }
      }, password => {
         type => 'string'
      }
    };

=item * C<transform>

A code reference to a subroutine that transforms/sanitizes the parameter value before validation.
The subroutine should accept the parameter value as an argument and return the transformed value.
The transformation is applied before any validation rules are checked, allowing you to normalize
or clean data before it is validated.

Common use cases include trimming whitespace, normalizing case, formatting phone numbers,
sanitizing user input, and converting between data formats.

  # Simple string transformations
  username => {
    type => 'string',
    transform => sub { lc(trim($_[0])) },  # lowercase and trim
    matches => qr/^[a-z0-9_]+$/
  }

  email => {
    type => 'string',
    transform => sub { lc(trim($_[0])) },  # normalize email
    matches => qr/^[\w\.\-]+@[\w\.\-]+\.\w+$/
  }

  # Array transformations
  tags => {
    type => 'arrayref',
    transform => sub { [map { lc($_) } @{$_[0]}] },  # lowercase all elements
    element_type => 'string'
  }

  keywords => {
    type => 'arrayref',
    transform => sub {
      my @arr = map { lc(trim($_)) } @{$_[0]};
      my %seen;
      return [grep { !$seen{$_}++ } @arr];  # remove duplicates
    }
  }

  # Numeric transformations
  quantity => {
    type => 'integer',
    transform => sub { int($_[0] + 0.5) },  # round to nearest integer
    min => 1
  }

  # Sanitization
  slug => {
    type => 'string',
    transform => sub {
      my $str = lc(trim($_[0]));
      $str =~ s/[^\w\s-]//g;  # remove special characters
      $str =~ s/\s+/-/g;      # replace spaces with hyphens
      return $str;
    },
    matches => qr/^[a-z0-9-]+$/
  }

  phone => {
    type => 'string',
    transform => sub {
      my $str = $_[0];
      $str =~ s/\D//g;  # remove all non-digits
      return $str;
    },
    matches => qr/^\d{10}$/
  }

The C<transform> function is applied to the value before any validation checks (C<min>/C<minimum>, C<max>,
C<matches>, C<callback>, etc.), ensuring that validation rules are checked against the cleaned data.

Transformations work with all parameter types including nested structures:

  user => {
    type => 'hashref',
    schema => {
      name => {
        type => 'string',
        transform => sub { trim($_[0]) }
      }, email => {
        type => 'string',
        transform => sub { lc(trim($_[0])) }
      }
    }
  }

Transformations can also be defined in custom types for reusability:

  my $custom_types = {
    email => {
      type => 'string',
      transform => sub { lc(trim($_[0])) },
      matches => qr/^[\w\.\-]+@[\w\.\-]+\.\w+$/
    }
  };

Note that the transformed value is what gets returned in the validated result and is what
subsequent validation rules will check against. If a transformation might fail, ensure it
handles edge cases appropriately.
It is the responsibility of the transformer to ensure that the type of the returned value is correct,
since that is what will be validated.

Many validators also allow a code ref to be passed so that you can create your own, conditional validation rule, e.g.:

  $schema = {
    age => {
      type => 'integer',
      min => sub {
          my ($value, $all_params) = @_;
          return $all_params->{country} eq 'US' ? 21 : 18;
      }
    }
  }

=item * C<validator>

A synonym of C<validate>, for compatibility with L<Data::Processor>.

=item * C<cross_validation>

A reference to a hash that defines validation rules that depend on more than one parameter.
Cross-field validations are performed after all individual parameter validations have passed,
allowing you to enforce business logic that requires checking relationships between different fields.

Each cross-validation rule is a key-value pair where the key is a descriptive name for the validation
and the value is a code reference that accepts a hash reference of all validated parameters.
The subroutine should return C<undef> if the validation passes, or an error message string if it fails.

  my $schema = {
    password => { type => 'string', min => 8 },
    password_confirm => { type => 'string' }
  };

  my $cross_validation = {
    passwords_match => sub {
      my $params = shift;
      return $params->{password} eq $params->{password_confirm}
        ? undef : "Passwords don't match";
    }
  };

  my $validated = validate_strict(
    schema => $schema,
    input => $input,
    cross_validation => $cross_validation
  );

Common use cases include password confirmation, date range validation, numeric comparisons,
and conditional requirements:

  # Date range validation
  my $cross_validation = {
    date_range_valid => sub {
      my $params = shift;
      return $params->{start_date} le $params->{end_date}
        ? undef : "Start date must be before or equal to end date";
    }
  };

  # Price range validation
  my $cross_validation = {
    price_range_valid => sub {
      my $params = shift;
      return $params->{min_price} <= $params->{max_price}
        ? undef : "Minimum price must be less than or equal to maximum price";
    }
  };

  # Conditional required field
  my $cross_validation = {
    address_required_for_delivery => sub {
      my $params = shift;
      if ($params->{shipping_method} eq 'delivery' && !$params->{delivery_address}) {
        return "Delivery address is required when shipping method is 'delivery'";
      }
      return undef;
    }
  };

Multiple cross-validations can be defined in the same hash, and they are all checked in order.
If any cross-validation fails, the function will C<croak> with the error message returned by the validation:

  my $cross_validation = {
    passwords_match => sub {
      my $params = shift;
      return $params->{password} eq $params->{password_confirm}
        ? undef : "Passwords don't match";
    },
    emails_match => sub {
      my $params = shift;
      return $params->{email} eq $params->{email_confirm}
        ? undef : "Email addresses don't match";
    },
    age_matches_birth_year => sub {
      my $params = shift;
      my $current_year = (localtime)[5] + 1900;
      my $calculated_age = $current_year - $params->{birth_year};
      return abs($calculated_age - $params->{age}) <= 1
        ? undef : "Age doesn't match birth year";
    }
  };

Cross-validations receive the parameters after individual validation and transformation have been applied,
so you can rely on the data being in the correct format and type:

  my $schema = {
    email => {
      type => 'string',
      transform => sub { lc($_[0]) }  # Lowercased before cross-validation
    },
    email_confirm => {
      type => 'string',
      transform => sub { lc($_[0]) }
    }
  };

  my $cross_validation = {
    emails_match => sub {
      my $params = shift;
      # Both emails are already lowercased at this point
      return $params->{email} eq $params->{email_confirm}
        ? undef : "Email addresses don't match";
    }
  };

Cross-validations can access nested structures and optional fields:

  my $cross_validation = {
    guardian_required_for_minors => sub {
      my $params = shift;
      if ($params->{user}{age} < 18 && !$params->{guardian}) {
        return "Guardian information required for users under 18";
      }
      return undef;
    }
  };

=item * metadata

Fields starting with <_> are generated by L<App::Test::Generator::SchemaExtractor>,
and are currently ignored.

=item * schematic

TODO: gives an idea of what the field will be, e.g. C<filename>.

All cross-validations must pass for the overall validation to succeed.

=item * C<relationships>

A reference to an array that defines validation rules based on relationships between parameters.
Relationship validations are performed after all individual parameter validations have passed,
but before cross-validations.

Each relationship is a hash reference with a C<type> field and additional fields depending on the type:

=over 4

=item * B<mutually_exclusive>

Parameters that cannot be specified together.

  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.

  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.

  relationships => [
    {
      type => 'conditional_requirement',
      if => 'async',
      then_required => 'callback',
      description => 'When async is specified, callback is required'
    }
  ]

=item * B<dependency>

One parameter requires another to be present.

  relationships => [
    {
      type => 'dependency',
      param => 'port',
      requires => 'host',
      description => 'port requires host to be specified'
    }
  ]

=item * B<value_constraint>

Specific value requirements between parameters.

  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.

  relationships => [
    {
      type => 'value_conditional',
      if => 'mode',
      equals => 'secure',
      then_required => 'key',
      description => "When mode equals 'secure', key is required"
    }
  ]

=back

If a parameter is optional and its value is C<undef>,
validation will be skipped for that parameter.

If the validation fails, the function will C<croak> with an error message describing the validation failure.

If the validation is successful, the function will return a reference to a new hash containing the validated and (where applicable) coerced parameters.  Integer and number parameters will be coerced to their respective types.

The C<description> field is optional but recommended for clearer error messages.

=back

=head2 Example Usage

  my $schema = {
    host => { type => 'string' },
    port => { type => 'integer' },
    ssl => { type => 'boolean' },
    file => { type => 'string', optional => 1 },
    content => { type => 'string', optional => 1 }
  };

  my $relationships = [
    {
      type => 'mutually_exclusive',
      params => ['file', 'content']
    },
    {
      type => 'required_group',
      params => ['host', 'file']
    },
    {
      type => 'dependency',
      param => 'port',
      requires => 'host'
    },
    {
      type => 'value_constraint',
      if => 'ssl',
      then => 'port',
      operator => '==',
      value => 443
    }
  ];

  my $validated = validate_strict(
    schema => $schema,
    input => $input,
    relationships => $relationships
  );

=head1 MIGRATION FROM LEGACY VALIDATORS

=head2 From L<Params::Validate>

    # Old style
    validate(@_, {
        name => { type => SCALAR },
        age => { type => SCALAR, regex => qr/^\d+$/ }
    });

    # New style
    validate_strict(
        schema => {  # or "members"
            name => 'string',
            age => { type => 'integer', min => 0 }
        },
        args => { @_ }
    );

=head2 From L<Type::Params>

    # Old style
    my ($name, $age) = validate_positional \@_, Str, Int;

    # New style - requires converting to named parameters first
    my %args = (name => $_[0], age => $_[1]);
    my $validated = validate_strict(
        schema => { name => 'string', age => 'integer' },
        args => \%args
    );

=cut
1007
1008sub validate_strict
1009{
1010
1695
3963280
        my $params = Params::Get::get_params(undef, \@_);
1011
1012
1695
19945
        my $schema = $params->{'schema'} || $params->{'members'};
1013
1695
2648
        my $args = $params->{'args'} || $params->{'input'};
1014
1695
1178
        my $logger = $params->{'logger'};
1015
1695
1139
        my $custom_types = $params->{'custom_types'};
1016
1695
1174
        my $unknown_parameter_handler = $params->{'unknown_parameter_handler'};
1017
1695
1481
        if(!defined($unknown_parameter_handler)) {
1018
1669
1524
                if($params->{'carp_on_warn'}) {
1019
2
2
                        $unknown_parameter_handler = 'warn';
1020                } else {
1021
1667
1298
                        $unknown_parameter_handler = 'die';
1022                }
1023        }
1024
1025
1695
1457
        return $args if(!defined($schema));     # No schema, allow all arguments
1026
1027        # Accept arrayref schema: [{ name=>'param', type=>'...', ... }, ...]
1028        # Normalise to the standard named-parameter hashref form before further processing.
1029
1691
1563
        if(ref($schema) eq 'ARRAY') {
1030
13
15
                $schema = _schema_from_arrayref($schema, $logger);
1031        }
1032
1033        # Check if schema and args are references to hashes
1034
1688
1568
        if(ref($schema) ne 'HASH') {
1035
3
14
                _error($logger, 'validate_strict: schema must be a hash reference');
1036        }
1037
1038        # Inspired by Data::Processor
1039
1685
2109
        my $schema_description = $params->{'description'} || 'validate_strict';
1040
1685
1151
        my $error_msg = $params->{'error_msg'};
1041
1042
1685
1563
        if($schema->{'members'} && ($schema->{'description'} || $schema->{'error_msg'})) {
1043
8
10
                $schema_description = $schema->{'description'};
1044
8
9
                $error_msg = $schema->{'error_msg'};
1045
8
7
                $schema = $schema->{'members'};
1046                # The members value may also be in arrayref form
1047
8
12
                if(ref($schema) eq 'ARRAY') {
1048
1
1
                        $schema = _schema_from_arrayref($schema, $logger);
1049                }
1050        }
1051
1052
1685
2767
        if(exists($params->{'args'}) && (!defined($args))) {
1053
1
1
                $args = {};
1054        } elsif((ref($args) ne 'HASH') && (ref($args) ne 'ARRAY')) {
1055
2
9
                _error($logger, $error_msg || "$schema_description: args must be a hash or array reference");
1056        }
1057
1058
1683
1492
        if(ref($args) eq 'HASH') {
1059                # Named args
1060
1658
1658
1089
1665
                foreach my $key (keys %{$args}) {
1061
1976
1901
                        if(!exists($schema->{$key})) {
1062
31
53
                                if($unknown_parameter_handler eq 'die') {
1063
9
18
                                        _error($logger, "$schema_description: Unknown parameter '$key'");
1064                                } elsif($unknown_parameter_handler eq 'warn') {
1065
14
34
                                        _warn($logger, "$schema_description: Unknown parameter '$key'");
1066
14
1102
                                        next;
1067                                } elsif($unknown_parameter_handler eq 'ignore') {
1068
5
9
                                        if($logger) {
1069
1
3
                                                $logger->debug(__PACKAGE__ . ": $schema_description: Unknown parameter '$key'");
1070                                        }
1071
5
9
                                        next;
1072                                } else {
1073
3
7
                                        _error($logger, "$schema_description: '$unknown_parameter_handler' unknown_parameter_handler must be one of die, warn, ignore");
1074                                }
1075                        }
1076                }
1077        }
1078
1079        # Find out if this routine takes positional arguments
1080
1671
1265
        my $are_positional_args = -1;
1081
1671
1671
987
1498
        foreach my $key (keys %{$schema}) {
1082
1679
1517
                if(defined(my $rules = $schema->{$key})) {
1083
1677
1352
                        if(ref($rules) eq 'HASH') {
1084
1640
1481
                                if(!defined($rules->{'position'})) {
1085
1604
1307
                                        if($are_positional_args == 1) {
1086
0
0
                                                _error($logger, "::validate_strict: $key is missing position value");
1087                                        }
1088
1604
1030
                                        $are_positional_args = 0;
1089
1604
1316
                                        last;
1090                                }
1091
36
35
                                $are_positional_args = 1;
1092                        } else {
1093
37
29
                                $are_positional_args = 0;
1094
37
35
                                last;
1095                        }
1096                } else {
1097
2
2
                        $are_positional_args = 0;
1098
2
2
                        last;
1099                }
1100        }
1101
1102
1671
1236
        my %validated_args;
1103        my %invalid_args;
1104
1671
1671
983
1322
        foreach my $key (keys %{$schema}) {
1105
2134
1467
                my $rules = $schema->{$key};
1106
2134
1305
                my $value;
1107
2134
1569
                if($are_positional_args == 1) {
1108
36
49
                        if(ref($args) ne 'ARRAY') {
1109
0
0
                                _error($logger, "::validate_strict: position $rules->{position} given for '$key', but args isn't an array");
1110                        }
1111
36
36
26
52
                        $value = @{$args}[$rules->{'position'}];
1112                } else {
1113
2098
1457
                        $value = $args->{$key};
1114                }
1115
1116
2133
1623
                if(!defined($rules)) {  # Allow anything
1117
2
3
                        $validated_args{$key} = $value;
1118
2
3
                        next;
1119                }
1120
1121                # If rules are a simple type string
1122
2131
1803
                if(ref($rules) eq '') {
1123
30
32
                        $rules = { type => $rules };
1124                }
1125
1126
2131
1312
                my $is_optional = 0;
1127
1128
2131
1298
                my $rule_description = $schema_description;     # Can be overridden in each element
1129
1130
2131
1726
                if(ref($rules) eq 'HASH') {
1131
2111
1625
                        if(exists($rules->{'description'})) {
1132
9
11
                                $rule_description = $rules->{'description'};
1133                        }
1134                        # For stringref: validate and dereference before transform so that
1135                        # transform (and all subsequent rule handlers) see the plain string.
1136                        # Preserve the original ref so optional => CODE receives what the caller passed.
1137
2111
1339
                        my $pre_deref_value = $value;
1138
2111
4349
                        my $is_stringref_type = defined($value) && defined($rules->{'type'}) && !ref($rules->{'type'}) && lc($rules->{'type'}) eq 'stringref';
1139
2111
1717
                        if($is_stringref_type) {
1140
116
110
                                if(ref($value) ne 'SCALAR') {
1141
42
55
                                        my $got = ref($value) ? 'a ' . ref($value) . ' reference' : 'a plain scalar';
1142
42
85
                                        _error($logger, $rules->{'error_msg'} || "$rule_description: Parameter '$key' must be a string reference, not $got");
1143                                }
1144
74
74
46
76
                                $value = ${$value};
1145                        }
1146
2069
1926
                        if($rules->{'transform'} && defined($value)) {
1147
90
112
                                if(ref($rules->{'transform'}) eq 'CODE') {
1148
87
87
67
102
                                        $value = &{$rules->{'transform'}}($value);
1149                                } else {
1150
3
6
                                        _error($logger, "$rule_description: transforms must be a code ref");
1151                                }
1152                        }
1153
2066
2342
                        if(exists($rules->{optional})) {
1154
349
337
                                if(ref($rules->{'optional'}) eq 'CODE') {
1155                                        # For stringref the coderef receives the original SCALAR ref (what
1156                                        # the caller supplied), not the internally-dereferenced plain string.
1157                                        # For all other types the post-transform value is passed, as before.
1158
19
26
                                        my $opt_arg = $is_stringref_type ? $pre_deref_value : $value;
1159
19
19
16
25
                                        $is_optional = &{$rules->{optional}}($opt_arg, $args);
1160                                } else {
1161
330
292
                                        $is_optional = $rules->{'optional'};
1162                                }
1163                        } elsif($rules->{nullable}) {
1164
7
10
                                $is_optional = $rules->{'nullable'};
1165                        }
1166                }
1167
1168                # Handle optional parameters
1169
2086
3859
                if((ref($rules) eq 'HASH') && $is_optional) {
1170
342
219
                        my $look_for_default = 0;
1171
342
265
                        if($are_positional_args == 1) {
1172                                # if(!defined(@{$args}[$rules->{'position'}])) {
1173
7
12
                                if(!defined($args->[$rules->{position}])) {
1174
6
5
                                        $look_for_default = 1;
1175                                }
1176                        } else {
1177
335
321
                                if(!exists($args->{$key})) {
1178
173
128
                                        $look_for_default = 1;
1179                                }
1180                        }
1181
342
326
                        if($look_for_default) {
1182
179
174
                                if($are_positional_args == 1) {
1183
6
6
7
9
                                        if(scalar(@{$args}) < $rules->{'position'}) {
1184                                                # arg array is too short, so it must be missing
1185
1
3
                                                _error($logger, "$rule_description: Required parameter '$key' is missing");
1186
0
0
                                                next;
1187                                        }
1188                                }
1189
178
191
                                if(exists($rules->{'default'})) {
1190                                        # Populate missing optional parameters with the specified output values
1191
36
43
                                        $validated_args{$key} = $rules->{'default'};
1192
36
38
                                        next;   # default wins; do not fall through to the schema branch
1193                                }
1194
1195
142
147
                                if($rules->{'schema'}) {
1196
6
10
                                        $value = _apply_nested_defaults({}, $rules->{'schema'});
1197
6
6
5
18
                                        next unless scalar(%{$value});
1198                                        # The nested schema has a default value
1199                                } else {
1200
136
116
                                        next;   # optional and missing
1201                                }
1202                        }
1203                } elsif((ref($args) eq 'HASH') && !exists($args->{$key})) {
1204                        # The parameter is required
1205                        # Use exists rather than defined, so that an undefined value can be passed, but the key is there
1206
21
46
                        _error($logger, "$rule_description: Required parameter '$key' is missing");
1207                }
1208
1209                # Normalise union type shorthand: { type => ['string', 'integer'], ... }
1210                # into the array-of-rules form that the ARRAY handler below already supports.
1211                # Each candidate type inherits all other constraints from the parent rule
1212                # (min, max, matches, optional, etc.) so they are each fully validated.
1213                # Must run after optional/transform handling above but before rule dispatch below.
1214
1888
2424
                if(ref($rules) eq 'HASH' && ref($rules->{'type'}) eq 'ARRAY') {
1215
60
60
46
70
                        my %base = %{$rules};
1216
60
60
52
86
                        my @type_list = @{delete $base{'type'}};
1217
60
68
                        if(!@type_list) {
1218
2
3
                                _error($logger, "$rule_description: Parameter '$key': union type list must not be empty");
1219                        }
1220                        # Expand into one full rule hash per candidate type
1221
58
115
72
158
                        $rules = [ map { { %base, type => $_ } } @type_list ];
1222                }
1223
1224                # Validate based on rules
1225
1886
1537
                if(ref($rules) eq 'HASH') {
1226
1808
2823
                        if(defined(my $min = $rules->{'min'} // $rules->{'minimum'}) && defined(my $max = $rules->{'max'})) {
1227
149
154
                                if($min > $max) {
1228
7
16
                                        _error($logger, "validate_strict($key): min must be <= max ($min > $max)");
1229                                }
1230                        }
1231
1232                        # memberof and its synonym enum cannot be combined with min or max
1233
1801
2972
                        if($rules->{'memberof'} || $rules->{'enum'} || $rules->{'values'}) {
1234
131
259
                                if(defined(my $min = $rules->{'min'} // $rules->{'minimum'})) {
1235
8
16
                                        _error($logger, "validate_strict($key): min ($min) makes no sense with memberof/enum/values");
1236                                }
1237
123
143
                                if(defined(my $max = $rules->{'max'})) {
1238
5
9
                                        _error($logger, "validate_strict($key): max ($max) makes no sense with memberof/enum/values");
1239                                }
1240                        }
1241
1242
1788
1620
                        foreach my $rule_name (keys %$rules) {
1243
3005
2215
                                my $rule_value = $rules->{$rule_name};
1244
1245
3005
2939
                                if((ref($rule_value) eq 'CODE')
1246                                        && ($rule_name ne 'validate')
1247                                        && ($rule_name ne 'callback')
1248                                        && ($rule_name ne 'validator')
1249                                        && ($rule_name ne 'transform')  # already applied before this loop
1250                                        && ($rule_name ne 'optional')) {        # already applied before this loop
1251
16
16
8
15
                                        $rule_value = &{$rule_value}($value, $args);
1252                                }
1253
1254                                # Better OOP, the routine has been given an object rather than a scalar
1255
3005
3249
                                if(Scalar::Util::blessed($rule_value) && $rule_value->can('as_string')) {
1256
0
0
                                        $rule_value = $rule_value->as_string();
1257                                }
1258
1259
3005
6119
                                if($rule_name eq 'type') {
1260
1617
1190
                                        my $type = lc($rule_value);
1261
1262
1617
4198
                                        if(($type eq 'string') || ($type eq 'str')) {
1263
670
514
                                                if(ref($value)) {
1264
27
70
                                                        _error($logger, $rules->{'error_msg'} || "$rule_description: Parameter '$key' must be a string");
1265                                                }
1266
643
682
                                                unless((ref($value) eq '') || (defined($value) && length($value))) {    # Allow undef for optional strings
1267
0
0
                                                        _error($logger, $rules->{'error_msg'} || "$rule_description: Parameter '$key' must be a string");
1268                                                }
1269                                        } elsif(($type eq 'integer') || ($type eq 'int')) {
1270
273
238
                                                if(!defined($value)) {
1271
2
2
                                                        next;   # Skip if number is undefined
1272                                                }
1273
271
708
                                                if(!Scalar::Util::looks_like_number($value) || ($value - $value) != 0 || $value != int($value)) {
1274
30
37
                                                        if($rules->{'error_msg'}) {
1275
2
3
                                                                _error($logger, $rules->{'error_msg'});
1276                                                        } else {
1277
28
76
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must be an integer");
1278                                                        }
1279                                                }
1280
241
241
                                                $value = int($value); # Coerce to integer
1281                                        } elsif(($type eq 'number') || ($type eq 'float') || ($type eq 'num') || ($type eq 'double')) {
1282
82
86
                                                if(!defined($value)) {
1283
2
2
                                                        next;   # Skip if number is undefined
1284                                                }
1285
80
148
                                                if(!Scalar::Util::looks_like_number($value)) {
1286
5
8
                                                        if($rules->{'error_msg'}) {
1287
0
0
                                                                _error($logger, $rules->{'error_msg'});
1288                                                        } else {
1289
5
11
                                                                _error($logger, "$rule_description: Parameter '$key' must be a number");
1290                                                        }
1291                                                }
1292                                                # $value = eval $value; # Coerce to number (be careful with eval)
1293
75
119
                                                $value = 0 + $value;    # Numeric coercion
1294                                        } elsif($type eq 'arrayref') {
1295
91
114
                                                if(!defined($value)) {
1296
2
4
                                                        next;   # Skip if arrayref is undefined
1297                                                }
1298
89
140
                                                if(ref($value) ne 'ARRAY') {
1299
11
15
                                                        if($rules->{'error_msg'}) {
1300
0
0
                                                                _error($logger, $rules->{'error_msg'});
1301                                                        } else {
1302
11
23
                                                                _error($logger, "$rule_description: Parameter '$key' must be an arrayref, not " . ref($value));
1303                                                        }
1304                                                }
1305                                        } elsif($type eq 'hashref') {
1306
67
68
                                                if(!defined($value)) {
1307
2
2
                                                        next;   # Skip if hashref is undefined
1308                                                }
1309
65
109
                                                if(ref($value) ne 'HASH') {
1310
5
8
                                                        if($rules->{'error_msg'}) {
1311
0
0
                                                                _error($logger, $rules->{'error_msg'});
1312                                                        } else {
1313
5
10
                                                                _error($logger, "$rule_description: Parameter '$key' must be an hashref");
1314                                                        }
1315                                                }
1316                                        } elsif($type eq 'scalar') {
1317
113
124
                                                if(!defined($value)) {
1318
3
3
                                                        next;   # Skip if undefined
1319                                                }
1320
110
115
                                                if(ref($value)) {
1321
47
130
                                                        _error($logger, $rules->{'error_msg'} || "$rule_description: Parameter '$key' must be a scalar, not a " . ref($value) . ' reference');
1322                                                }
1323                                        } elsif($type eq 'scalarref') {
1324
69
63
                                                if(!defined($value)) {
1325
2
2
                                                        next;   # Skip if undefined
1326                                                }
1327
67
81
                                                if(ref($value) ne 'SCALAR') {
1328
41
47
                                                        my $got = ref($value) ? 'a ' . ref($value) . ' reference' : 'a plain scalar';
1329
41
88
                                                        _error($logger, $rules->{'error_msg'} || "$rule_description: Parameter '$key' must be a scalar reference, not $got");
1330                                                }
1331                                        } elsif($type eq 'stringref') {
1332
63
59
                                                if(!defined($value)) {
1333
2
3
                                                        next;   # Skip if undefined
1334                                                }
1335                                                # The early-deref block validated the SCALAR ref and set $value to the
1336                                                # plain string.  If transform subsequently returned a reference, reject it.
1337
61
75
                                                if(ref($value)) {
1338
2
6
                                                        _error($logger, $rules->{'error_msg'} || "$rule_description: Parameter '$key' stringref transform must return a plain string, not a " . ref($value) . ' reference');
1339                                                }
1340                                        } elsif(($type eq 'boolean') || ($type eq 'bool')) {
1341
66
65
                                                if(!defined($value)) {
1342
2
2
                                                        next;   # Skip if bool is undefined
1343                                                }
1344
64
177
                                                if(defined(my $b = $Readonly::Values::Boolean::booleans{$value})) {
1345
57
273
                                                        $value = $b;
1346                                                } else {
1347
7
27
                                                        if($rules->{'error_msg'}) {
1348
0
0
                                                                _error($logger, $rules->{'error_msg'});
1349                                                        } else {
1350
7
15
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must be a boolean");
1351                                                        }
1352                                                }
1353                                        } elsif($type eq 'coderef') {
1354
9
11
                                                if(!defined($value)) {
1355
1
1
                                                        next;   # Skip if code is undefined
1356                                                }
1357
8
14
                                                if(ref($value) ne 'CODE') {
1358
3
7
                                                        if($rules->{'error_msg'}) {
1359
0
0
                                                                _error($logger, $rules->{'error_msg'});
1360                                                        } else {
1361
3
8
                                                                _error($logger, "$rule_description: Parameter '$key' must be a coderef, not a ref to " . ref($value));
1362                                                        }
1363                                                }
1364                                        } elsif($type eq 'object') {
1365
54
55
                                                if(!defined($value)) {
1366
1
1
                                                        next;   # Skip if object is undefined
1367                                                }
1368
53
94
                                                if(!Scalar::Util::blessed($value)) {
1369
4
7
                                                        if($rules->{'error_msg'}) {
1370
0
0
                                                                _error($logger, $rules->{'error_msg'});
1371                                                        } else {
1372
4
10
                                                                _error($logger, "$rule_description: Parameter '$key' must be an object");
1373                                                        }
1374                                                }
1375                                        } elsif(my $custom_type = $custom_types->{$type}) {
1376
57
55
                                                if($custom_type->{'transform'}) {
1377                                                        # The custom type has a transform embedded within it
1378
9
13
                                                        if(ref($custom_type->{'transform'}) eq 'CODE') {
1379
8
8
6
15
                                                                $value = &{$custom_type->{'transform'}}($value);
1380                                                        } else {
1381
1
5
                                                                _error($logger, "$rule_description: transforms must be a code ref");
1382
0
0
                                                                next;
1383                                                        }
1384                                                }
1385
56
351
                                                validate_strict({ input => { $key => $value }, schema => { $key => $custom_type }, custom_types => $custom_types });
1386                                        } else {
1387
3
5
                                                _error($logger, "$rule_description: Unknown type '$type'");
1388                                        }
1389                                } elsif(($rule_name eq 'min') || ($rule_name eq 'minimum')) {
1390
330
335
                                        if(!defined($rules->{'type'})) {
1391
0
0
                                                _error($logger, "$rule_description: Don't know type of '$key' to determine its minimum value $rule_value");
1392                                        }
1393
330
295
                                        my $type = lc($rules->{'type'});
1394
330
642
                                        if(exists($custom_types->{$type}->{'min'}) || exists($custom_types->{$type}->{minimum})) {
1395
3
6
                                                $rule_value = $custom_types->{$type}->{'min'} // $custom_types->{$type}->{minumum};
1396
3
3
                                                $type = $custom_types->{$type}->{'type'};
1397                                        }
1398
330
877
                                        if(($type eq 'string') || ($type eq 'str') || ($type eq 'stringref')) {
1399
123
150
                                                if($rule_value < 0) {
1400
3
6
                                                        if($rules->{'error_msg'}) {
1401
0
0
                                                                _error($logger, $rules->{'error_msg'});
1402                                                        } else {
1403
3
6
                                                                _error($logger, "$rule_description: String parameter '$key' has meaningless minimum value that is less than zero");
1404                                                        }
1405                                                }
1406
120
121
                                                if(!defined($value)) {
1407
0
0
                                                        next;   # Skip if string is undefined
1408                                                }
1409
120
137
                                                if(defined(my $len = _number_of_characters($value))) {
1410
120
283
                                                        if($len < $rule_value) {
1411
32
119
                                                                _error($logger, $rules->{'error_msg'} || "$rule_description: String parameter '$key' too short, ($len characters), must be at least $rule_value characters");
1412
0
0
                                                                $invalid_args{$key} = 1;
1413                                                        }
1414                                                } else {
1415
0
0
                                                        _error($logger, $rules->{'error_msg'} || "$rule_description: '$key' can't be decoded");
1416
0
0
                                                        $invalid_args{$key} = 1;
1417                                                }
1418                                        } elsif($type eq 'arrayref') {
1419
28
31
                                                if(!defined($value)) {
1420
0
0
                                                        next;   # Skip if array is undefined
1421                                                }
1422
28
39
                                                if(ref($value) ne 'ARRAY') {
1423
3
6
                                                        if($rules->{'error_msg'}) {
1424
0
0
                                                                _error($logger, $rules->{'error_msg'});
1425                                                        } else {
1426
3
6
                                                                _error($logger, "$rule_description: Parameter '$key' must be an arrayref, not " . ref($value));
1427                                                        }
1428                                                }
1429
25
25
20
46
                                                if(scalar(@{$value}) < $rule_value) {
1430
7
13
                                                        if($rules->{'error_msg'}) {
1431
0
0
                                                                _error($logger, $rules->{'error_msg'});
1432                                                        } else {
1433
7
13
                                                                _error($logger, "$rule_description: Parameter '$key' must be at least length $rule_value");
1434                                                        }
1435
0
0
                                                        $invalid_args{$key} = 1;
1436                                                }
1437                                        } elsif($type eq 'hashref') {
1438
13
16
                                                if(!defined($value)) {
1439
0
0
                                                        next;   # Skip if hash is undefined
1440                                                }
1441
13
13
9
22
                                                if(scalar(keys(%{$value})) < $rule_value) {
1442
7
11
                                                        if($rules->{'error_msg'}) {
1443
1
3
                                                                _error($logger, $rules->{'error_msg'});
1444                                                        } else {
1445
6
13
                                                                _error($logger, "$rule_description: Parameter '$key' must contain at least $rule_value keys");
1446                                                        }
1447
0
0
                                                        $invalid_args{$key} = 1;
1448                                                }
1449                                        } elsif(($type eq 'integer') || ($type eq 'number') || ($type eq 'float')) {
1450
163
149
                                                if(!defined($value)) {
1451
0
0
                                                        next;   # Skip if hash is undefined
1452                                                }
1453
163
196
                                                if(Scalar::Util::looks_like_number($value)) {
1454
162
196
                                                        if($value < $rule_value) {
1455
37
118
                                                                if($rules->{'error_msg'}) {
1456
7
14
                                                                        _error($logger, $rules->{'error_msg'});
1457                                                                } elsif(($type eq 'integer') && ($value == 0)) {
1458
2
4
                                                                        _error($logger, "$rule_description: Parameter '$key' ($value) must be a positive number");
1459                                                                } elsif(($type eq 'integer') && ($value == 1)) {
1460
0
0
                                                                        _error($logger, "$rule_description: Parameter '$key' ($value) must be a positive, non-zero number");
1461                                                                } else {
1462
28
63
                                                                        _error($logger, "$rule_description: Parameter '$key' ($value) must be at least $rule_value");
1463                                                                }
1464
0
0
                                                                $invalid_args{$key} = 1;
1465
0
0
                                                                next;
1466                                                        }
1467                                                } else {
1468
1
4
                                                        if($rules->{'error_msg'}) {
1469
0
0
                                                                _error($logger, $rules->{'error_msg'});
1470                                                        } else {
1471
1
3
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must be a number");
1472                                                        }
1473
0
0
                                                        next;
1474                                                }
1475                                        } else {
1476
3
8
                                                _error($logger, "$rule_description: Parameter '$key' of type '$type' has meaningless min value $rule_value");
1477                                        }
1478                                } elsif($rule_name eq 'max') {
1479
178
196
                                        if(!defined($rules->{'type'})) {
1480
0
0
                                                _error($logger, "$rule_description: Don't know type of '$key' to determine its maximum value $rule_value");
1481                                        }
1482
178
172
                                        my $type = lc($rules->{'type'});
1483
178
222
                                        if(exists($custom_types->{$type}->{'max'})) {
1484
4
4
                                                $rule_value = $custom_types->{$type}->{'max'};
1485
4
21
                                                $type = $custom_types->{$type}->{'type'};
1486                                        }
1487
178
520
                                        if(($type eq 'string') || ($type eq 'str') || ($type eq 'stringref')) {
1488
72
70
                                                if(!defined($value)) {
1489
0
0
                                                        next;   # Skip if string is undefined
1490                                                }
1491
72
84
                                                if(defined(my $len = _number_of_characters($value))) {
1492
72
164
                                                        if($len > $rule_value) {
1493
22
80
                                                                _error($logger, $rules->{'error_msg'} || "$rule_description: String parameter '$key' too long, ($len characters), must be no longer than $rule_value");
1494
0
0
                                                                $invalid_args{$key} = 1;
1495                                                        }
1496                                                } else {
1497
0
0
                                                        _error($logger, $rules->{'error_msg'} || "$rule_description: '$key' can't be decoded");
1498
0
0
                                                        $invalid_args{$key} = 1;
1499                                                }
1500                                        } elsif($type eq 'arrayref') {
1501
17
21
                                                if(!defined($value)) {
1502
0
0
                                                        next;   # Skip if string is undefined
1503                                                }
1504
17
26
                                                if(ref($value) ne 'ARRAY') {
1505
0
0
                                                        if($rules->{'error_msg'}) {
1506
0
0
                                                                _error($logger, $rules->{'error_msg'});
1507                                                        } else {
1508
0
0
                                                                _error($logger, "$rule_description: Parameter '$key' must be an arrayref, not " . ref($value));
1509                                                        }
1510                                                }
1511
17
17
15
30
                                                if(scalar(@{$value}) > $rule_value) {
1512
8
14
                                                        if($rules->{'error_msg'}) {
1513
0
0
                                                                _error($logger, $rules->{'error_msg'});
1514                                                        } else {
1515
8
17
                                                                _error($logger, "$rule_description: Parameter '$key' must contain no more than $rule_value items");
1516                                                        }
1517
0
0
                                                        $invalid_args{$key} = 1;
1518                                                }
1519                                        } elsif($type eq 'hashref') {
1520
13
14
                                                if(!defined($value)) {
1521
0
0
                                                        next;   # Skip if hash is undefined
1522                                                }
1523
13
13
11
22
                                                if(scalar(keys(%{$value})) > $rule_value) {
1524
7
10
                                                        if($rules->{'error_msg'}) {
1525
1
2
                                                                _error($logger, $rules->{'error_msg'});
1526                                                        } else {
1527
6
12
                                                                _error($logger, "$rule_description: Parameter '$key' must contain no more than $rule_value keys");
1528                                                        }
1529
0
0
                                                        $invalid_args{$key} = 1;
1530                                                }
1531                                        } elsif(($type eq 'integer') || ($type eq 'number') || ($type eq 'float')) {
1532
73
62
                                                if(!defined($value)) {
1533
0
0
                                                        next;   # Skip if hash is undefined
1534                                                }
1535
73
107
                                                if(Scalar::Util::looks_like_number($value)) {
1536
73
99
                                                        if($value > $rule_value) {
1537
17
96
                                                                if($rules->{'error_msg'}) {
1538
0
0
                                                                        _error($logger, $rules->{'error_msg'});
1539                                                                } elsif(($type eq 'integer') && ($value == 0)) {
1540
0
0
                                                                        _error($logger, "$rule_description: Parameter '$key' ($value) must be a negative number");
1541                                                                } elsif(($type eq 'integer') && ($value == -1)) {
1542
0
0
                                                                        _error($logger, "$rule_description: Parameter '$key' ($value) must be a negative, non-zero number");
1543                                                                } else {
1544
17
39
                                                                        _error($logger, "$rule_description: Parameter '$key' ($value) must be no more than $rule_value");
1545                                                                }
1546
0
0
                                                                $invalid_args{$key} = 1;
1547
0
0
                                                                next;
1548                                                        }
1549                                                } else {
1550
0
0
                                                        if($rules->{'error_msg'}) {
1551
0
0
                                                                _error($logger, $rules->{'error_msg'});
1552                                                        } else {
1553
0
0
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must be a number");
1554                                                        }
1555
0
0
                                                        next;
1556                                                }
1557                                        } else {
1558
3
7
                                                _error($logger, "$rule_description: Parameter '$key' of type '$type' has meaningless max value $rule_value");
1559                                        }
1560                                } elsif(($rule_name eq 'matches') || ($rule_name eq 'regex')) {
1561
121
123
                                        if(!defined($value)) {
1562
1
1
                                                next;   # Skip if string is undefined
1563                                        }
1564
120
137
                                        eval {
1565
120
165
                                                my $re = (ref($rule_value) eq 'Regexp') ? $rule_value : qr/\Q$rule_value\E/;
1566
120
506
                                                if(($rules->{'type'} eq 'arrayref') || ($rules->{'type'} eq 'ArrayRef')) {
1567
5
11
5
5
30
6
                                                        my @matches = grep { $_ =~ $re } @{$value};
1568
5
5
5
8
                                                        if(scalar(@matches) != scalar(@{$value})) {
1569
2
4
                                                                if($rules->{'error_msg'}) {
1570
0
0
                                                                        _error($logger, $rules->{'error_msg'});
1571                                                                } else {
1572
2
2
4
7
                                                                        _error($logger, "$rule_description: All members of parameter '$key' [", join(', ', @{$value}), "] must match pattern '$rule_value'");
1573                                                                }
1574                                                        }
1575                                                } elsif($value !~ $re) {
1576
36
60
                                                        if($rules->{'error_msg'}) {
1577
3
5
                                                                _error($logger, $rules->{'error_msg'});
1578                                                        } else {
1579
33
92
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must match pattern '$re'");
1580                                                        }
1581                                                }
1582
82
80
                                                1;
1583                                        };
1584
120
47117
                                        if($@) {
1585
38
60
                                                if($rules->{'error_msg'}) {
1586
3
6
                                                        _error($logger, $rules->{'error_msg'});
1587                                                } else {
1588
35
94
                                                        _error($logger, "$rule_description: Parameter '$key' regex '$rule_value' error: $@");
1589                                                }
1590
0
0
                                                $invalid_args{$key} = 1;
1591                                        }
1592                                } elsif($rule_name eq 'nomatch') {
1593
26
38
                                        if(!defined($value)) {
1594
0
0
                                                next;   # Skip if string is undefined
1595                                        }
1596
26
118
                                        if(($rules->{'type'} eq 'arrayref') || ($rules->{'type'} eq 'ArrayRef')) {
1597
5
15
5
5
29
4
                                                my @matches = grep { /$rule_value/ } @{$value};
1598
5
8
                                                if(scalar(@matches)) {
1599
2
3
                                                        if($rules->{'error_msg'}) {
1600
0
0
                                                                _error($logger, $rules->{'error_msg'});
1601                                                        } else {
1602
2
2
4
5
                                                                _error($logger, "$rule_description: No member of parameter '$key' [", join(', ', @{$value}), "] must match pattern '$rule_value'");
1603                                                        }
1604                                                }
1605                                        } elsif($value =~ $rule_value) {
1606
10
15
                                                if($rules->{'error_msg'}) {
1607
1
2
                                                        _error($logger, $rules->{'error_msg'});
1608                                                } else {
1609
9
29
                                                        _error($logger, "$rule_description: Parameter '$key' ($value) must not match pattern '$rule_value'");
1610                                                }
1611
0
0
                                                $invalid_args{$key} = 1;
1612                                        }
1613                                } elsif(($rule_name eq 'memberof') || ($rule_name eq 'enum') || ($rule_name eq 'values')) {
1614
117
131
                                        if(!defined($value)) {
1615
0
0
                                                next;   # Skip if string is undefined
1616                                        }
1617
117
134
                                        if(ref($rule_value) eq 'ARRAY') {
1618
115
101
                                                my $ok = 1;
1619
115
294
                                                if(($rules->{'type'} eq 'integer') || ($rules->{'type'} eq 'number') || ($rules->{'type'} eq 'float')) {
1620
21
65
21
42
60
31
                                                        unless(List::Util::any { $_ == $value } @{$rule_value}) {
1621
7
6
                                                                $ok = 0;
1622                                                        }
1623                                                } else {
1624
94
95
                                                        my $l = lc($value);
1625
94
318
94
209
399
155
                                                        unless(List::Util::any { (!defined($rules->{'case_sensitive'}) || ($rules->{'case_sensitive'} == 1)) ? $_ eq $value : lc($_) eq $l } @{$rule_value}) {
1626
35
36
                                                                $ok = 0;
1627                                                        }
1628                                                }
1629
1630
115
267
                                                if(!$ok) {
1631
42
61
                                                        if($rules->{'error_msg'}) {
1632
4
7
                                                                _error($logger, $rules->{'error_msg'});
1633                                                        } else {
1634
38
38
54
73
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must be one of ", join(', ', @{$rule_value}));
1635                                                        }
1636
0
0
                                                        $invalid_args{$key} = 1;
1637                                                }
1638                                        } else {
1639
2
3
                                                if($rules->{'error_msg'}) {
1640
0
0
                                                        _error($logger, $rules->{'error_msg'});
1641                                                } else {
1642
2
5
                                                        _error($logger, "$rule_description: Parameter '$key' rule ($rule_value) must be an array reference");
1643                                                }
1644                                        }
1645                                } elsif($rule_name eq 'notmemberof') {
1646
50
51
                                        if(!defined($value)) {
1647
0
0
                                                next;   # Skip if string is undefined
1648                                        }
1649
50
61
                                        if(ref($rule_value) eq 'ARRAY') {
1650
49
32
                                                my $ok = 1;
1651
49
135
                                                if(($rules->{'type'} eq 'integer') || ($rules->{'type'} eq 'number') || ($rules->{'type'} eq 'float')) {
1652
9
25
9
15
20
16
                                                        if(List::Util::any { $_ == $value } @{$rule_value}) {
1653
5
3
                                                                $ok = 0;
1654                                                        }
1655                                                } else {
1656
40
42
                                                        my $l = lc($value);
1657
40
68
40
83
110
75
                                                        if(List::Util::any { (!defined($rules->{'case_sensitive'}) || ($rules->{'case_sensitive'} == 1)) ? $_ eq $value : lc($_) eq $l } @{$rule_value}) {
1658
22
19
                                                                $ok = 0;
1659                                                        }
1660                                                }
1661
1662
49
112
                                                if(!$ok) {
1663
27
35
                                                        if($rules->{'error_msg'}) {
1664
1
1
                                                                _error($logger, $rules->{'error_msg'});
1665                                                        } else {
1666
26
26
36
44
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must not be one of ", join(', ', @{$rule_value}));
1667                                                        }
1668
0
0
                                                        $invalid_args{$key} = 1;
1669                                                }
1670                                        } else {
1671
1
1
                                                if($rules->{'error_msg'}) {
1672
0
0
                                                        _error($logger, $rules->{'error_msg'});
1673                                                } else {
1674
1
2
                                                        _error($logger, "$rule_description: Parameter '$key' rule ($rule_value) must be an array reference");
1675                                                }
1676                                        }
1677                                } elsif($rule_name eq 'isa') {
1678
21
59
                                        if(!defined($value)) {
1679
0
0
                                                next;   # Skip if object not given
1680                                        }
1681
21
33
                                        if($rules->{'type'} eq 'object') {
1682
18
63
                                                if(!$value->isa($rule_value)) {
1683
5
16
                                                        _error($logger, "$rule_description: Parameter '$key' must be a '$rule_value' object got a " . (ref($value) ? ref($value) : $value) . ' object instead');
1684
0
0
                                                        $invalid_args{$key} = 1;
1685                                                }
1686                                        } else {
1687
3
7
                                                _error($logger, "$rule_description: Parameter '$key' has meaningless isa value $rule_value");
1688                                        }
1689                                } elsif($rule_name eq 'can') {
1690
39
40
                                        if(!defined($value)) {
1691
0
0
                                                next;   # Skip if object not given
1692                                        }
1693
39
67
                                        if($rules->{'type'} eq 'object') {
1694
36
51
                                                if(ref($rule_value) eq 'ARRAY') {
1695                                                        # List of methods
1696
15
15
29
40
                                                        foreach my $method(@{$rule_value}) {
1697
29
63
                                                                if(!$value->can($method)) {
1698
6
20
                                                                        _error($logger, "$rule_description: Parameter '$key' must be an object that understands the $method method");
1699
0
0
                                                                        $invalid_args{$key} = 1;
1700                                                                }
1701                                                        }
1702                                                } elsif(!ref($rule_value)) {
1703
20
91
                                                        if(!$value->can($rule_value)) {
1704
9
22
                                                                _error($logger, "$rule_description: Parameter '$key' must be an object that understands the $rule_value method");
1705
0
0
                                                                $invalid_args{$key} = 1;
1706                                                        }
1707                                                } else {
1708
1
2
                                                        _error($logger, "$rule_description: 'can' rule for Parameter '$key must be either a scalar or an arrayref");
1709                                                }
1710                                        } else {
1711
3
8
                                                _error($logger, "$rule_description: Parameter '$key' has meaningless can value '$rule_value' for parameter type $rules->{type}");
1712                                        }
1713                                } elsif($rule_name eq 'element_type') {
1714
42
68
                                        if(($rules->{'type'} eq 'arrayref') || ($rules->{'type'} eq 'ArrayRef')) {
1715
39
39
                                                my $type = $rule_value;
1716
39
28
                                                my $custom_type = $custom_types->{$rule_value};
1717
39
51
                                                if($custom_type && $custom_type->{'type'}) {
1718
4
7
                                                        $type = $custom_type->{'type'};
1719                                                }
1720
39
39
30
47
                                                foreach my $member(@{$value}) {
1721
99
87
                                                        if($custom_type && $custom_type->{'transform'}) {
1722                                                                # The custom type has a transform embedded within it
1723
5
7
                                                                if(ref($custom_type->{'transform'}) eq 'CODE') {
1724
4
4
5
3
                                                                        $member = &{$custom_type->{'transform'}}($member);
1725                                                                } else {
1726
1
2
                                                                        _error($logger, "$rule_description: transforms must be a code ref");
1727
0
0
                                                                        last;
1728                                                                }
1729                                                        }
1730
98
156
                                                        if(($type eq 'string') || ($type eq 'Str')) {
1731
43
43
                                                                if(ref($member)) {
1732
2
4
                                                                        if($rules->{'error_msg'}) {
1733
0
0
                                                                                _error($logger, $rules->{'error_msg'});
1734                                                                        } else {
1735
2
3
                                                                                _error($logger, "$key can only contain strings");
1736                                                                        }
1737
0
0
                                                                        $invalid_args{$key} = 1;
1738                                                                }
1739                                                        } elsif($type eq 'integer') {
1740
44
91
                                                                if(ref($member) || ($member =~ /\D/)) {
1741
6
12
                                                                        if($rules->{'error_msg'}) {
1742
1
1
                                                                                _error($logger, $rules->{'error_msg'});
1743                                                                        } else {
1744
5
9
                                                                                _error($logger, "$key can only contain integers (found $member)");
1745                                                                        }
1746
0
0
                                                                        $invalid_args{$key} = 1;
1747                                                                }
1748                                                        } elsif(($type eq 'number') || ($rule_value eq 'float')) {
1749
11
55
                                                                if(ref($member) || ($member !~ /^[-+]?(\d*\.\d+|\d+\.?\d*)$/)) {
1750
2
4
                                                                        if($rules->{'error_msg'}) {
1751
0
0
                                                                                _error($logger, $rules->{'error_msg'});
1752                                                                        } else {
1753
2
4
                                                                                _error($logger, "$key can only contain numbers (found $member)");
1754                                                                        }
1755
0
0
                                                                        $invalid_args{$key} = 1;
1756                                                                }
1757                                                        } else {
1758
0
0
                                                                _error($logger, "BUG: Add $type to element_type list");
1759                                                        }
1760                                                }
1761                                        } else {
1762
3
21
                                                _error($logger, "$rule_description: Parameter '$key' has meaningless element_type value $rule_value");
1763                                        }
1764                                } elsif($rule_name eq 'optional') {
1765                                        # Already handled at the beginning of the loop
1766                                } elsif($rule_name eq 'nullable') {
1767                                        # Already handled at the beginning of the loop (same as optional)
1768                                } elsif($rule_name eq 'default') {
1769                                        # Handled earlier
1770                                } elsif($rule_name eq 'error_msg') {
1771                                        # Handled inline
1772                                } elsif($rule_name eq 'transform') {
1773                                        # Handled before the loop
1774                                } elsif($rule_name eq 'case_sensitive') {
1775                                        # Handled inline
1776                                } elsif($rule_name eq 'description') {
1777                                        # A la, Data::Processor
1778                                } elsif($rule_name =~ /^_/) {
1779                                        # Ignore internal/metadata fields from schema extraction
1780                                } elsif($rule_name eq 'semantic') {
1781
3
5
                                        if($rule_value eq 'unix_timestamp') {
1782
2
5
                                                if($value < 0 || $value > 2147483647) {
1783
0
0
                                                        error($logger, 'Invalid Unix timestamp: $value');
1784                                                }
1785                                        } else {
1786
1
3
                                                _warn($logger, "semantic type $rule_value is not yet supported");
1787                                        }
1788                                } elsif($rule_name eq 'schema') {
1789                                        # Nested schema Run the given schema against each element of the array
1790
66
138
                                        if(($rules->{'type'} eq 'arrayref') || ($rules->{'type'} eq 'ArrayRef')) {
1791
15
15
                                                if(ref($value) eq 'ARRAY') {
1792
15
15
10
18
                                                        foreach my $member(@{$value}) {
1793                                                                # Distinguish two schema forms:
1794                                                                # (a) Rule hash   â€” has a top-level 'type' key, e.g. { type=>'string', matches=>qr/.../ }
1795                                                                #     â†’ validate each element against that rule directly.
1796                                                                # (b) Field-schema hash — keys are field names whose values are rule hashes,
1797                                                                #     e.g. { name=>{type=>'string'}, age=>{type=>'integer'} }
1798                                                                #     â†’ validate each hashref element against the field schema directly.
1799
23
41
                                                                my $is_field_schema = (ref($rule_value) eq 'HASH') && !exists($rule_value->{'type'});
1800
23
26
                                                                my %inner = (custom_types => $custom_types);
1801
23
30
                                                                if($is_field_schema) {
1802
3
3
                                                                        $inner{input}  = $member;
1803
3
2
                                                                        $inner{schema} = $rule_value;
1804                                                                } else {
1805
20
21
                                                                        $inner{input}  = { $key => $member };
1806
20
23
                                                                        $inner{schema} = { $key => $rule_value };
1807                                                                }
1808
23
24
                                                                if(!validate_strict(\%inner)) {
1809
0
0
                                                                        $invalid_args{$key} = 1;
1810                                                                }
1811                                                        }
1812                                                } elsif(defined($value)) {      # Allow undef for optional values
1813
0
0
                                                        _error($logger, "$rule_description: nested schema: Parameter '$value' must be an arrayref");
1814                                                }
1815                                        } elsif($rules->{'type'} eq 'hashref') {
1816
50
101
                                                if(ref($rule_value) eq 'HASH') {
1817                                                        # Apply nested defaults before validation
1818
50
60
                                                        my $nested_with_defaults = _apply_nested_defaults($value, $rule_value);
1819
50
50
33
67
                                                        if(scalar keys(%{$nested_with_defaults})) {
1820
48
307
                                                                if(my $new_args = validate_strict({ input => $nested_with_defaults, schema => $rule_value, custom_types => $custom_types })) {
1821
34
61
                                                                        $value = $new_args;
1822                                                                } else {
1823
0
0
                                                                        $invalid_args{$key} = 1;
1824                                                                }
1825                                                        }
1826                                                } else {
1827
0
0
                                                        _error($logger, "$rule_description: nested schema: Parameter '$value' must be an hashref");
1828                                                }
1829                                        } else {
1830
1
2
                                                _error($logger, "$rule_description: Parameter '$key': 'schema' only supports arrayref and hashref, not $rules->{type}");
1831                                        }
1832                                } elsif(($rule_name eq 'validate') || ($rule_name eq 'validator')) {
1833
13
17
                                        if(ref($rule_value) eq 'CODE') {
1834
13
13
13
16
                                                if(my $error = &{$rule_value}($args)) {
1835
5
22
                                                        _error($logger, "$rule_description: $key not valid: $error");
1836
0
0
                                                        $invalid_args{$key} = 1;
1837                                                }
1838                                        } else {
1839                                                # _error($logger, "$rule_description: Parameter '$key': 'validate' only supports coderef, not $value");
1840
0
0
                                                _error($logger, "$rule_description: Parameter '$key': 'validate' only supports coderef, not " . ref($rule_value) // $rule_value);
1841                                        }
1842                                } elsif ($rule_name eq 'callback') {
1843                                        # Custom validation code
1844
50
69
                                        unless (defined &$rule_value) {
1845
1
2
                                                _error($logger, "$rule_description: callback for '$key' must be a code reference");
1846                                        }
1847
49
74
                                        my $res = $rule_value->($value, $args, $schema);
1848
47
2544
                                        unless ($res) {
1849
18
26
                                                if($rules->{'error_msg'}) {
1850
0
0
                                                        _error($logger, $rules->{'error_msg'});
1851                                                } else {
1852
18
33
                                                        _error($logger, "$rule_description: Parameter '$key' failed custom validation");
1853                                                }
1854
0
0
                                                $invalid_args{$key} = 1;
1855                                        }
1856                                } elsif($rule_name eq 'position') {
1857
28
44
                                        if($rule_value =~ /\D/) {
1858
0
0
                                                _error($logger, "$rule_description: Parameter '$key': 'position' must be an integer");
1859                                        }
1860
28
36
                                        if($rule_value < 0) {
1861
0
0
                                                _error($logger, "$rule_description: Parameter '$key': 'position' must be a positive integer, not $value");
1862                                        }
1863                                } else {
1864
1
2
                                        _error($logger, "$rule_description: Unknown rule '$rule_name'");
1865                                }
1866                        }
1867                } elsif(ref($rules) eq 'ARRAY') {
1868
76
76
56
74
                        if(scalar(@{$rules})) {
1869                                # An argument can be one of several different types.
1870                                # This path handles both explicit array-of-rules schemas and the
1871                                # normalised form of union type shorthand (type => ['a', 'b', ...]).
1872
74
65
                                my $rc = 0;
1873
74
58
                                my @types;
1874
74
74
47
67
                                foreach my $rule(@{$rules}) {
1875
120
167
                                        if(ref($rule) ne 'HASH') {
1876
1
3
                                                _error($logger, "$rule_description: Parameter '$key' rules must be a hash reference");
1877
0
0
                                                next;
1878                                        }
1879
119
133
                                        if(!defined($rule->{'type'})) {
1880
0
0
                                                _error($logger, "$rule_description: Parameter '$key' is missing a type in an alternative");
1881
0
0
                                                next;
1882                                        }
1883
119
116
                                        push @types, $rule->{'type'};
1884
119
89
                                        my $result;
1885
119
82
                                        eval {
1886
119
366
                                                $result = validate_strict({ input => { $key => $value }, schema => { $key => $rule }, logger => undef, custom_types => $custom_types });
1887                                        };
1888
119
78952
                                        if(!$@) {
1889                                                # Capture coercion performed by the successful sub-validation
1890                                                # (e.g. integer/number coercion) so the outer scope sees it.
1891
51
67
                                                $value = $result->{$key} if(defined($result));
1892
51
35
                                                $rc = 1;
1893
51
51
                                                last;
1894                                        }
1895                                }
1896
73
102
                                if(!$rc) {
1897
22
54
                                        _error($logger, "$rule_description: Parameter: '$key': must be one of " . join(', ', @types));
1898
0
0
                                        $invalid_args{$key} = 1;
1899                                }
1900                        } else {
1901
2
4
                                _error($logger, "$rule_description: Parameter: '$key': schema is empty arrayref");
1902                        }
1903                } elsif(ref($rules)) {
1904
2
4
                        _error($logger, 'rules must be a hash reference or string');
1905                }
1906
1907
1273
1487
                $validated_args{$key} = $value;
1908        }
1909
1910        # Validate parameter relationships
1911
988
1078
        if (my $relationships = $params->{'relationships'}) {
1912
49
59
                _validate_relationships(\%validated_args, $relationships, $logger, $schema_description);
1913        }
1914
1915
964
805
        if(my $cross_validation = $params->{'cross_validation'}) {
1916
55
55
43
50
                foreach my $validator_name(keys %{$cross_validation}) {
1917
62
59
                        my $validator = $cross_validation->{$validator_name};
1918
62
99
                        if((!ref($validator)) || (ref($validator) ne 'CODE')) {
1919
1
2
                                _error($logger, "$schema_description: cross_validation $validator is not a code snippet");
1920
0
0
                                next;
1921                        }
1922
61
61
52
66
                        if(my $error = &{$validator}(\%validated_args, $validator)) {
1923
25
104
                                _error($logger, $error);
1924                                # We have no idea which parameters are still valid, so let's invalidate them all
1925
0
0
                                return;
1926                        }
1927                }
1928        }
1929
1930
937
888
        foreach my $key(keys %invalid_args) {
1931
0
0
                delete $validated_args{$key};
1932        }
1933
1934
937
782
        if($are_positional_args == 1) {
1935
19
13
                my @rc;
1936
19
19
14
22
                foreach my $key (keys %{$schema}) {
1937                        # Use exists() rather than if(my $value = ...) so that falsy but
1938                        # valid coerced values (integer 0, empty string, undef from an
1939                        # absent optional) are not silently dropped from the return array.
1940
30
33
                        if(exists $validated_args{$key}) {
1941
28
23
                                my $value = delete $validated_args{$key};
1942
28
26
                                my $position = $schema->{$key}->{'position'};
1943
28
55
                                if(defined($rc[$position])) {
1944
1
2
                                        _error($logger, "$schema_description: $key: position $position appears twice");
1945                                }
1946
27
25
                                $rc[$position] = $value;
1947                        }
1948                }
1949
18
47
                return \@rc;
1950        }
1951
918
2042
        return \%validated_args;
1952}
1953
1954# _schema_from_arrayref($arrayref, $logger)
1955#
1956# Normalise an arrayref schema:
1957#   [ { name => 'param', type => 'string', ... }, ... ]
1958# to the standard named-parameter hashref form:
1959#   { param => { type => 'string', ... }, ... }
1960#
1961# The 'name' key is consumed during conversion and does not become a rule.
1962# Croaks if any element is not a hashref, is missing 'name', or if a name
1963# appears more than once.
1964sub _schema_from_arrayref
1965{
1966
14
11
        my ($arrayref, $logger) = @_;
1967
1968
14
11
        my %schema;
1969
14
14
12
15
        foreach my $spec (@{$arrayref}) {
1970
19
20
                _error($logger, "validate_strict: each arrayref schema element must be a hashref")
1971                        unless ref($spec) eq 'HASH';
1972                _error($logger, "validate_strict: arrayref schema element must have a 'name' key")
1973
18
17
                        unless exists($spec->{'name'});
1974
17
17
13
21
                my %rule = %{$spec};
1975
17
17
                my $name = delete $rule{'name'};
1976                _error($logger, "validate_strict: duplicate parameter '$name' in arrayref schema")
1977
17
19
                        if exists($schema{$name});
1978
16
16
                $schema{$name} = \%rule;
1979        }
1980
11
11
        return \%schema;
1981}
1982
1983# Return number of visible characters not number of bytes
1984# Ensure string is decoded into Perl characters
1985sub _number_of_characters
1986{
1987
197
84726
        my $value = $_[0];
1988
1989
197
218
        return if(!defined($value));
1990
1991
196
649
        if($value !~ /[^[:ascii:]]/) {
1992
168
231
                return length($value);
1993        }
1994        # Decode only if it's not already a Perl character string
1995
28
99
        $value = decode_utf8($value) unless utf8::is_utf8($value);
1996
1997        # Count grapheme clusters (visible characters)
1998        # The pseudo-operator () = forces list context to count matches
1999        # return scalar( () = $value =~ /\X/g );
2000
2001
28
97
        return Unicode::GCString->new($value)->length();
2002}
2003
2004sub _apply_nested_defaults {
2005
70
5656
        my ($input, $schema) = @_;
2006
70
99
        my %result = %$input;
2007
2008
70
87
        foreach my $key (keys %$schema) {
2009
150
110
                my $rules = $schema->{$key};
2010
2011
150
279
                if (ref $rules eq 'HASH' && exists $rules->{default} && !exists $result{$key}) {
2012
11
10
                        $result{$key} = $rules->{default};
2013                }
2014
2015                # Recursively handle nested schema
2016
150
272
                if((ref $rules eq 'HASH') && $rules->{schema} && (ref $result{$key} eq 'HASH')) {
2017
10
24
                        $result{$key} = _apply_nested_defaults($result{$key}, $rules->{schema});
2018                }
2019        }
2020
2021
70
70
        return \%result;
2022}
2023
2024sub _validate_relationships {
2025
49
48
        my ($validated_args, $relationships, $logger, $description) = @_;
2026
2027
49
54
        return unless ref($relationships) eq 'ARRAY';
2028
2029
49
46
        foreach my $rel (@$relationships) {
2030
49
55
                my $type = $rel->{type} or next;
2031
2032
49
94
                if ($type eq 'mutually_exclusive') {
2033
8
13
                        _validate_mutually_exclusive($validated_args, $rel, $logger, $description);
2034                } elsif ($type eq 'required_group') {
2035
6
12
                        _validate_required_group($validated_args, $rel, $logger, $description);
2036                } elsif ($type eq 'conditional_requirement') {
2037
7
10
                        _validate_conditional_requirement($validated_args, $rel, $logger, $description);
2038                } elsif ($type eq 'dependency') {
2039
6
14
                        _validate_dependency($validated_args, $rel, $logger, $description);
2040                } elsif ($type eq 'value_constraint') {
2041
16
21
                        _validate_value_constraint($validated_args, $rel, $logger, $description);
2042                } elsif ($type eq 'value_conditional') {
2043
6
7
                        _validate_value_conditional($validated_args, $rel, $logger, $description);
2044                } else {
2045
0
0
                        _error($logger, "Unknown relationship type $type");
2046                }
2047        }
2048}
2049
2050sub _validate_mutually_exclusive {
2051
12
7226
        my ($args, $rel, $logger, $description) = @_;
2052
2053
12
12
13
26
        my @params = @{$rel->{params} || []};
2054
12
16
        return unless @params >= 2;
2055
2056
12
24
16
63
        my @present = grep { exists($args->{$_}) && defined($args->{$_}) } @params;
2057
2058
12
29
        if (@present > 1) {
2059
6
17
                my $msg = $rel->{description} || 'Cannot specify both ' . join(' and ', @present);
2060
6
14
                _error($logger, "$description: $msg");
2061        }
2062}
2063
2064sub _validate_required_group {
2065
8
4215
        my ($args, $rel, $logger, $description) = @_;
2066
2067
8
8
6
22
        my @params = @{$rel->{params} || []};
2068
8
17
        return unless @params >= 2;
2069
2070
8
16
12
27
        my @present = grep { exists($args->{$_}) && defined($args->{$_}) } @params;
2071
2072
8
17
        if (@present == 0) {
2073                my $msg = $rel->{description} ||
2074
4
16
                        'Must specify at least one of: ' . join(', ', @params);
2075
4
26
                _error($logger, "$description: $msg");
2076        }
2077}
2078
2079sub _validate_conditional_requirement {
2080
11
7068
        my ($args, $rel, $logger, $description) = @_;
2081
2082
11
19
        my $if_param = $rel->{if} or return;
2083
11
37
        my $then_param = $rel->{then_required} or return;
2084
2085        # If the condition parameter is present and defined
2086
11
36
        if (exists($args->{$if_param}) && defined($args->{$if_param})) {
2087                # Check if it's truthy (for booleans and general values)
2088
9
13
                if ($args->{$if_param}) {
2089                        # Then the required parameter must also be present
2090
7
24
                        unless (exists($args->{$then_param}) && defined($args->{$then_param})) {
2091
3
39
                                my $msg = $rel->{description} || "When $if_param is specified, $then_param is required";
2092
3
6
                                _error($logger, "$description: $msg");
2093                        }
2094                }
2095        }
2096}
2097
2098sub _validate_dependency {
2099
9
5372
        my ($args, $rel, $logger, $description) = @_;
2100
2101
9
17
        my $param = $rel->{param} or return;
2102
9
39
        my $requires = $rel->{requires} or return;
2103
2104        # If param is present, requires must also be present
2105
9
24
        if (exists($args->{$param}) && defined($args->{$param})) {
2106
6
17
                unless (exists($args->{$requires}) && defined($args->{$requires})) {
2107
4
11
                        my $msg = $rel->{description} || "$param requires $requires to be specified";
2108
4
6
                        _error($logger, "$description: $msg");
2109                }
2110        }
2111}
2112
2113sub _validate_value_constraint {
2114
31
14583
        my ($args, $rel, $logger, $description) = @_;
2115
2116
31
40
        my $if_param = $rel->{if} or return;
2117
31
82
        my $then_param = $rel->{then} or return;
2118
31
33
        my $operator = $rel->{operator} or return;
2119
31
22
        my $value = $rel->{value};
2120
31
30
        return unless defined $value;
2121
2122        # If the condition parameter is present and truthy
2123
31
83
        if (exists($args->{$if_param}) && defined($args->{$if_param}) && $args->{$if_param}) {
2124                # Check if the then parameter exists
2125
28
62
                if (exists($args->{$then_param}) && defined($args->{$then_param})) {
2126
28
24
                        my $actual = $args->{$then_param};
2127
28
19
                        my $valid = 0;
2128
2129
28
49
                        if ($operator eq '==') {
2130
8
8
                                $valid = ($actual == $value);
2131                        } elsif ($operator eq '!=') {
2132
4
4
                                $valid = ($actual != $value);
2133                        } elsif ($operator eq '<') {
2134
4
3
                                $valid = ($actual < $value);
2135                        } elsif ($operator eq '<=') {
2136
4
3
                                $valid = ($actual <= $value);
2137                        } elsif ($operator eq '>') {
2138
4
3
                                $valid = ($actual > $value);
2139                        } elsif ($operator eq '>=') {
2140
4
3
                                $valid = ($actual >= $value);
2141                        }
2142
2143
28
48
                        unless ($valid) {
2144
16
38
                                my $msg = $rel->{description} || "When $if_param is specified, $then_param must be $operator $value (got $actual)";
2145
16
22
                                _error($logger, "$description: $msg");
2146                        }
2147                }
2148        }
2149}
2150
2151sub _validate_value_conditional {
2152
10
5814
        my ($args, $rel, $logger, $description) = @_;
2153
2154
10
15
        my $if_param = $rel->{if} or return;
2155
10
9
        my $equals = $rel->{equals};
2156
10
14
        my $then_param = $rel->{then_required} or return;
2157
10
13
        return unless defined $equals;
2158
2159        # If the parameter has the specific value
2160
10
25
        if (exists($args->{$if_param}) && defined($args->{$if_param})) {
2161
8
13
                if ($args->{$if_param} eq $equals) {
2162                        # Then the required parameter must be present
2163
6
15
                        unless (exists($args->{$then_param}) && defined($args->{$then_param})) {
2164                                my $msg = $rel->{description} ||
2165
4
11
                                        "When $if_param equals '$equals', $then_param is required";
2166
4
8
                                _error($logger, "$description: $msg");
2167                        }
2168                }
2169        }
2170}
2171
2172# Helper to log error or croak
2173sub _error
2174{
2175
746
4679
        my $logger = shift;
2176
746
846
        my $message = join('', @_);
2177
2178
746
821
        my @call_details = caller(0);
2179
746
10645
        if($logger) {
2180
21
52
                $logger->error(__PACKAGE__, ' line ', $call_details[2], ": $message");
2181        }
2182
741
4011
        croak(__PACKAGE__, ' line ', $call_details[2], ": $message");
2183        # Be absolutely sure, sometimes croak doesn't die for me in Test::Most scripts
2184
0
0
        die (__PACKAGE__, ' line ', $call_details[2], ": $message");
2185}
2186
2187# Helper to log warning or carp
2188sub _warn
2189{
2190
17
4764
        my $logger = shift;
2191
17
27
        my $message = join('', @_);
2192
2193
17
29
        if($logger) {
2194
7
21
                $logger->warn(__PACKAGE__, ": $message");
2195        } else {
2196
10
50
                carp(__PACKAGE__, ": $message");
2197        }
2198}
2199
2200 - 2356
=head1 AUTHOR

Nigel Horne, C<< <njh at nigelhorne.com> >>

=encoding utf-8

=head1 FORMAL SPECIFICATION

    [PARAM_NAME, VALUE, TYPE_NAME, CONSTRAINT_VALUE]

    ValidationRule ::= SimpleType | ComplexRule | UnionType

    SimpleType ::= string | integer | number | scalar | scalarref | stringref | arrayref | hashref | coderef | object

    UnionType ::= seq SimpleType    -- at least two members; written as type => ['a', 'b']

    ComplexRule == [
        type: SimpleType | UnionType;
        min: ℕ₁;
        max: ℕ₁;
        optional: 𝔹;
        matches: REGEX;
        regex: REGEX;
        nomatch: REGEX;
        memberof: seq VALUE;
        enum: seq VALUE;
        values: seq VALUE;
        notmemberof: seq VALUE;
        callback: FUNCTION;
        isa: TYPE_NAME;
        can: METHOD_NAME
    ]

    Schema == PARAM_NAME ⇸ ValidationRule

    Arguments == PARAM_NAME ⇸ VALUE

    ValidatedResult == PARAM_NAME ⇸ VALUE

    âˆ€ rule: ComplexRule •
      rule.min ≤ rule.max ∧
      Â¬((rule.memberof ∨ rule.enum ∨ rule.values) ∧ rule.min) ∧
      Â¬((rule.memberof ∨ rule.enum ∨ rule.values) ∧ rule.max) ∧
      Â¬(rule.notmemberof ∧ rule.min) ∧
      Â¬(rule.notmemberof ∧ rule.max)

    âˆ€ schema: Schema; args: Arguments •
      dom(validate_strict(schema, args)) ⊆ dom(schema) ∪ dom(args)

    validate_strict: Schema × Arguments → ValidatedResult

    âˆ€ schema: Schema; args: Arguments •
      let result == validate_strict(schema, args) •
        (∀ name: dom(schema) ∩ dom(args) •
          name ∈ dom(result) ⇒
          type_matches(result(name), schema(name))) ∧
        (∀ name: dom(schema) •
          Â¬optional(schema(name)) ⇒ name ∈ dom(args))

    type_matches: VALUE × ValidationRule → 𝔹

=head1 EXAMPLE

    use Params::Get;
    use Params::Validate::Strict;

    sub where_am_i
    {
        my $params = Params::Validate::Strict::validate_strict({
            args => Params::Get::get_params(undef, \@_),
            description => 'Print a string of latitude and longitude',
            error_msg => 'Latitude is a number between +/- 90, longitude is a number between +/- 180',
            members => {
                'latitude' => {
                    type => 'number',
                    min => -90,
                    max => 90
                }, 'longitude' => {
                    type => 'number',
                    min => -180,
                    max => 180
                }
            }
        });

        print 'You are at ', $params->{'latitude'}, ', ', $params->{'longitude'}, "\n";
    }

    where_am_i({ latitude => 3.14, longitude => -155 });

=head1 BUGS

=head1 SEE ALSO

=over 4

=item * L<Test Dashboard|https://nigelhorne.github.io/Params-Validate-Strict/coverage/>

=item * L<Data::Processor>

=item * L<Params::Get>

=item * L<Params::Smart>

=item * L<Params::Validate>

=item * L<Return::Set>

=item * L<App::Test::Generator>

=back

=head1 SUPPORT

This module is provided as-is without any warranty.

Please report any bugs or feature requests to C<bug-params-validate-strict at rt.cpan.org>,
or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Params-Validate-Strict>.
I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

You can find documentation for this module with the perldoc command.

    perldoc Params::Validate::Strict

You can also look for information at:

=over 4

=item * MetaCPAN

L<https://metacpan.org/dist/Params-Validate-Strict>

=item * RT: CPAN's request tracker

L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Params-Validate-Strict>

=item * CPAN Testers' Matrix

L<http://matrix.cpantesters.org/?dist=Params-Validate-Strict>

=item * CPAN Testers Dependencies

L<http://deps.cpantesters.org/?module=Params::Validate::Strict>

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2025-2026 Nigel Horne.

This program is released under the following licence: GPL2.
If you use it,
please let me know.

=cut
2357
23581;
2359