File Coverage

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

linestmtbrancondsubtimecode
1package Params::Validate::Strict;
2
3# FIXME: {max} doesn't play ball with non-ascii strings
4
5
19
19
19
1227944
20
256
use strict;
6
19
19
19
29
16
309
use warnings;
7
8
19
19
19
35
20
442
use Carp;
9
19
19
19
38
23
246
use Exporter qw(import);        # Required for @EXPORT_OK
10
19
19
19
3884
119673
772
use Encode qw(decode_utf8);
11
19
19
19
66
195
564
use List::Util 1.33 qw(any);    # Required for memberof validation
12
19
19
19
2758
78508
373
use Params::Get 0.13;
13
19
19
19
71
25
218
use Scalar::Util;
14
19
19
19
2784
123868
60000
use Unicode::GCString;
15
16our @ISA = qw(Exporter);
17our @EXPORT_OK = qw(validate_strict);
18
19 - 27
=head1 NAME

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

=head1 VERSION

Version 0.29

=cut
28
29our $VERSION = '0.29';
30
31 - 925
=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.

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> (the default), C<warn>, or C<ignore>.

=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<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<hashref>, C<arrayref>, C<object> and C<coderef>.

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
    ]
  };

=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<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>

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<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 as an argument and return true if the value is valid, false otherwise.

=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 });

=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<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 Cvalidate>, 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
926
927sub validate_strict
928{
929
526
1712351
        my $params = Params::Get::get_params(undef, \@_);
930
931
526
6519
        my $schema = $params->{'schema'} || $params->{'members'};
932
526
815
        my $args = $params->{'args'} || $params->{'input'};
933
526
754
        my $unknown_parameter_handler = $params->{'unknown_parameter_handler'} || 'die';
934
526
420
        my $logger = $params->{'logger'};
935
526
376
        my $custom_types = $params->{'custom_types'};
936
937        # Check if schema and args are references to hashes
938
526
589
        if(ref($schema) ne 'HASH') {
939
3
5
                _error($logger, 'validate_strict: schema must be a hash reference');
940        }
941
942        # Inspired by Data::Processor
943
523
702
        my $schema_description = $params->{'description'} || 'validate_strict';
944
523
391
        my $error_msg = $params->{'error_msg'};
945
946
523
493
        if($schema->{'members'} && ($schema->{'description'} || $schema->{'error_msg'})) {
947
1
1
                $schema_description = $schema->{'description'};
948
1
1
                $error_msg = $schema->{'error_msg'};
949
1
2
                $schema = $schema->{'members'};
950        }
951
952
523
1061
        if(exists($params->{'args'}) && (!defined($args))) {
953
1
1
                $args = {};
954        } elsif((ref($args) ne 'HASH') && (ref($args) ne 'ARRAY')) {
955
2
4
                _error($logger, "$schema_description: args must be a hash or array reference");
956        }
957
958
521
530
        if(ref($args) eq 'HASH') {
959                # Named args
960
516
516
348
618
                foreach my $key (keys %{$args}) {
961
680
695
                        if(!exists($schema->{$key})) {
962
13
26
                                if($unknown_parameter_handler eq 'die') {
963
5
7
                                        _error($logger, "$schema_description: Unknown parameter '$key'");
964                                } elsif($unknown_parameter_handler eq 'warn') {
965
4
10
                                        _warn($logger, "$schema_description: Unknown parameter '$key'");
966
4
196
                                        next;
967                                } elsif($unknown_parameter_handler eq 'ignore') {
968
2
3
                                        if($logger) {
969
1
4
                                                $logger->debug(__PACKAGE__ . ": $schema_description: Unknown parameter '$key'");
970                                        }
971
2
6
                                        next;
972                                } else {
973
2
5
                                        _error($logger, "$schema_description: '$unknown_parameter_handler' unknown_parameter_handler must be one of die, warn, ignore");
974                                }
975                        }
976                }
977        }
978
979        # Find out if this routine takes positional arguments
980
514
452
        my $are_positional_args = -1;
981
514
514
360
528
        foreach my $key (keys %{$schema}) {
982
514
503
                if(defined(my $rules = $schema->{$key})) {
983
512
460
                        if(ref($rules) eq 'HASH') {
984
480
519
                                if(!defined($rules->{'position'})) {
985
474
406
                                        if($are_positional_args == 1) {
986
0
0
                                                _error($logger, "::validate_strict: $key is missing position value");
987                                        }
988
474
300
                                        $are_positional_args = 0;
989
474
413
                                        last;
990                                }
991
6
5
                                $are_positional_args = 1;
992                        } else {
993
32
25
                                $are_positional_args = 0;
994
32
31
                                last;
995                        }
996                } else {
997
2
1
                        $are_positional_args = 0;
998
2
2
                        last;
999                }
1000        }
1001
1002
514
408
        my %validated_args;
1003        my %invalid_args;
1004
514
514
351
424
        foreach my $key (keys %{$schema}) {
1005
732
492
                my $rules = $schema->{$key};
1006
732
6
661
7
                my $value = ($are_positional_args == 1) ? @{$args}[$rules->{'position'}] : $args->{$key};
1007
1008
731
598
                if(!defined($rules)) {  # Allow anything
1009
2
2
                        $validated_args{$key} = $value;
1010
2
2
                        next;
1011                }
1012
1013                # If rules are a simple type string
1014
729
629
                if(ref($rules) eq '') {
1015
26
26
                        $rules = { type => $rules };
1016                }
1017
1018
729
434
                my $is_optional = 0;
1019
1020
729
465
                my $rule_description = $schema_description;     # Can be overridden in each element
1021
1022
729
625
                if(ref($rules) eq 'HASH') {
1023
716
583
                        if(exists($rules->{'description'})) {
1024
0
0
                                $rule_description = $rules->{'description'};
1025                        }
1026
716
673
                        if($rules->{'transform'} && defined($value)) {
1027
40
59
                                if(ref($rules->{'transform'}) eq 'CODE') {
1028
38
38
26
45
                                        $value = &{$rules->{'transform'}}($value);
1029                                } else {
1030
2
5
                                        _error($logger, "$rule_description: transforms must be a code ref");
1031                                }
1032                        }
1033
714
857
                        if(exists($rules->{optional})) {
1034
153
146
                                if(ref($rules->{'optional'}) eq 'CODE') {
1035
9
9
9
12
                                        $is_optional = &{$rules->{optional}}($value, $args);
1036                                } else {
1037
144
119
                                        $is_optional = $rules->{'optional'};
1038                                }
1039                        } elsif($rules->{nullable}) {
1040
0
0
                                $is_optional = $rules->{'nullable'};
1041                        }
1042                }
1043
1044                # Handle optional parameters
1045
727
1419
                if((ref($rules) eq 'HASH') && $is_optional) {
1046
145
96
                        my $look_for_default = 0;
1047
145
109
                        if($are_positional_args == 1) {
1048                                # if(!defined(@{$args}[$rules->{'position'}])) {
1049
2
4
                                if(!defined($args->[$rules->{position}])) {
1050
1
1
                                        $look_for_default = 1;
1051                                }
1052                        } else {
1053
143
130
                                if(!exists($args->{$key})) {
1054
71
50
                                        $look_for_default = 1;
1055                                }
1056                        }
1057
145
128
                        if($look_for_default) {
1058
72
72
                                if($are_positional_args == 1) {
1059
1
1
1
2
                                        if(scalar(@{$args}) < $rules->{'position'}) {
1060                                                # arg array is too short, so it must be missing
1061
0
0
                                                _error($logger, "$rule_description: Required parameter '$key' is missing");
1062
0
0
                                                next;
1063                                        }
1064                                }
1065
72
84
                                if(exists($rules->{'default'})) {
1066                                        # Populate missing optional parameters with the specified output values
1067
4
6
                                        $validated_args{$key} = $rules->{'default'};
1068                                }
1069
1070
72
68
                                if($rules->{'schema'}) {
1071
4
7
                                        $value = _apply_nested_defaults({}, $rules->{'schema'});
1072
4
4
3
19
                                        next unless scalar(%{$value});
1073                                        # The nested schema has a default value
1074                                } else {
1075
68
65
                                        next;   # optional and missing
1076                                }
1077                        }
1078                } elsif((ref($args) eq 'HASH') && !exists($args->{$key})) {
1079                        # The parameter is required
1080
7
25
                        _error($logger, "$rule_description: Required parameter '$key' is missing");
1081                }
1082
1083                # Validate based on rules
1084
649
548
                if(ref($rules) eq 'HASH') {
1085
636
744
                        if(defined(my $min = $rules->{'min'}) && defined(my $max = $rules->{'max'})) {
1086
78
79
                                if($min > $max) {
1087
5
32
                                        _error($logger, "validate_strict($key): min must be <= max ($min > $max)");
1088                                }
1089                        }
1090
1091
631
557
                        if($rules->{'memberof'}) {
1092
69
74
                                if(defined(my $min = $rules->{'min'})) {
1093
3
7
                                        _error($logger, "validate_strict($key): min ($min) makes no sense with memberof");
1094                                }
1095
66
66
                                if(defined(my $max = $rules->{'max'})) {
1096
1
2
                                        _error($logger, "validate_strict($key): max ($max) makes no sense with memberof");
1097                                }
1098                        }
1099
1100
627
589
                        foreach my $rule_name (keys %$rules) {
1101
1199
814
                                my $rule_value = $rules->{$rule_name};
1102
1103
1199
1137
                                if((ref($rule_value) eq 'CODE') && ($rule_name ne 'validate') && ($rule_name ne 'callback') && ($rule_name ne 'validator')) {
1104
53
53
36
58
                                        $rule_value = &{$rule_value}($value, $args);
1105                                }
1106
1107
1199
2168
                                if($rule_name eq 'type') {
1108
564
483
                                        my $type = lc($rule_value);
1109
1110
564
1099
                                        if(($type eq 'string') || ($type eq 'str')) {
1111
258
204
                                                if(ref($value)) {
1112
6
17
                                                        _error($logger, $rules->{'error_msg'} || "$rule_description: Parameter '$key' must be a string");
1113                                                }
1114
252
285
                                                unless((ref($value) eq '') || (defined($value) && length($value))) {    # Allow undef for optional strings
1115
0
0
                                                        _error($logger, $rules->{'error_msg'} || "$rule_description: Parameter '$key' must be a string");
1116                                                }
1117                                        } elsif($type eq 'integer') {
1118
97
108
                                                if(!defined($value)) {
1119
1
1
                                                        next;   # Skip if number is undefined
1120                                                }
1121
96
246
                                                if($value !~ /^\s*[+\-]?\d+\s*$/) {
1122
5
6
                                                        if($rules->{'error_msg'}) {
1123
1
1
                                                                _error($logger, $rules->{'error_msg'});
1124                                                        } else {
1125
4
12
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must be an integer");
1126                                                        }
1127                                                }
1128
91
91
                                                $value = int($value); # Coerce to integer
1129                                        } elsif(($type eq 'number') || ($type eq 'float')) {
1130
50
49
                                                if(!defined($value)) {
1131
2
2
                                                        next;   # Skip if number is undefined
1132                                                }
1133
48
62
                                                if(!Scalar::Util::looks_like_number($value)) {
1134
2
2
                                                        if($rules->{'error_msg'}) {
1135
0
0
                                                                _error($logger, $rules->{'error_msg'});
1136                                                        } else {
1137
2
5
                                                                _error($logger, "$rule_description: Parameter '$key' must be a number");
1138                                                        }
1139                                                }
1140                                                # $value = eval $value; # Coerce to number (be careful with eval)
1141
46
62
                                                $value = 0 + $value;    # Numeric coercion
1142                                        } elsif($type eq 'arrayref') {
1143
41
50
                                                if(!defined($value)) {
1144
2
3
                                                        next;   # Skip if arrayref is undefined
1145                                                }
1146
39
62
                                                if(ref($value) ne 'ARRAY') {
1147
0
0
                                                        if($rules->{'error_msg'}) {
1148
0
0
                                                                _error($logger, $rules->{'error_msg'});
1149                                                        } else {
1150
0
0
                                                                _error($logger, "$rule_description: Parameter '$key' must be an arrayref, not " . ref($value));
1151                                                        }
1152                                                }
1153                                        } elsif($type eq 'hashref') {
1154
31
52
                                                if(!defined($value)) {
1155
2
2
                                                        next;   # Skip if hashref is undefined
1156                                                }
1157
29
55
                                                if(ref($value) ne 'HASH') {
1158
0
0
                                                        if($rules->{'error_msg'}) {
1159
0
0
                                                                _error($logger, $rules->{'error_msg'});
1160                                                        } else {
1161
0
0
                                                                _error($logger, "$rule_description: Parameter '$key' must be an hashref");
1162                                                        }
1163                                                }
1164                                        } elsif(($type eq 'boolean') || ($type eq 'bool')) {
1165
22
19
                                                if(!defined($value)) {
1166
1
1
                                                        next;   # Skip if bool is undefined
1167                                                }
1168
21
93
                                                if(($value eq 'true') || ($value eq 'on') || ($value eq 'yes')) {
1169
3
2
                                                        $value = 1;
1170                                                } elsif(($value eq 'false') || ($value eq 'off') || ($value eq 'no')) {
1171
3
2
                                                        $value = 0;
1172                                                }
1173
21
34
                                                if(($value ne '1') && ($value ne '0')) {        # Do string compare
1174
2
13
                                                        if($rules->{'error_msg'}) {
1175
0
0
                                                                _error($logger, $rules->{'error_msg'});
1176                                                        } else {
1177
2
5
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must be a boolean");
1178                                                        }
1179                                                }
1180
19
22
                                                $value = int($value);   # Coerce to integer
1181                                        } elsif($type eq 'coderef') {
1182
3
5
                                                if(!defined($value)) {
1183
1
1
                                                        next;   # Skip if code is undefined
1184                                                }
1185
2
4
                                                if(ref($value) ne 'CODE') {
1186
0
0
                                                        if($rules->{'error_msg'}) {
1187
0
0
                                                                _error($logger, $rules->{'error_msg'});
1188                                                        } else {
1189
0
0
                                                                _error($logger, "$rule_description: Parameter '$key' must be a coderef");
1190                                                        }
1191                                                }
1192                                        } elsif($type eq 'object') {
1193
15
23
                                                if(!defined($value)) {
1194
1
1
                                                        next;   # Skip if object is undefined
1195                                                }
1196
14
34
                                                if(!Scalar::Util::blessed($value)) {
1197
1
2
                                                        if($rules->{'error_msg'}) {
1198
0
0
                                                                _error($logger, $rules->{'error_msg'});
1199                                                        } else {
1200
1
2
                                                                _error($logger, "$rule_description: Parameter '$key' must be an object");
1201                                                        }
1202                                                }
1203                                        } elsif(my $custom_type = $custom_types->{$type}) {
1204
46
65
                                                if($custom_type->{'transform'}) {
1205                                                        # The custom type has a transform embedded within it
1206
6
7
                                                        if(ref($custom_type->{'transform'}) eq 'CODE') {
1207
6
6
6
9
                                                                $value = &{$custom_type->{'transform'}}($value);
1208                                                        } else {
1209
0
0
                                                                _error($logger, "$rule_description: transforms must be a code ref");
1210
0
0
                                                                next;
1211                                                        }
1212                                                }
1213
46
256
                                                validate_strict({ input => { $key => $value }, schema => { $key => $custom_type }, custom_types => $custom_types });
1214                                        } else {
1215
1
2
                                                _error($logger, "$rule_description: Unknown type '$type'");
1216                                        }
1217                                } elsif($rule_name eq 'min') {
1218
158
153
                                        if(!defined($rules->{'type'})) {
1219
0
0
                                                _error($logger, "$rule_description: Don't know type of '$key' to determine its minimum value $rule_value");
1220                                        }
1221
158
134
                                        my $type = lc($rules->{'type'});
1222
158
187
                                        if(exists($custom_types->{$type}->{'min'})) {
1223
3
5
                                                $rule_value = $custom_types->{$type}->{'min'};
1224
3
3
                                                $type = $custom_types->{$type}->{'type'};
1225                                        }
1226
158
342
                                        if(($type eq 'string') || ($type eq 'str')) {
1227
55
65
                                                if($rule_value < 0) {
1228
1
1
                                                        if($rules->{'error_msg'}) {
1229
0
0
                                                                _error($logger, $rules->{'error_msg'});
1230                                                        } else {
1231
1
3
                                                                _error($logger, "$rule_description: String parameter '$key' has meaningless minimum value that is less than zero");
1232                                                        }
1233                                                }
1234
54
54
                                                if(!defined($value)) {
1235
0
0
                                                        next;   # Skip if string is undefined
1236                                                }
1237
54
59
                                                if(defined(my $len = _number_of_characters($value))) {
1238
54
109
                                                        if($len < $rule_value) {
1239
7
33
                                                                _error($logger, $rules->{'error_msg'} || "$rule_description: String parameter '$key' too short, ($len characters), must be at least $rule_value characters");
1240
0
0
                                                                $invalid_args{$key} = 1;
1241                                                        }
1242                                                } else {
1243
0
0
                                                        _error($logger, $rules->{'error_msg'} || "$rule_description: '$key' can't be decoded");
1244
0
0
                                                        $invalid_args{$key} = 1;
1245                                                }
1246                                        } elsif($type eq 'arrayref') {
1247
16
18
                                                if(!defined($value)) {
1248
0
0
                                                        next;   # Skip if array is undefined
1249                                                }
1250
16
22
                                                if(ref($value) ne 'ARRAY') {
1251
2
3
                                                        if($rules->{'error_msg'}) {
1252
0
0
                                                                _error($logger, $rules->{'error_msg'});
1253                                                        } else {
1254
2
4
                                                                _error($logger, "$rule_description: Parameter '$key' must be an arrayref, not " . ref($value));
1255                                                        }
1256                                                }
1257
14
14
13
25
                                                if(scalar(@{$value}) < $rule_value) {
1258
2
4
                                                        if($rules->{'error_msg'}) {
1259
0
0
                                                                _error($logger, $rules->{'error_msg'});
1260                                                        } else {
1261
2
6
                                                                _error($logger, "$rule_description: Parameter '$key' must be at least length $rule_value");
1262                                                        }
1263
0
0
                                                        $invalid_args{$key} = 1;
1264                                                }
1265                                        } elsif($type eq 'hashref') {
1266
4
5
                                                if(!defined($value)) {
1267
0
0
                                                        next;   # Skip if hash is undefined
1268                                                }
1269
4
4
3
7
                                                if(scalar(keys(%{$value})) < $rule_value) {
1270
1
2
                                                        if($rules->{'error_msg'}) {
1271
0
0
                                                                _error($logger, $rules->{'error_msg'});
1272                                                        } else {
1273
1
2
                                                                _error($logger, "$rule_description: Parameter '$key' must contain at least $rule_value keys");
1274                                                        }
1275
0
0
                                                        $invalid_args{$key} = 1;
1276                                                }
1277                                        } elsif(($type eq 'integer') || ($type eq 'number') || ($type eq 'float')) {
1278
82
87
                                                if(!defined($value)) {
1279
0
0
                                                        next;   # Skip if hash is undefined
1280                                                }
1281
82
122
                                                if(Scalar::Util::looks_like_number($value)) {
1282
81
101
                                                        if($value < $rule_value) {
1283
19
26
                                                                if($rules->{'error_msg'}) {
1284
3
5
                                                                        _error($logger, $rules->{'error_msg'});
1285                                                                } else {
1286
16
38
                                                                        _error($logger, "$rule_description: Parameter '$key' ($value) must be at least $rule_value");
1287                                                                }
1288
0
0
                                                                $invalid_args{$key} = 1;
1289
0
0
                                                                next;
1290                                                        }
1291                                                } else {
1292
1
2
                                                        if($rules->{'error_msg'}) {
1293
0
0
                                                                _error($logger, $rules->{'error_msg'});
1294                                                        } else {
1295
1
3
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must be a number");
1296                                                        }
1297
0
0
                                                        next;
1298                                                }
1299                                        } else {
1300
1
2
                                                _error($logger, "$rule_description: Parameter '$key' of type '$type' has meaningless min value $rule_value");
1301                                        }
1302                                } elsif($rule_name eq 'max') {
1303
74
78
                                        if(!defined($rules->{'type'})) {
1304
0
0
                                                _error($logger, "$rule_description: Don't know type of '$key' to determine its maximum value $rule_value");
1305                                        }
1306
74
69
                                        my $type = lc($rules->{'type'});
1307
74
94
                                        if(exists($custom_types->{$type}->{'max'})) {
1308
2
3
                                                $rule_value = $custom_types->{$type}->{'max'};
1309
2
2
                                                $type = $custom_types->{$type}->{'type'};
1310                                        }
1311
74
194
                                        if(($type eq 'string') || ($type eq 'str')) {
1312
27
28
                                                if(!defined($value)) {
1313
0
0
                                                        next;   # Skip if string is undefined
1314                                                }
1315
27
48
                                                if(defined(my $len = _number_of_characters($value))) {
1316
27
64
                                                        if($len > $rule_value) {
1317
5
22
                                                                _error($logger, $rules->{'error_msg'} || "$rule_description: String parameter '$key' too long, ($len characters), must be no longer than $rule_value");
1318
0
0
                                                                $invalid_args{$key} = 1;
1319                                                        }
1320                                                } else {
1321
0
0
                                                        _error($logger, $rules->{'error_msg'} || "$rule_description: '$key' can't be decoded");
1322
0
0
                                                        $invalid_args{$key} = 1;
1323                                                }
1324                                        } elsif($type eq 'arrayref') {
1325
9
11
                                                if(!defined($value)) {
1326
0
0
                                                        next;   # Skip if string is undefined
1327                                                }
1328
9
10
                                                if(ref($value) ne 'ARRAY') {
1329
0
0
                                                        if($rules->{'error_msg'}) {
1330
0
0
                                                                _error($logger, $rules->{'error_msg'});
1331                                                        } else {
1332
0
0
                                                                _error($logger, "$rule_description: Parameter '$key' must be an arrayref, not " . ref($value));
1333                                                        }
1334                                                }
1335
9
9
6
18
                                                if(scalar(@{$value}) > $rule_value) {
1336
4
7
                                                        if($rules->{'error_msg'}) {
1337
0
0
                                                                _error($logger, $rules->{'error_msg'});
1338                                                        } else {
1339
4
9
                                                                _error($logger, "$rule_description: Parameter '$key' must contain no more than $rule_value items");
1340                                                        }
1341
0
0
                                                        $invalid_args{$key} = 1;
1342                                                }
1343                                        } elsif($type eq 'hashref') {
1344
3
5
                                                if(!defined($value)) {
1345
0
0
                                                        next;   # Skip if hash is undefined
1346                                                }
1347
3
3
2
5
                                                if(scalar(keys(%{$value})) > $rule_value) {
1348
2
5
                                                        if($rules->{'error_msg'}) {
1349
0
0
                                                                _error($logger, $rules->{'error_msg'});
1350                                                        } else {
1351
2
6
                                                                _error($logger, "$rule_description: Parameter '$key' must contain no more than $rule_value keys");
1352                                                        }
1353
0
0
                                                        $invalid_args{$key} = 1;
1354                                                }
1355                                        } elsif(($type eq 'integer') || ($type eq 'number') || ($type eq 'float')) {
1356
34
31
                                                if(!defined($value)) {
1357
0
0
                                                        next;   # Skip if hash is undefined
1358                                                }
1359
34
53
                                                if(Scalar::Util::looks_like_number($value)) {
1360
34
51
                                                        if($value > $rule_value) {
1361
4
12
                                                                if($rules->{'error_msg'}) {
1362
0
0
                                                                        _error($logger, $rules->{'error_msg'});
1363                                                                } else {
1364
4
9
                                                                        _error($logger, "$rule_description: Parameter '$key' ($value) must be no more than $rule_value");
1365                                                                }
1366
0
0
                                                                $invalid_args{$key} = 1;
1367
0
0
                                                                next;
1368                                                        }
1369                                                } else {
1370
0
0
                                                        if($rules->{'error_msg'}) {
1371
0
0
                                                                _error($logger, $rules->{'error_msg'});
1372                                                        } else {
1373
0
0
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must be a number");
1374                                                        }
1375
0
0
                                                        next;
1376                                                }
1377                                        } else {
1378
1
2
                                                _error($logger, "$rule_description: Parameter '$key' of type '$type' has meaningless max value $rule_value");
1379                                        }
1380                                } elsif($rule_name eq 'matches') {
1381
59
63
                                        if(!defined($value)) {
1382
1
1
                                                next;   # Skip if string is undefined
1383                                        }
1384
58
62
                                        eval {
1385
58
87
                                                my $re = (ref($rule_value) eq 'Regexp') ? $rule_value : qr/\Q$rule_value\E/;
1386
58
260
                                                if(($rules->{'type'} eq 'arrayref') || ($rules->{'type'} eq 'ArrayRef')) {
1387
2
4
2
2
10
2
                                                        my @matches = grep { $_ =~ $re } @{$value};
1388
2
2
3
3
                                                        if(scalar(@matches) != scalar(@{$value})) {
1389
0
0
                                                                if($rules->{'error_msg'}) {
1390
0
0
                                                                        _error($logger, $rules->{'error_msg'});
1391                                                                } else {
1392
0
0
0
0
                                                                        _error($logger, "$rule_description: All members of parameter '$key' [", join(', ', @{$value}), "] must match pattern '$rule_value'");
1393                                                                }
1394                                                        }
1395                                                } elsif($value !~ $re) {
1396
17
24
                                                        if($rules->{'error_msg'}) {
1397
3
6
                                                                _error($logger, $rules->{'error_msg'});
1398                                                        } else {
1399
14
44
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must match pattern '$re'");
1400                                                        }
1401                                                }
1402
41
50
                                                1;
1403                                        };
1404
58
19153
                                        if($@) {
1405
17
34
                                                if($rules->{'error_msg'}) {
1406
3
5
                                                        _error($logger, $rules->{'error_msg'});
1407                                                } else {
1408
14
50
                                                        _error($logger, "$rule_description: Parameter '$key' regex '$rule_value' error: $@");
1409                                                }
1410
0
0
                                                $invalid_args{$key} = 1;
1411                                        }
1412                                } elsif($rule_name eq 'nomatch') {
1413
7
10
                                        if(!defined($value)) {
1414
0
0
                                                next;   # Skip if string is undefined
1415                                        }
1416
7
46
                                        if(($rules->{'type'} eq 'arrayref') || ($rules->{'type'} eq 'ArrayRef')) {
1417
3
9
3
3
20
4
                                                my @matches = grep { /$rule_value/ } @{$value};
1418
3
4
                                                if(scalar(@matches)) {
1419
1
2
                                                        if($rules->{'error_msg'}) {
1420
0
0
                                                                _error($logger, $rules->{'error_msg'});
1421                                                        } else {
1422
1
1
2
4
                                                                _error($logger, "$rule_description: No member of parameter '$key' [", join(', ', @{$value}), "] must match pattern '$rule_value'");
1423                                                        }
1424                                                }
1425                                        } elsif($value =~ $rule_value) {
1426
1
3
                                                if($rules->{'error_msg'}) {
1427
0
0
                                                        _error($logger, $rules->{'error_msg'});
1428                                                } else {
1429
1
3
                                                        _error($logger, "$rule_description: Parameter '$key' ($value) must not match pattern '$rule_value'");
1430                                                }
1431
0
0
                                                $invalid_args{$key} = 1;
1432                                        }
1433                                } elsif(($rule_name eq 'memberof') || ($rule_name eq 'enum')) {
1434
65
57
                                        if(!defined($value)) {
1435
0
0
                                                next;   # Skip if string is undefined
1436                                        }
1437
65
62
                                        if(ref($rule_value) eq 'ARRAY') {
1438
63
39
                                                my $ok = 1;
1439
63
149
                                                if(($rules->{'type'} eq 'integer') || ($rules->{'type'} eq 'number') || ($rules->{'type'} eq 'float')) {
1440
12
41
12
22
33
23
                                                        unless(List::Util::any { $_ == $value } @{$rule_value}) {
1441
5
2
                                                                $ok = 0;
1442                                                        }
1443                                                } else {
1444
51
42
                                                        my $l = lc($value);
1445
51
246
51
106
266
76
                                                        unless(List::Util::any { (!defined($rules->{'case_sensitive'}) || ($rules->{'case_sensitive'} == 1)) ? $_ eq $value : lc($_) eq $l } @{$rule_value}) {
1446
15
10
                                                                $ok = 0;
1447                                                        }
1448                                                }
1449
1450
63
133
                                                if(!$ok) {
1451
20
20
                                                        if($rules->{'error_msg'}) {
1452
3
5
                                                                _error($logger, $rules->{'error_msg'});
1453                                                        } else {
1454
17
17
25
39
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must be one of ", join(', ', @{$rule_value}));
1455                                                        }
1456
0
0
                                                        $invalid_args{$key} = 1;
1457                                                }
1458                                        } else {
1459
2
5
                                                if($rules->{'error_msg'}) {
1460
0
0
                                                        _error($logger, $rules->{'error_msg'});
1461                                                } else {
1462
2
14
                                                        _error($logger, "$rule_description: Parameter '$key' rule ($rule_value) must be an array reference");
1463                                                }
1464                                        }
1465                                } elsif($rule_name eq 'notmemberof') {
1466
25
21
                                        if(!defined($value)) {
1467
0
0
                                                next;   # Skip if string is undefined
1468                                        }
1469
25
17
                                        if(ref($rule_value) eq 'ARRAY') {
1470
24
13
                                                my $ok = 1;
1471
24
42
                                                if(($rules->{'type'} eq 'integer') || ($rules->{'type'} eq 'number') || ($rules->{'type'} eq 'float')) {
1472
6
17
6
10
12
8
                                                        if(List::Util::any { $_ == $value } @{$rule_value}) {
1473
4
3
                                                                $ok = 0;
1474                                                        }
1475                                                } else {
1476
18
16
                                                        my $l = lc($value);
1477
18
36
18
39
44
21
                                                        if(List::Util::any { (!defined($rules->{'case_sensitive'}) || ($rules->{'case_sensitive'} == 1)) ? $_ eq $value : lc($_) eq $l } @{$rule_value}) {
1478
9
5
                                                                $ok = 0;
1479                                                        }
1480                                                }
1481
1482
24
43
                                                if(!$ok) {
1483
13
11
                                                        if($rules->{'error_msg'}) {
1484
1
2
                                                                _error($logger, $rules->{'error_msg'});
1485                                                        } else {
1486
12
12
15
21
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must not be one of ", join(', ', @{$rule_value}));
1487                                                        }
1488
0
0
                                                        $invalid_args{$key} = 1;
1489                                                }
1490                                        } else {
1491
1
2
                                                if($rules->{'error_msg'}) {
1492
0
0
                                                        _error($logger, $rules->{'error_msg'});
1493                                                } else {
1494
1
1
                                                        _error($logger, "$rule_description: Parameter '$key' rule ($rule_value) must be an array reference");
1495                                                }
1496                                        }
1497                                } elsif($rule_name eq 'isa') {
1498
6
9
                                        if(!defined($value)) {
1499
0
0
                                                next;   # Skip if object not given
1500                                        }
1501
6
9
                                        if($rules->{'type'} eq 'object') {
1502
5
16
                                                if(!$value->isa($rule_value)) {
1503
1
5
                                                        _error($logger, "$rule_description: Parameter '$key' must be a '$rule_value' object");
1504
0
0
                                                        $invalid_args{$key} = 1;
1505                                                }
1506                                        } else {
1507
1
3
                                                _error($logger, "$rule_description: Parameter '$key' has meaningless isa value $rule_value");
1508                                        }
1509                                } elsif($rule_name eq 'can') {
1510
16
18
                                        if(!defined($value)) {
1511
0
0
                                                next;   # Skip if object not given
1512                                        }
1513
16
25
                                        if($rules->{'type'} eq 'object') {
1514
15
32
                                                if(ref($rule_value) eq 'ARRAY') {
1515                                                        # List of methods
1516
8
8
10
9
                                                        foreach my $method(@{$rule_value}) {
1517
15
57
                                                                if(!$value->can($method)) {
1518
4
8
                                                                        _error($logger, "$rule_description: Parameter '$key' must be an object that understands the $method method");
1519
0
0
                                                                        $invalid_args{$key} = 1;
1520                                                                }
1521                                                        }
1522                                                } elsif(!ref($rule_value)) {
1523
6
31
                                                        if(!$value->can($rule_value)) {
1524
3
10
                                                                _error($logger, "$rule_description: Parameter '$key' must be an object that understands the $rule_value method");
1525
0
0
                                                                $invalid_args{$key} = 1;
1526                                                        }
1527                                                } else {
1528
1
2
                                                        _error($logger, "$rule_description: 'can' rule for Parameter '$key must be either a scalar or an arrayref");
1529                                                }
1530                                        } else {
1531
1
3
                                                _error($logger, "$rule_description: Parameter '$key' has meaningless can value $rule_value");
1532                                        }
1533                                } elsif($rule_name eq 'element_type') {
1534
20
34
                                        if(($rules->{'type'} eq 'arrayref') || ($rules->{'type'} eq 'ArrayRef')) {
1535
20
20
                                                my $type = $rule_value;
1536
20
27
                                                my $custom_type = $custom_types->{$rule_value};
1537
20
30
                                                if($custom_type && $custom_type->{'type'}) {
1538
1
1
                                                        $type = $custom_type->{'type'};
1539                                                }
1540
20
20
15
20
                                                foreach my $member(@{$value}) {
1541
45
45
                                                        if($custom_type && $custom_type->{'transform'}) {
1542                                                                # The custom type has a transform embedded within it
1543
2
3
                                                                if(ref($custom_type->{'transform'}) eq 'CODE') {
1544
2
2
1
3
                                                                        $member = &{$custom_type->{'transform'}}($member);
1545                                                                } else {
1546
0
0
                                                                        _error($logger, "$rule_description: transforms must be a code ref");
1547
0
0
                                                                        last;
1548                                                                }
1549                                                        }
1550
45
75
                                                        if(($type eq 'string') || ($type eq 'Str')) {
1551
15
19
                                                                if(ref($member)) {
1552
0
0
                                                                        if($rules->{'error_msg'}) {
1553
0
0
                                                                                _error($logger, $rules->{'error_msg'});
1554                                                                        } else {
1555
0
0
                                                                                _error($logger, "$key can only contain strings");
1556                                                                        }
1557
0
0
                                                                        $invalid_args{$key} = 1;
1558                                                                }
1559                                                        } elsif($type eq 'integer') {
1560
23
45
                                                                if(ref($member) || ($member =~ /\D/)) {
1561
2
4
                                                                        if($rules->{'error_msg'}) {
1562
1
2
                                                                                _error($logger, $rules->{'error_msg'});
1563                                                                        } else {
1564
1
2
                                                                                _error($logger, "$key can only contain integers (found $member)");
1565                                                                        }
1566
0
0
                                                                        $invalid_args{$key} = 1;
1567                                                                }
1568                                                        } elsif(($type eq 'number') || ($rule_value eq 'float')) {
1569
7
28
                                                                if(ref($member) || ($member !~ /^[-+]?(\d*\.\d+|\d+\.?\d*)$/)) {
1570
1
1
                                                                        if($rules->{'error_msg'}) {
1571
0
0
                                                                                _error($logger, $rules->{'error_msg'});
1572                                                                        } else {
1573
1
2
                                                                                _error($logger, "$key can only contain numbers (found $member)");
1574                                                                        }
1575
0
0
                                                                        $invalid_args{$key} = 1;
1576                                                                }
1577                                                        } else {
1578
0
0
                                                                _error($logger, "BUG: Add $type to element_type list");
1579                                                        }
1580                                                }
1581                                        } else {
1582
0
0
                                                _error($logger, "$rule_description: Parameter '$key' has meaningless element_type value $rule_value");
1583                                        }
1584                                } elsif($rule_name eq 'optional') {
1585                                        # Already handled at the beginning of the loop
1586                                } elsif($rule_name eq 'default') {
1587                                        # Handled earlier
1588                                } elsif($rule_name eq 'error_msg') {
1589                                        # Handled inline
1590                                } elsif($rule_name eq 'transform') {
1591                                        # Handled before the loop
1592                                } elsif($rule_name eq 'case_sensitive') {
1593                                        # Handled inline
1594                                } elsif($rule_name eq 'description') {
1595                                        # A la, Data::Processor
1596                                } elsif($rule_name =~ /^_/) {
1597                                        # Ignore internal/metadata fields from schema extraction
1598                                } elsif($rule_name eq 'semantic') {
1599
1
5
                                        if($rule_value eq 'unix_timestamp') {
1600
1
3
                                                if($value < 0 || $value > 2147483647) {
1601
0
0
                                                        error($logger, 'Invalid Unix timestamp: $value');
1602                                                }
1603                                        } else {
1604
0
0
                                                _warn($logger, "semantic type $rule_value is not yet supported");
1605                                        }
1606                                } elsif($rule_name eq 'schema') {
1607                                        # Nested schema Run the given schema against each element of the array
1608
45
93
                                        if(($rules->{'type'} eq 'arrayref') || ($rules->{'type'} eq 'ArrayRef')) {
1609
11
21
                                                if(ref($value) eq 'ARRAY') {
1610
11
11
10
14
                                                        foreach my $member(@{$value}) {
1611
16
33
                                                                if(!validate_strict({ input => { $key => $member }, schema => { $key => $rule_value }, custom_types => $custom_types })) {
1612
0
0
                                                                        $invalid_args{$key} = 1;
1613                                                                }
1614                                                        }
1615                                                } elsif(defined($value)) {      # Allow undef for optional values
1616
0
0
                                                        _error($logger, "$rule_description: nested schema: Parameter '$value' must be an arrayref");
1617                                                }
1618                                        } elsif($rules->{'type'} eq 'hashref') {
1619
34
57
                                                if(ref($value) eq 'HASH') {
1620                                                        # Apply nested defaults before validation
1621
34
55
                                                        my $nested_with_defaults = _apply_nested_defaults($value, $rule_value);
1622
34
34
23
42
                                                        if(scalar keys(%{$value})) {
1623
32
188
                                                                if(my $new_args = validate_strict({ input => $nested_with_defaults, schema => $rule_value, custom_types => $custom_types })) {
1624
21
34
                                                                        $value = $new_args;
1625                                                                } else {
1626
0
0
                                                                        $invalid_args{$key} = 1;
1627                                                                }
1628                                                        }
1629                                                } else {
1630
0
0
                                                        _error($logger, "$rule_description: nested schema: Parameter '$value' must be an hashref");
1631                                                }
1632                                        } else {
1633
0
0
                                                _error($logger, "$rule_description: Parameter '$key': 'schema' only supports arrayref and hashref, not $rules->{type}");
1634                                        }
1635                                } elsif(($rule_name eq 'validate') || ($rule_name eq 'validator')) {
1636
2
3
                                        if(ref($rule_value) eq 'CODE') {
1637
2
2
1
3
                                                if(my $error = &{$rule_value}($args)) {
1638
1
5
                                                        _error($logger, "$rule_description: $key not valid: $error");
1639
0
0
                                                        $invalid_args{$key} = 1;
1640                                                }
1641                                        } else {
1642                                                # _error($logger, "$rule_description: Parameter '$key': 'validate' only supports coderef, not $value");
1643
0
0
                                                _error($logger, "$rule_description: Parameter '$key': 'validate' only supports coderef, not " . ref($rule_value) // $rule_value);
1644                                        }
1645                                } elsif ($rule_name eq 'callback') {
1646
17
36
                                        unless (defined &$rule_value) {
1647
1
3
                                                _error($logger, "$rule_description: callback for '$key' must be a code reference");
1648                                        }
1649
16
20
                                        my $res = $rule_value->($value);
1650
15
2676
                                        unless ($res) {
1651
6
9
                                                if($rules->{'error_msg'}) {
1652
0
0
                                                        _error($logger, $rules->{'error_msg'});
1653                                                } else {
1654
6
11
                                                        _error($logger, "$rule_description: Parameter '$key' failed custom validation");
1655                                                }
1656
0
0
                                                $invalid_args{$key} = 1;
1657                                        }
1658                                } elsif($rule_name eq 'position') {
1659
5
7
                                        if($rule_value =~ /\D/) {
1660
0
0
                                                _error($logger, "$rule_description: Parameter '$key': 'position' must be an integer");
1661                                        }
1662
5
9
                                        if($rule_value < 0) {
1663
0
0
                                                _error($logger, "$rule_description: Parameter '$key': 'position' must be a positive integer, not $value");
1664                                        }
1665                                } else {
1666
0
0
                                        _error($logger, "$rule_description: Unknown rule '$rule_name'");
1667                                }
1668                        }
1669                } elsif(ref($rules) eq 'ARRAY') {
1670
12
12
10
15
                        if(scalar(@{$rules})) {
1671                                # An argument can be one of several different type
1672
10
8
                                my $rc = 0;
1673
10
10
                                my @types;
1674
10
10
5
12
                                foreach my $rule(@{$rules}) {
1675
17
24
                                        if(ref($rule) ne 'HASH') {
1676
1
3
                                                _error($logger, "$rule_description: Parameter '$key' rules must be a hash reference");
1677
0
0
                                                next;
1678                                        }
1679
16
19
                                        if(!defined($rule->{'type'})) {
1680
0
0
                                                _error($logger, "$rule_description: Parameter '$key' is missing a type in an alternative");
1681
0
0
                                                next;
1682                                        }
1683
16
15
                                        push @types, $rule->{'type'};
1684
16
12
                                        eval {
1685
16
60
                                                validate_strict({ input => { $key => $value }, schema => { $key => $rule }, logger => undef, custom_types => $custom_types });
1686                                        };
1687
16
11131
                                        if(!$@) {
1688
7
4
                                                $rc = 1;
1689
7
8
                                                last;
1690                                        }
1691                                }
1692
9
12
                                if(!$rc) {
1693
2
5
                                        _error($logger, "$rule_description: Parameter: '$key': must be one of " . join(', ', @types));
1694
0
0
                                        $invalid_args{$key} = 1;
1695                                }
1696                        } else {
1697
2
4
                                _error($logger, "$rule_description: Parameter: '$key': schema is empty arrayref");
1698                        }
1699                } elsif(ref($rules)) {
1700
1
2
                        _error($logger, 'rules must be a hash reference or string');
1701                }
1702
1703
458
547
                $validated_args{$key} = $value;
1704        }
1705
1706        # Validate parameter relationships
1707
313
351
        if (my $relationships = $params->{'relationships'}) {
1708
6
9
                _validate_relationships(\%validated_args, $relationships, $logger, $schema_description);
1709        }
1710
1711
308
280
        if(my $cross_validation = $params->{'cross_validation'}) {
1712
37
37
27
31
                foreach my $validator_name(keys %{$cross_validation}) {
1713
42
39
                        my $validator = $cross_validation->{$validator_name};
1714
42
59
                        if((!ref($validator)) || (ref($validator) ne 'CODE')) {
1715
1
2
                                _error($logger, "$schema_description: cross_validation $validator is not a code snippet");
1716
0
0
                                next;
1717                        }
1718
41
41
29
45
                        if(my $error = &{$validator}(\%validated_args, $validator)) {
1719
18
68
                                _error($logger, $error);
1720                                # We have no idea which parameters are still valid, so let's invalidate them all
1721
0
0
                                return;
1722                        }
1723                }
1724        }
1725
1726
289
294
        foreach my $key(keys %invalid_args) {
1727
0
0
                delete $validated_args{$key};
1728        }
1729
1730
289
235
        if($are_positional_args == 1) {
1731
4
6
                my @rc;
1732
4
4
2
4
                foreach my $key (keys %{$schema}) {
1733
6
8
                        if(my $value = delete $validated_args{$key}) {
1734
6
5
                                my $position = $schema->{$key}->{'position'};
1735
6
5
                                if(defined($rc[$position])) {
1736
1
2
                                        _error($logger, "$schema_description: $key: position $position appears twice");
1737                                }
1738
5
6
                                $rc[$position] = $value;
1739                        }
1740                }
1741
3
10
                return \@rc;
1742        }
1743
285
648
        return \%validated_args;
1744}
1745
1746# Return number of visible characters not number of bytes
1747# Ensure string is decoded into Perl characters
1748sub _number_of_characters
1749{
1750
81
59
        my $value = $_[0];
1751
1752
81
74
        return if(!defined($value));
1753
1754
81
403
        if($value !~ /[^[:ascii:]]/) {
1755
74
94
                return length($value);
1756        }
1757        # Decode only if it's not already a Perl character string
1758
7
47
        $value = decode_utf8($value) unless utf8::is_utf8($value);
1759
1760        # Count grapheme clusters (visible characters)
1761        # The pseudo-operator () = forces list context to count matches
1762        # return scalar( () = $value =~ /\X/g );
1763
1764
7
38
        return Unicode::GCString->new($value)->length();
1765}
1766
1767sub _apply_nested_defaults {
1768
46
42
        my ($input, $schema) = @_;
1769
46
58
        my %result = %$input;
1770
1771
46
49
        foreach my $key (keys %$schema) {
1772
108
72
                my $rules = $schema->{$key};
1773
1774
108
160
                if (ref $rules eq 'HASH' && exists $rules->{default} && !exists $result{$key}) {
1775
2
2
                        $result{$key} = $rules->{default};
1776                }
1777
1778                # Recursively handle nested schema
1779
108
172
                if((ref $rules eq 'HASH') && $rules->{schema} && (ref $result{$key} eq 'HASH')) {
1780
8
15
                        $result{$key} = _apply_nested_defaults($result{$key}, $rules->{schema});
1781                }
1782        }
1783
1784
46
43
        return \%result;
1785}
1786
1787sub _validate_relationships {
1788
6
6
        my ($validated_args, $relationships, $logger, $description) = @_;
1789
1790
6
8
        return unless ref($relationships) eq 'ARRAY';
1791
1792
6
6
        foreach my $rel (@$relationships) {
1793
6
7
                my $type = $rel->{type} or next;
1794
1795
6
26
                if ($type eq 'mutually_exclusive') {
1796
1
3
                        _validate_mutually_exclusive($validated_args, $rel, $logger, $description);
1797                } elsif ($type eq 'required_group') {
1798
1
2
                        _validate_required_group($validated_args, $rel, $logger, $description);
1799                } elsif ($type eq 'conditional_requirement') {
1800
1
2
                        _validate_conditional_requirement($validated_args, $rel, $logger, $description);
1801                } elsif ($type eq 'dependency') {
1802
1
3
                        _validate_dependency($validated_args, $rel, $logger, $description);
1803                } elsif ($type eq 'value_constraint') {
1804
1
3
                        _validate_value_constraint($validated_args, $rel, $logger, $description);
1805                } elsif ($type eq 'value_conditional') {
1806
1
2
                        _validate_value_conditional($validated_args, $rel, $logger, $description);
1807                } else {
1808
0
0
                        _error($logger, "Unknown relationship type $type");
1809                }
1810        }
1811}
1812
1813sub _validate_mutually_exclusive {
1814
1
1
        my ($args, $rel, $logger, $description) = @_;
1815
1816
1
1
1
2
        my @params = @{$rel->{params} || []};
1817
1
4
        return unless @params >= 2;
1818
1819
1
2
2
20
        my @present = grep { exists($args->{$_}) && defined($args->{$_}) } @params;
1820
1821
1
2
        if (@present > 1) {
1822
1
2
                my $msg = $rel->{description} || 'Cannot specify both ' . join(' and ', @present);
1823
1
3
                _error($logger, "$description: $msg");
1824        }
1825}
1826
1827sub _validate_required_group {
1828
1
2
        my ($args, $rel, $logger, $description) = @_;
1829
1830
1
1
1
2
        my @params = @{$rel->{params} || []};
1831
1
4
        return unless @params >= 2;
1832
1833
1
2
1
3
        my @present = grep { exists($args->{$_}) && defined($args->{$_}) } @params;
1834
1835
1
2
        if (@present == 0) {
1836                my $msg = $rel->{description} ||
1837
1
7
                        'Must specify at least one of: ' . join(', ', @params);
1838
1
2
                _error($logger, "$description: $msg");
1839        }
1840}
1841
1842sub _validate_conditional_requirement {
1843
1
2
        my ($args, $rel, $logger, $description) = @_;
1844
1845
1
13
        my $if_param = $rel->{if} or return;
1846
1
3
        my $then_param = $rel->{then_required} or return;
1847
1848        # If the condition parameter is present and defined
1849
1
4
        if (exists($args->{$if_param}) && defined($args->{$if_param})) {
1850                # Check if it's truthy (for booleans and general values)
1851
1
1
                if ($args->{$if_param}) {
1852                        # Then the required parameter must also be present
1853
1
3
                        unless (exists($args->{$then_param}) && defined($args->{$then_param})) {
1854
0
0
                                my $msg = $rel->{description} || "When $if_param is specified, $then_param is required";
1855
0
0
                                _error($logger, "$description: $msg");
1856                        }
1857                }
1858        }
1859}
1860
1861sub _validate_dependency {
1862
1
2
        my ($args, $rel, $logger, $description) = @_;
1863
1864
1
1
        my $param = $rel->{param} or return;
1865
1
2
        my $requires = $rel->{requires} or return;
1866
1867        # If param is present, requires must also be present
1868
1
4
        if (exists($args->{$param}) && defined($args->{$param})) {
1869
1
2
                unless (exists($args->{$requires}) && defined($args->{$requires})) {
1870
1
4
                        my $msg = $rel->{description} || "$param requires $requires to be specified";
1871
1
4
                        _error($logger, "$description: $msg");
1872                }
1873        }
1874}
1875
1876sub _validate_value_constraint {
1877
1
2
        my ($args, $rel, $logger, $description) = @_;
1878
1879
1
1
        my $if_param = $rel->{if} or return;
1880
1
2
        my $then_param = $rel->{then} or return;
1881
1
2
        my $operator = $rel->{operator} or return;
1882
1
1
        my $value = $rel->{value};
1883
1
2
        return unless defined $value;
1884
1885        # If the condition parameter is present and truthy
1886
1
4
        if (exists($args->{$if_param}) && defined($args->{$if_param}) && $args->{$if_param}) {
1887                # Check if the then parameter exists
1888
1
5
                if (exists($args->{$then_param}) && defined($args->{$then_param})) {
1889
1
1
                        my $actual = $args->{$then_param};
1890
1
1
                        my $valid = 0;
1891
1892
1
1
                        if ($operator eq '==') {
1893
1
9
                                $valid = ($actual == $value);
1894                        } elsif ($operator eq '!=') {
1895
0
0
                                $valid = ($actual != $value);
1896                        } elsif ($operator eq '<') {
1897
0
0
                                $valid = ($actual < $value);
1898                        } elsif ($operator eq '<=') {
1899
0
0
                                $valid = ($actual <= $value);
1900                        } elsif ($operator eq '>') {
1901
0
0
                                $valid = ($actual > $value);
1902                        } elsif ($operator eq '>=') {
1903
0
0
                                $valid = ($actual >= $value);
1904                        }
1905
1906
1
2
                        unless ($valid) {
1907
1
2
                                my $msg = $rel->{description} || "When $if_param is specified, $then_param must be $operator $value (got $actual)";
1908
1
2
                                _error($logger, "$description: $msg");
1909                        }
1910                }
1911        }
1912}
1913
1914sub _validate_value_conditional {
1915
1
2
        my ($args, $rel, $logger, $description) = @_;
1916
1917
1
1
        my $if_param = $rel->{if} or return;
1918
1
6
        my $equals = $rel->{equals};
1919
1
1
        my $then_param = $rel->{then_required} or return;
1920
1
1
        return unless defined $equals;
1921
1922        # If the parameter has the specific value
1923
1
4
        if (exists($args->{$if_param}) && defined($args->{$if_param})) {
1924
1
2
                if ($args->{$if_param} eq $equals) {
1925                        # Then the required parameter must be present
1926
1
2
                        unless (exists($args->{$then_param}) && defined($args->{$then_param})) {
1927                                my $msg = $rel->{description} ||
1928
1
3
                                        "When $if_param equals '$equals', $then_param is required";
1929
1
3
                                _error($logger, "$description: $msg");
1930                        }
1931                }
1932        }
1933}
1934
1935# Helper to log error or croak
1936sub _error
1937{
1938
222
174
        my $logger = shift;
1939
222
259
        my $message = join('', @_);
1940
1941
222
262
        my @call_details = caller(0);
1942
222
3271
        if($logger) {
1943
12
29
                $logger->error(__PACKAGE__, ' line ', $call_details[2], ": $message");
1944        }
1945
217
1103
        croak(__PACKAGE__, ' line ', $call_details[2], ": $message");
1946        # Be absolutely sure, sometimes croak doesn't die for me in Test::Most scripts
1947
0
0
        die (__PACKAGE__, ' line ', $call_details[2], ": $message");
1948}
1949
1950# Helper to log warning or carp
1951sub _warn
1952{
1953
4
19
        my $logger = shift;
1954
4
7
        my $message = join('', @_);
1955
1956
4
6
        if($logger) {
1957
3
11
                $logger->warn(__PACKAGE__, ": $message");
1958        } else {
1959
1
6
                carp(__PACKAGE__, ": $message");
1960        }
1961}
1962
1963 - 2112
=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

    SimpleType ::= string | integer | number | arrayref | hashref | coderef | object

    ComplexRule == [
        type: TYPE_NAME;
        min: ℕ₁;
        max: ℕ₁;
        optional: 𝔹;
        matches: REGEX;
        nomatch: REGEX;
        memberof: 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.min) ∧
      Â¬(rule.memberof ∧ 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 * Test coverage report: L<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

=cut
2113
21141;
2115