File Coverage

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

linestmtbrancondsubtimecode
1package Params::Validate::Strict;
2
3# FIXME: {max} doesn't play ball with non-ascii strings
4
5
18
18
18
1182538
17
253
use strict;
6
18
18
18
29
15
313
use warnings;
7
8
18
18
18
33
11
421
use Carp;
9
18
18
18
27
33
237
use Exporter qw(import);        # Required for @EXPORT_OK
10
18
18
18
4096
115939
712
use Encode qw(decode_utf8);
11
18
18
18
44
179
526
use List::Util 1.33 qw(any);    # Required for memberof validation
12
18
18
18
3030
75301
354
use Params::Get 0.13;
13
18
18
18
57
15
47166
use Scalar::Util;
14
15our @ISA = qw(Exporter);
16our @EXPORT_OK = qw(validate_strict);
17
18 - 26
=head1 NAME

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

=head1 VERSION

Version 0.25

=cut
27
28our $VERSION = '0.25';
29
30 - 751
=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<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.

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

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

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

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

=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
752
753sub validate_strict
754{
755
508
1564813
        my $params = Params::Get::get_params(undef, \@_);
756
757
508
5939
        my $schema = $params->{'schema'} || $params->{'members'};
758
508
767
        my $args = $params->{'args'} || $params->{'input'};
759
508
696
        my $unknown_parameter_handler = $params->{'unknown_parameter_handler'} || 'die';
760
508
362
        my $logger = $params->{'logger'};
761
508
349
        my $custom_types = $params->{'custom_types'};
762
763        # Check if schema and args are references to hashes
764
508
581
        if(ref($schema) ne 'HASH') {
765
3
4
                _error($logger, 'validate_strict: schema must be a hash reference');
766        }
767
768        # Inspired by Data::Processor
769
505
629
        my $schema_description = $params->{'description'} || 'validate_strict';
770
505
330
        my $error_msg = $params->{'error_msg'};
771
772
505
476
        if($schema->{'members'} && ($schema->{'description'} || $schema->{'error_msg'})) {
773
1
1
                $schema_description = $schema->{'description'};
774
1
4
                $error_msg = $schema->{'error_msg'};
775
1
1
                $schema = $schema->{'members'};
776        }
777
778
505
938
        if(exists($params->{'args'}) && (!defined($args))) {
779
1
1
                $args = {};
780        } elsif((ref($args) ne 'HASH') && (ref($args) ne 'ARRAY')) {
781
2
2
                _error($logger, "$schema_description: args must be a hash or array reference");
782        }
783
784
503
487
        if(ref($args) eq 'HASH') {
785                # Named args
786
500
500
300
572
                foreach my $key (keys %{$args}) {
787
658
656
                        if(!exists($schema->{$key})) {
788
12
18
                                if($unknown_parameter_handler eq 'die') {
789
5
9
                                        _error($logger, "$schema_description: Unknown parameter '$key'");
790                                } elsif($unknown_parameter_handler eq 'warn') {
791
3
9
                                        _warn($logger, "$schema_description: Unknown parameter '$key'");
792
3
185
                                        next;
793                                } elsif($unknown_parameter_handler eq 'ignore') {
794
2
20
                                        if($logger) {
795
1
4
                                                $logger->debug(__PACKAGE__ . "$schema_description: Unknown parameter '$key'");
796                                        }
797
2
4
                                        next;
798                                } else {
799
2
4
                                        _error($logger, "$schema_description: '$unknown_parameter_handler' unknown_parameter_handler must be one of die, warn, ignore");
800                                }
801                        }
802                }
803        }
804
805        # Find out if this routine takes positional arguments
806
496
410
        my $are_positional_args = -1;
807
496
496
292
464
        foreach my $key (keys %{$schema}) {
808
495
480
                if(defined(my $rules = $schema->{$key})) {
809
493
448
                        if(ref($rules) eq 'HASH') {
810
465
452
                                if(!defined($rules->{'position'})) {
811
461
420
                                        if($are_positional_args == 1) {
812
0
0
                                                _error($logger, "::validate_strict: $key is missing position value");
813                                        }
814
461
311
                                        $are_positional_args = 0;
815
461
379
                                        last;
816                                }
817
4
2
                                $are_positional_args = 1;
818                        } else {
819
28
23
                                $are_positional_args = 0;
820
28
26
                                last;
821                        }
822                } else {
823
2
1
                        $are_positional_args = 0;
824
2
5
                        last;
825                }
826        }
827
828
496
395
        my %validated_args;
829        my %invalid_args;
830
496
496
307
381
        foreach my $key (keys %{$schema}) {
831
712
467
                my $rules = $schema->{$key};
832
712
4
604
4
                my $value = ($are_positional_args == 1) ? @{$args}[$rules->{'position'}] : $args->{$key};
833
834
712
559
                if(!defined($rules)) {  # Allow anything
835
2
2
                        $validated_args{$key} = $value;
836
2
2
                        next;
837                }
838
839                # If rules are a simple type string
840
710
585
                if(ref($rules) eq '') {
841
26
22
                        $rules = { type => $rules };
842                }
843
844
710
405
                my $is_optional = 0;
845
846
710
443
                my $rule_description = $schema_description;     # Can be overridden in each element
847
848
710
567
                if(ref($rules) eq 'HASH') {
849
697
561
                        if(exists($rules->{'description'})) {
850
0
0
                                $rule_description = $rules->{'description'};
851                        }
852
697
667
                        if($rules->{'transform'} && defined($value)) {
853
39
39
                                if(ref($rules->{'transform'}) eq 'CODE') {
854
37
37
26
50
                                        $value = &{$rules->{'transform'}}($value);
855                                } else {
856
2
3
                                        _error($logger, "$rule_description: transforms must be a code ref");
857                                }
858                        }
859
695
704
                        if(exists($rules->{optional})) {
860
146
138
                                if(ref($rules->{'optional'}) eq 'CODE') {
861
9
9
8
9
                                        $is_optional = &{$rules->{optional}}($value, $args);
862                                } else {
863
137
88
                                        $is_optional = $rules->{'optional'};
864                                }
865                        }
866                }
867
868                # Handle optional parameters
869
708
1316
                if((ref($rules) eq 'HASH') && $is_optional) {
870
138
90
                        my $look_for_default = 0;
871
138
98
                        if($are_positional_args == 1) {
872
2
2
2
3
                                if(!defined(@{$args}[$rules->{'position'}])) {
873
1
1
                                        $look_for_default = 1;
874                                }
875                        } else {
876
136
112
                                if(!exists($args->{$key})) {
877
72
47
                                        $look_for_default = 1;
878                                }
879                        }
880
138
120
                        if($look_for_default) {
881
73
60
                                if($are_positional_args == 1) {
882
1
1
1
2
                                        if(scalar(@{$args}) < $rules->{'position'}) {
883                                                # arg array is too short, so it must be missing
884
0
0
                                                _error($logger, "$rule_description: Required parameter '$key' is missing");
885
0
0
                                                next;
886                                        }
887                                }
888
73
76
                                if(exists($rules->{'default'})) {
889                                        # Populate missing optional parameters with the specified output values
890
5
7
                                        $validated_args{$key} = $rules->{'default'};
891                                }
892
893
73
64
                                if($rules->{'schema'}) {
894
4
10
                                        $value = _apply_nested_defaults({}, $rules->{'schema'});
895
4
4
3
9
                                        next unless scalar(%{$value});
896                                        # The nested schema has a default value
897                                } else {
898
69
62
                                        next;   # optional and missing
899                                }
900                        }
901                } elsif((ref($args) eq 'HASH') && !exists($args->{$key})) {
902                        # The parameter is required
903
7
15
                        _error($logger, "$rule_description: Required parameter '$key' is missing");
904                }
905
906                # Validate based on rules
907
630
507
                if(ref($rules) eq 'HASH') {
908
617
672
                        if((my $min = $rules->{'min'}) && (my $max = $rules->{'max'})) {
909
55
59
                                if($min > $max) {
910
4
9
                                        _error($logger, "validate_strict($key): min must be <= max ($min > $max)");
911                                }
912                        }
913
914
613
471
                        if($rules->{'memberof'}) {
915
69
66
                                if(my $min = $rules->{'min'}) {
916
2
6
                                        _error($logger, "validate_strict($key): min ($min) makes no sense with memberof");
917                                }
918
67
74
                                if(my $max = $rules->{'max'}) {
919
1
2
                                        _error($logger, "validate_strict($key): max ($max) makes no sense with memberof");
920                                }
921                        }
922
923
610
515
                        foreach my $rule_name (keys %$rules) {
924
1155
794
                                my $rule_value = $rules->{$rule_name};
925
926
1155
1128
                                if((ref($rule_value) eq 'CODE') && ($rule_name ne 'validate') && ($rule_name ne 'callback') && ($rule_name ne 'validator')) {
927
54
54
34
49
                                        $rule_value = &{$rule_value}($value, $args);
928                                }
929
930
1155
1734
                                if($rule_name eq 'type') {
931
547
393
                                        my $type = lc($rule_value);
932
933
547
770
                                        if($type eq 'string') {
934
245
209
                                                if(ref($value)) {
935
6
17
                                                        _error($logger, $rules->{'error_msg'} || "$rule_description: Parameter '$key' must be a string");
936                                                }
937
239
272
                                                unless((ref($value) eq '') || (defined($value) && length($value))) {    # Allow undef for optional strings
938
0
0
                                                        _error($logger, $rules->{'error_msg'} || "$rule_description: Parameter '$key' must be a string");
939                                                }
940                                        } elsif($type eq 'integer') {
941
88
84
                                                if(!defined($value)) {
942
1
2
                                                        next;   # Skip if number is undefined
943                                                }
944
87
214
                                                if($value !~ /^\s*[+\-]?\d+\s*$/) {
945
4
6
                                                        if($rules->{'error_msg'}) {
946
1
2
                                                                _error($logger, $rules->{'error_msg'});
947                                                        } else {
948
3
7
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must be an integer");
949                                                        }
950                                                }
951
83
82
                                                $value = int($value); # Coerce to integer
952                                        } elsif(($type eq 'number') || ($type eq 'float')) {
953
49
50
                                                if(!defined($value)) {
954
2
17
                                                        next;   # Skip if number is undefined
955                                                }
956
47
60
                                                if(!Scalar::Util::looks_like_number($value)) {
957
2
3
                                                        if($rules->{'error_msg'}) {
958
0
0
                                                                _error($logger, $rules->{'error_msg'});
959                                                        } else {
960
2
3
                                                                _error($logger, "$rule_description: Parameter '$key' must be a number");
961                                                        }
962                                                }
963                                                # $value = eval $value; # Coerce to number (be careful with eval)
964
45
58
                                                $value = 0 + $value;    # Numeric coercion
965                                        } elsif($type eq 'arrayref') {
966
39
46
                                                if(!defined($value)) {
967
2
2
                                                        next;   # Skip if arrayref is undefined
968                                                }
969
37
51
                                                if(ref($value) ne 'ARRAY') {
970
0
0
                                                        if($rules->{'error_msg'}) {
971
0
0
                                                                _error($logger, $rules->{'error_msg'});
972                                                        } else {
973
0
0
                                                                _error($logger, "$rule_description: Parameter '$key' must be an arrayref, not " . ref($value));
974                                                        }
975                                                }
976                                        } elsif($type eq 'hashref') {
977
38
35
                                                if(!defined($value)) {
978
2
3
                                                        next;   # Skip if hashref is undefined
979                                                }
980
36
46
                                                if(ref($value) ne 'HASH') {
981
0
0
                                                        if($rules->{'error_msg'}) {
982
0
0
                                                                _error($logger, $rules->{'error_msg'});
983                                                        } else {
984
0
0
                                                                _error($logger, "$rule_description: Parameter '$key' must be an hashref");
985                                                        }
986                                                }
987                                        } elsif($type eq 'boolean') {
988
21
18
                                                if(!defined($value)) {
989
1
2
                                                        next;   # Skip if bool is undefined
990                                                }
991
20
64
                                                if(($value eq 'true') || ($value eq 'on') || ($value eq 'yes')) {
992
3
2
                                                        $value = 1;
993                                                } elsif(($value eq 'false') || ($value eq 'off') || ($value eq 'no')) {
994
3
1
                                                        $value = 0;
995                                                }
996
20
37
                                                if(($value ne '1') && ($value ne '0')) {        # Do string compare
997
2
3
                                                        if($rules->{'error_msg'}) {
998
0
0
                                                                _error($logger, $rules->{'error_msg'});
999                                                        } else {
1000
2
4
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must be a boolean");
1001                                                        }
1002                                                }
1003
18
19
                                                $value = int($value);   # Coerce to integer
1004                                        } elsif($type eq 'coderef') {
1005
3
6
                                                if(!defined($value)) {
1006
1
1
                                                        next;   # Skip if code is undefined
1007                                                }
1008
2
4
                                                if(ref($value) ne 'CODE') {
1009
0
0
                                                        if($rules->{'error_msg'}) {
1010
0
0
                                                                _error($logger, $rules->{'error_msg'});
1011                                                        } else {
1012
0
0
                                                                _error($logger, "$rule_description: Parameter '$key' must be a coderef");
1013                                                        }
1014                                                }
1015                                        } elsif($type eq 'object') {
1016
19
20
                                                if(!defined($value)) {
1017
1
1
                                                        next;   # Skip if object is undefined
1018                                                }
1019
18
39
                                                if(!Scalar::Util::blessed($value)) {
1020
1
2
                                                        if($rules->{'error_msg'}) {
1021
0
0
                                                                _error($logger, $rules->{'error_msg'});
1022                                                        } else {
1023
1
3
                                                                _error($logger, "$rule_description: Parameter '$key' must be an object");
1024                                                        }
1025                                                }
1026                                        } elsif(my $custom_type = $custom_types->{$type}) {
1027
44
66
                                                if($custom_type->{'transform'}) {
1028                                                        # The custom type has a transform embedded within it
1029
6
9
                                                        if(ref($custom_type->{'transform'}) eq 'CODE') {
1030
6
6
5
14
                                                                $value = &{$custom_type->{'transform'}}($value);
1031                                                        } else {
1032
0
0
                                                                _error($logger, "$rule_description: transforms must be a code ref");
1033
0
0
                                                                next;
1034                                                        }
1035                                                }
1036
44
226
                                                validate_strict({ input => { $key => $value }, schema => { $key => $custom_type }, custom_types => $custom_types });
1037                                        } else {
1038
1
2
                                                _error($logger, "$rule_description: Unknown type '$type'");
1039                                        }
1040                                } elsif($rule_name eq 'min') {
1041
148
157
                                        if(!defined($rules->{'type'})) {
1042
0
0
                                                _error($logger, "$rule_description: Don't know type of '$key' to determine its minimum value $rule_value");
1043                                        }
1044
148
128
                                        my $type = lc($rules->{'type'});
1045
148
184
                                        if(exists($custom_types->{$type}->{'min'})) {
1046
2
2
                                                $rule_value = $custom_types->{$type}->{'min'};
1047
2
2
                                                $type = $custom_types->{$type}->{'type'};
1048                                        }
1049
148
261
                                        if($type eq 'string') {
1050
51
52
                                                if($rule_value < 0) {
1051
1
1
                                                        if($rules->{'error_msg'}) {
1052
0
0
                                                                _error($logger, $rules->{'error_msg'});
1053                                                        } else {
1054
1
2
                                                                _error($logger, "$rule_description: String parameter '$key' has meaningless minimum value that is less than zero");
1055                                                        }
1056                                                }
1057
50
42
                                                if(!defined($value)) {
1058
0
0
                                                        next;   # Skip if string is undefined
1059                                                }
1060                                                # Ensure string is decoded into Perl characters
1061
50
200
                                                my $bytes = decode_utf8($value) unless utf8::is_utf8($value);
1062
50
152
                                                my $len = length($bytes);
1063
50
46
                                                if(!defined($len)) {
1064                                                        # _error($logger, $rules->{'error_msg'} || "$rule_description: '$key' can't be decoded");
1065                                                        # $invalid_args{$key} = 1;
1066
0
0
                                                        $len = length($value);
1067                                                }
1068
50
75
                                                if($len < $rule_value) {
1069
8
31
                                                        _error($logger, $rules->{'error_msg'} || "$rule_description: String parameter '$key' too short, ($len characters), must be at least $rule_value characters");
1070
0
0
                                                        $invalid_args{$key} = 1;
1071                                                }
1072                                        } elsif($rules->{'type'} eq 'arrayref') {
1073
18
22
                                                if(!defined($value)) {
1074
0
0
                                                        next;   # Skip if array is undefined
1075                                                }
1076
18
34
                                                if(ref($value) ne 'ARRAY') {
1077
1
1
                                                        if($rules->{'error_msg'}) {
1078
0
0
                                                                _error($logger, $rules->{'error_msg'});
1079                                                        } else {
1080
1
2
                                                                _error($logger, "$rule_description: Parameter '$key' must be an arrayref, not " . ref($value));
1081                                                        }
1082                                                }
1083
17
17
8
30
                                                if(scalar(@{$value}) < $rule_value) {
1084
2
3
                                                        if($rules->{'error_msg'}) {
1085
0
0
                                                                _error($logger, $rules->{'error_msg'});
1086                                                        } else {
1087
2
6
                                                                _error($logger, "$rule_description: Parameter '$key' must be at least length $rule_value");
1088                                                        }
1089
0
0
                                                        $invalid_args{$key} = 1;
1090                                                }
1091                                        } elsif($rules->{'type'} eq 'hashref') {
1092
4
5
                                                if(!defined($value)) {
1093
0
0
                                                        next;   # Skip if hash is undefined
1094                                                }
1095
4
4
2
7
                                                if(scalar(keys(%{$value})) < $rule_value) {
1096
1
2
                                                        if($rules->{'error_msg'}) {
1097
0
0
                                                                _error($logger, $rules->{'error_msg'});
1098                                                        } else {
1099
1
2
                                                                _error($logger, "$rule_description: Parameter '$key' must contain at least $rule_value keys");
1100                                                        }
1101
0
0
                                                        $invalid_args{$key} = 1;
1102                                                }
1103                                        } elsif(($type eq 'integer') || ($type eq 'number') || ($type eq 'float')) {
1104
74
63
                                                if(!defined($value)) {
1105
0
0
                                                        next;   # Skip if hash is undefined
1106                                                }
1107
74
92
                                                if(Scalar::Util::looks_like_number($value)) {
1108
73
82
                                                        if($value < $rule_value) {
1109
16
22
                                                                if($rules->{'error_msg'}) {
1110
3
8
                                                                        _error($logger, $rules->{'error_msg'});
1111                                                                } else {
1112
13
25
                                                                        _error($logger, "$rule_description: Parameter '$key' ($value) must be at least $rule_value");
1113                                                                }
1114
0
0
                                                                $invalid_args{$key} = 1;
1115
0
0
                                                                next;
1116                                                        }
1117                                                } else {
1118
1
2
                                                        if($rules->{'error_msg'}) {
1119
0
0
                                                                _error($logger, $rules->{'error_msg'});
1120                                                        } else {
1121
1
3
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must be a number");
1122                                                        }
1123
0
0
                                                        next;
1124                                                }
1125                                        } else {
1126
1
2
                                                _error($logger, "$rule_description: Parameter '$key' of type '$type' has meaningless min value $rule_value");
1127                                        }
1128                                } elsif($rule_name eq 'max') {
1129
67
77
                                        if(!defined($rules->{'type'})) {
1130
0
0
                                                _error($logger, "$rule_description: Don't know type of '$key' to determine its maximum value $rule_value");
1131                                        }
1132
67
86
                                        my $type = lc($rules->{'type'});
1133
67
88
                                        if(exists($custom_types->{$type}->{'max'})) {
1134
2
2
                                                $rule_value = $custom_types->{$type}->{'max'};
1135
2
2
                                                $type = $custom_types->{$type}->{'type'};
1136                                        }
1137
67
128
                                        if($type eq 'string') {
1138
27
28
                                                if(!defined($value)) {
1139
0
0
                                                        next;   # Skip if string is undefined
1140                                                }
1141                                                # Ensure string is decoded into Perl characters
1142
27
1501
                                                my $bytes = decode_utf8($value) unless utf8::is_utf8($value);
1143
27
2373
                                                my $len = length($bytes);
1144
27
32
                                                if(!defined($len)) {
1145                                                        # _error($logger, $rules->{'error_msg'} || "$rule_description: '$key' can't be decoded");
1146                                                        # $invalid_args{$key} = 1;
1147
0
0
                                                        $len = length($value);
1148                                                }
1149
27
46
                                                if($len > $rule_value) {
1150
5
20
                                                        _error($logger, $rules->{'error_msg'} || "$rule_description: String parameter '$key' too long, ($len characters), must be no longer than $rule_value");
1151
0
0
                                                        $invalid_args{$key} = 1;
1152                                                }
1153                                        } elsif($rules->{'type'} eq 'arrayref') {
1154
8
11
                                                if(!defined($value)) {
1155
0
0
                                                        next;   # Skip if string is undefined
1156                                                }
1157
8
10
                                                if(ref($value) ne 'ARRAY') {
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 arrayref, not " . ref($value));
1162                                                        }
1163                                                }
1164
8
8
3
13
                                                if(scalar(@{$value}) > $rule_value) {
1165
4
6
                                                        if($rules->{'error_msg'}) {
1166
0
0
                                                                _error($logger, $rules->{'error_msg'});
1167                                                        } else {
1168
4
10
                                                                _error($logger, "$rule_description: Parameter '$key' must contain no more than $rule_value items");
1169                                                        }
1170
0
0
                                                        $invalid_args{$key} = 1;
1171                                                }
1172                                        } elsif($rules->{'type'} eq 'hashref') {
1173
3
3
                                                if(!defined($value)) {
1174
0
0
                                                        next;   # Skip if hash is undefined
1175                                                }
1176
3
3
4
7
                                                if(scalar(keys(%{$value})) > $rule_value) {
1177
2
4
                                                        if($rules->{'error_msg'}) {
1178
0
0
                                                                _error($logger, $rules->{'error_msg'});
1179                                                        } else {
1180
2
4
                                                                _error($logger, "$rule_description: Parameter '$key' must contain no more than $rule_value keys");
1181                                                        }
1182
0
0
                                                        $invalid_args{$key} = 1;
1183                                                }
1184                                        } elsif(($type eq 'integer') || ($type eq 'number') || ($type eq 'float')) {
1185
28
55
                                                if(!defined($value)) {
1186
0
0
                                                        next;   # Skip if hash is undefined
1187                                                }
1188
28
47
                                                if(Scalar::Util::looks_like_number($value)) {
1189
28
35
                                                        if($value > $rule_value) {
1190
4
6
                                                                if($rules->{'error_msg'}) {
1191
0
0
                                                                        _error($logger, $rules->{'error_msg'});
1192                                                                } else {
1193
4
8
                                                                        _error($logger, "$rule_description: Parameter '$key' ($value) must be no more than $rule_value");
1194                                                                }
1195
0
0
                                                                $invalid_args{$key} = 1;
1196
0
0
                                                                next;
1197                                                        }
1198                                                } else {
1199
0
0
                                                        if($rules->{'error_msg'}) {
1200
0
0
                                                                _error($logger, $rules->{'error_msg'});
1201                                                        } else {
1202
0
0
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must be a number");
1203                                                        }
1204
0
0
                                                        next;
1205                                                }
1206                                        } else {
1207
1
2
                                                _error($logger, "$rule_description: Parameter '$key' of type '$type' has meaningless max value $rule_value");
1208                                        }
1209                                } elsif($rule_name eq 'matches') {
1210
57
51
                                        if(!defined($value)) {
1211
1
1
                                                next;   # Skip if string is undefined
1212                                        }
1213
56
51
                                        eval {
1214
56
104
                                                my $re = (ref($rule_value) eq 'Regexp') ? $rule_value : qr/\Q$rule_value\E/;
1215
56
195
                                                if($rules->{'type'} eq 'arrayref') {
1216
2
4
2
2
10
2
                                                        my @matches = grep { $_ =~ $re } @{$value};
1217
2
2
2
4
                                                        if(scalar(@matches) != scalar(@{$value})) {
1218
0
0
                                                                if($rules->{'error_msg'}) {
1219
0
0
                                                                        _error($logger, $rules->{'error_msg'});
1220                                                                } else {
1221
0
0
0
0
                                                                        _error($logger, "$rule_description: All members of parameter '$key' [", join(', ', @{$value}), "] must match pattern '$rule_value'");
1222                                                                }
1223                                                        }
1224                                                } elsif($value !~ $re) {
1225
16
22
                                                        if($rules->{'error_msg'}) {
1226
2
3
                                                                _error($logger, $rules->{'error_msg'});
1227                                                        } else {
1228
14
37
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must match pattern '$re'");
1229                                                        }
1230                                                }
1231
40
36
                                                1;
1232                                        };
1233
56
18094
                                        if($@) {
1234
16
24
                                                if($rules->{'error_msg'}) {
1235
2
3
                                                        _error($logger, $rules->{'error_msg'});
1236                                                } else {
1237
14
41
                                                        _error($logger, "$rule_description: Parameter '$key' regex '$rule_value' error: $@");
1238                                                }
1239
0
0
                                                $invalid_args{$key} = 1;
1240                                        }
1241                                } elsif($rule_name eq 'nomatch') {
1242
7
15
                                        if(!defined($value)) {
1243
0
0
                                                next;   # Skip if string is undefined
1244                                        }
1245
7
27
                                        if($rules->{'type'} eq 'arrayref') {
1246
3
9
3
2
17
4
                                                my @matches = grep { /$rule_value/ } @{$value};
1247
3
3
                                                if(scalar(@matches)) {
1248
1
2
                                                        if($rules->{'error_msg'}) {
1249
0
0
                                                                _error($logger, $rules->{'error_msg'});
1250                                                        } else {
1251
1
1
2
3
                                                                _error($logger, "$rule_description: No member of parameter '$key' [", join(', ', @{$value}), "] must match pattern '$rule_value'");
1252                                                        }
1253                                                }
1254                                        } elsif($value =~ $rule_value) {
1255
1
2
                                                if($rules->{'error_msg'}) {
1256
0
0
                                                        _error($logger, $rules->{'error_msg'});
1257                                                } else {
1258
1
4
                                                        _error($logger, "$rule_description: Parameter '$key' ($value) must not match pattern '$rule_value'");
1259                                                }
1260
0
0
                                                $invalid_args{$key} = 1;
1261                                        }
1262                                } elsif($rule_name eq 'memberof') {
1263
66
59
                                        if(!defined($value)) {
1264
0
0
                                                next;   # Skip if string is undefined
1265                                        }
1266
66
64
                                        if(ref($rule_value) eq 'ARRAY') {
1267
64
42
                                                my $ok = 1;
1268
64
148
                                                if(($rules->{'type'} eq 'integer') || ($rules->{'type'} eq 'number') || ($rules->{'type'} eq 'float')) {
1269
12
41
12
22
48
20
                                                        unless(List::Util::any { $_ == $value } @{$rule_value}) {
1270
5
3
                                                                $ok = 0;
1271                                                        }
1272                                                } else {
1273
52
48
                                                        my $l = lc($value);
1274
52
249
52
107
273
74
                                                        unless(List::Util::any { (!defined($rules->{'case_sensitive'}) || ($rules->{'case_sensitive'} == 1)) ? $_ eq $value : lc($_) eq $l } @{$rule_value}) {
1275
15
15
                                                                $ok = 0;
1276                                                        }
1277                                                }
1278
1279
64
149
                                                if(!$ok) {
1280
20
23
                                                        if($rules->{'error_msg'}) {
1281
3
5
                                                                _error($logger, $rules->{'error_msg'});
1282                                                        } else {
1283
17
17
24
36
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must be one of ", join(', ', @{$rule_value}));
1284                                                        }
1285
0
0
                                                        $invalid_args{$key} = 1;
1286                                                }
1287                                        } else {
1288
2
4
                                                if($rules->{'error_msg'}) {
1289
0
0
                                                        _error($logger, $rules->{'error_msg'});
1290                                                } else {
1291
2
9
                                                        _error($logger, "$rule_description: Parameter '$key' rule ($rule_value) must be an array reference");
1292                                                }
1293                                        }
1294                                } elsif($rule_name eq 'notmemberof') {
1295
25
19
                                        if(!defined($value)) {
1296
0
0
                                                next;   # Skip if string is undefined
1297                                        }
1298
25
19
                                        if(ref($rule_value) eq 'ARRAY') {
1299
24
13
                                                my $ok = 1;
1300
24
44
                                                if(($rules->{'type'} eq 'integer') || ($rules->{'type'} eq 'number') || ($rules->{'type'} eq 'float')) {
1301
6
17
6
12
14
6
                                                        if(List::Util::any { $_ == $value } @{$rule_value}) {
1302
4
3
                                                                $ok = 0;
1303                                                        }
1304                                                } else {
1305
18
16
                                                        my $l = lc($value);
1306
18
36
18
37
46
23
                                                        if(List::Util::any { (!defined($rules->{'case_sensitive'}) || ($rules->{'case_sensitive'} == 1)) ? $_ eq $value : lc($_) eq $l } @{$rule_value}) {
1307
9
5
                                                                $ok = 0;
1308                                                        }
1309                                                }
1310
1311
24
48
                                                if(!$ok) {
1312
13
10
                                                        if($rules->{'error_msg'}) {
1313
1
1
                                                                _error($logger, $rules->{'error_msg'});
1314                                                        } else {
1315
12
12
14
20
                                                                _error($logger, "$rule_description: Parameter '$key' ($value) must not be one of ", join(', ', @{$rule_value}));
1316                                                        }
1317
0
0
                                                        $invalid_args{$key} = 1;
1318                                                }
1319                                        } else {
1320
1
1
                                                if($rules->{'error_msg'}) {
1321
0
0
                                                        _error($logger, $rules->{'error_msg'});
1322                                                } else {
1323
1
2
                                                        _error($logger, "$rule_description: Parameter '$key' rule ($rule_value) must be an array reference");
1324                                                }
1325                                        }
1326                                } elsif($rule_name eq 'isa') {
1327
6
11
                                        if($rules->{'type'} eq 'object') {
1328
5
15
                                                if(!$value->isa($rule_value)) {
1329
1
2
                                                        _error($logger, "$rule_description: Parameter '$key' must be a '$rule_value' object");
1330
0
0
                                                        $invalid_args{$key} = 1;
1331                                                }
1332                                        } else {
1333
1
3
                                                _error($logger, "$rule_description: Parameter '$key' has meaningless isa value $rule_value");
1334                                        }
1335                                } elsif($rule_name eq 'can') {
1336
16
20
                                        if(!defined($value)) {
1337
0
0
                                                next;   # Skip if object not given
1338                                        }
1339
16
20
                                        if($rules->{'type'} eq 'object') {
1340
15
20
                                                if(ref($rule_value) eq 'ARRAY') {
1341                                                        # List of methods
1342
8
8
8
8
                                                        foreach my $method(@{$rule_value}) {
1343
15
40
                                                                if(!$value->can($method)) {
1344
4
9
                                                                        _error($logger, "$rule_description: Parameter '$key' must be an object that understands the $method method");
1345
0
0
                                                                        $invalid_args{$key} = 1;
1346                                                                }
1347                                                        }
1348                                                } elsif(!ref($rule_value)) {
1349
6
26
                                                        if(!$value->can($rule_value)) {
1350
3
7
                                                                _error($logger, "$rule_description: Parameter '$key' must be an object that understands the $rule_value method");
1351
0
0
                                                                $invalid_args{$key} = 1;
1352                                                        }
1353                                                } else {
1354
1
2
                                                        _error($logger, "$rule_description: 'can' rule for Parameter '$key must be either a scalar or an arrayref");
1355                                                }
1356                                        } else {
1357
1
2
                                                _error($logger, "$rule_description: Parameter '$key' has meaningless can value $rule_value");
1358                                        }
1359                                } elsif($rule_name eq 'element_type') {
1360
20
23
                                        if($rules->{'type'} eq 'arrayref') {
1361
20
19
                                                my $type = $rule_value;
1362
20
18
                                                my $custom_type = $custom_types->{$rule_value};
1363
20
22
                                                if($custom_type && $custom_type->{'type'}) {
1364
1
1
                                                        $type = $custom_type->{'type'};
1365                                                }
1366
20
20
17
25
                                                foreach my $member(@{$value}) {
1367
53
46
                                                        if($custom_type && $custom_type->{'transform'}) {
1368                                                                # The custom type has a transform embedded within it
1369
2
3
                                                                if(ref($custom_type->{'transform'}) eq 'CODE') {
1370
2
2
1
3
                                                                        $member = &{$custom_type->{'transform'}}($member);
1371                                                                } else {
1372
0
0
                                                                        _error($logger, "$rule_description: transforms must be a code ref");
1373
0
0
                                                                        last;
1374                                                                }
1375                                                        }
1376
53
64
                                                        if($type eq 'string') {
1377
26
25
                                                                if(ref($member)) {
1378
0
0
                                                                        if($rules->{'error_msg'}) {
1379
0
0
                                                                                _error($logger, $rules->{'error_msg'});
1380                                                                        } else {
1381
0
0
                                                                                _error($logger, "$key can only contain strings");
1382                                                                        }
1383
0
0
                                                                        $invalid_args{$key} = 1;
1384                                                                }
1385                                                        } elsif($type eq 'integer') {
1386
23
44
                                                                if(ref($member) || ($member =~ /\D/)) {
1387
2
5
                                                                        if($rules->{'error_msg'}) {
1388
1
2
                                                                                _error($logger, $rules->{'error_msg'});
1389                                                                        } else {
1390
1
2
                                                                                _error($logger, "$key can only contain integers (found $member)");
1391                                                                        }
1392
0
0
                                                                        $invalid_args{$key} = 1;
1393                                                                }
1394                                                        } elsif(($type eq 'number') || ($rule_value eq 'float')) {
1395
4
28
                                                                if(ref($member) || ($member !~ /^[-+]?(\d*\.\d+|\d+\.?\d*)$/)) {
1396
1
2
                                                                        if($rules->{'error_msg'}) {
1397
0
0
                                                                                _error($logger, $rules->{'error_msg'});
1398                                                                        } else {
1399
1
2
                                                                                _error($logger, "$key can only contain numbers (found $member)");
1400                                                                        }
1401
0
0
                                                                        $invalid_args{$key} = 1;
1402                                                                }
1403                                                        } else {
1404
0
0
                                                                _error($logger, "BUG: Add $type to element_type list");
1405                                                        }
1406                                                }
1407                                        } else {
1408
0
0
                                                _error($logger, "$rule_description: Parameter '$key' has meaningless element_type value $rule_value");
1409                                        }
1410                                } elsif($rule_name eq 'optional') {
1411                                        # Already handled at the beginning of the loop
1412                                } elsif($rule_name eq 'default') {
1413                                        # Handled earlier
1414                                } elsif($rule_name eq 'error_msg') {
1415                                        # Handled inline
1416                                } elsif($rule_name eq 'transform') {
1417                                        # Handled before the loop
1418                                } elsif($rule_name eq 'case_sensitive') {
1419                                        # Handled inline
1420                                } elsif($rule_name eq 'description') {
1421                                        # A la, Data::Processor
1422                                } elsif($rule_name eq 'schema') {
1423                                        # Nested schema Run the given schema against each element of the array
1424
45
55
                                        if($rules->{'type'} eq 'arrayref') {
1425
11
14
                                                if(ref($value) eq 'ARRAY') {
1426
11
11
5
13
                                                        foreach my $member(@{$value}) {
1427
16
58
                                                                if(!validate_strict({ input => { $key => $member }, schema => { $key => $rule_value }, custom_types => $custom_types })) {
1428
0
0
                                                                        $invalid_args{$key} = 1;
1429                                                                }
1430                                                        }
1431                                                } elsif(defined($value)) {      # Allow undef for optional values
1432
0
0
                                                        _error($logger, "$rule_description: nested schema: Parameter '$value' must be an arrayref");
1433                                                }
1434                                        } elsif($rules->{'type'} eq 'hashref') {
1435
34
34
                                                if(ref($value) eq 'HASH') {
1436                                                        # Apply nested defaults before validation
1437
34
49
                                                        my $nested_with_defaults = _apply_nested_defaults($value, $rule_value);
1438
34
34
24
35
                                                        if(scalar keys(%{$value})) {
1439
32
138
                                                                if(my $new_args = validate_strict({ input => $nested_with_defaults, schema => $rule_value, custom_types => $custom_types })) {
1440
21
36
                                                                        $value = $new_args;
1441                                                                } else {
1442
0
0
                                                                        $invalid_args{$key} = 1;
1443                                                                }
1444                                                        }
1445                                                } else {
1446
0
0
                                                        _error($logger, "$rule_description: nested schema: Parameter '$value' must be an hashref");
1447                                                }
1448                                        } else {
1449
0
0
                                                _error($logger, "$rule_description: Parameter '$key': 'schema' only supports arrayref and hashref, not $rules->{type}");
1450                                        }
1451                                } elsif(($rule_name eq 'validate') || ($rule_name eq 'validator')) {
1452
2
3
                                        if(ref($rule_value) eq 'CODE') {
1453
2
2
2
3
                                                if(my $error = &{$rule_value}($args)) {
1454
1
5
                                                        _error($logger, "$rule_description: $key not valid: $error");
1455
0
0
                                                        $invalid_args{$key} = 1;
1456                                                }
1457                                        } else {
1458                                                # _error($logger, "$rule_description: Parameter '$key': 'validate' only supports coderef, not $value");
1459
0
0
                                                _error($logger, "$rule_description: Parameter '$key': 'validate' only supports coderef, not " . ref($rule_value) // $rule_value);
1460                                        }
1461                                } elsif ($rule_name eq 'callback') {
1462
18
23
                                        unless (defined &$rule_value) {
1463
1
2
                                                _error($logger, "$rule_description: callback for '$key' must be a code reference");
1464                                        }
1465
17
22
                                        my $res = $rule_value->($value);
1466
16
2645
                                        unless ($res) {
1467
7
9
                                                if($rules->{'error_msg'}) {
1468
0
0
                                                        _error($logger, $rules->{'error_msg'});
1469                                                } else {
1470
7
16
                                                        _error($logger, "$rule_description: Parameter '$key' failed custom validation");
1471                                                }
1472
0
0
                                                $invalid_args{$key} = 1;
1473                                        }
1474                                } elsif($rule_name eq 'position') {
1475
3
5
                                        if($rule_value =~ /\D/) {
1476
0
0
                                                _error($logger, "$rule_description: Parameter '$key': 'position' must be an integer");
1477                                        }
1478
3
3
                                        if($rule_value < 0) {
1479
0
0
                                                _error($logger, "$rule_description: Parameter '$key': 'position' must be a positive integer, not $value");
1480                                        }
1481                                } else {
1482
0
0
                                        _error($logger, "$rule_description: Unknown rule '$rule_name'");
1483                                }
1484                        }
1485                } elsif(ref($rules) eq 'ARRAY') {
1486
12
12
10
14
                        if(scalar(@{$rules})) {
1487                                # An argument can be one of several different type
1488
10
6
                                my $rc = 0;
1489
10
8
                                my @types;
1490
10
10
7
9
                                foreach my $rule(@{$rules}) {
1491
17
25
                                        if(ref($rule) ne 'HASH') {
1492
1
7
                                                _error($logger, "$rule_description: Parameter '$key' rules must be a hash reference");
1493
0
0
                                                next;
1494                                        }
1495
16
17
                                        if(!defined($rule->{'type'})) {
1496
0
0
                                                _error($logger, "$rule_description: Parameter '$key' is missing a type in an alternative");
1497
0
0
                                                next;
1498                                        }
1499
16
18
                                        push @types, $rule->{'type'};
1500
16
13
                                        eval {
1501
16
58
                                                validate_strict({ input => { $key => $value }, schema => { $key => $rule }, logger => undef, custom_types => $custom_types });
1502                                        };
1503
16
10341
                                        if(!$@) {
1504
7
6
                                                $rc = 1;
1505
7
5
                                                last;
1506                                        }
1507                                }
1508
9
15
                                if(!$rc) {
1509
2
6
                                        _error($logger, "$rule_description: Parameter: '$key': must be one of " . join(', ', @types));
1510
0
0
                                        $invalid_args{$key} = 1;
1511                                }
1512                        } else {
1513
2
5
                                _error($logger, "$rule_description: Parameter: '$key': schema is empty arrayref");
1514                        }
1515                } elsif(ref($rules)) {
1516
1
1
                        _error($logger, 'rules must be a hash reference or string');
1517                }
1518
1519
445
514
                $validated_args{$key} = $value;
1520        }
1521
1522
303
319
        if(my $cross_validation = $params->{'cross_validation'}) {
1523
37
37
24
32
                foreach my $validator_name(keys %{$cross_validation}) {
1524
42
36
                        my $validator = $cross_validation->{$validator_name};
1525
42
55
                        if((!ref($validator)) || (ref($validator) ne 'CODE')) {
1526
1
2
                                _error($logger, "$schema_description: cross_validation $validator is not a code snippet");
1527
0
0
                                next;
1528                        }
1529
41
41
29
39
                        if(my $error = &{$validator}(\%validated_args, $validator)) {
1530
18
67
                                _error($logger, $error);
1531                                # We have no idea which parameters are still valid, so let's invalidate them all
1532
0
0
                                return;
1533                        }
1534                }
1535        }
1536
1537
284
285
        foreach my $key(keys %invalid_args) {
1538
0
0
                delete $validated_args{$key};
1539        }
1540
1541
284
239
        if($are_positional_args == 1) {
1542
3
5
                my @rc;
1543
3
3
2
4
                foreach my $key (keys %{$schema}) {
1544
4
7
                        if(my $value = delete $validated_args{$key}) {
1545
4
2
                                my $position = $schema->{$key}->{'position'};
1546
4
5
                                if(defined($rc[$position])) {
1547
0
0
                                        _error($logger, "$schema_description: $key: position $position appears twice");
1548                                }
1549
4
4
                                $rc[$position] = $value;
1550                        }
1551                }
1552
3
5
                return \@rc;
1553        }
1554
281
607
        return \%validated_args;
1555}
1556
1557# Helper to log error or croak
1558sub _error
1559{
1560
209
158
        my $logger = shift;
1561
209
258
        my $message = join('', @_);
1562
1563
209
227
        my @call_details = caller(0);
1564
209
2968
        if($logger) {
1565
6
15
                $logger->error(__PACKAGE__, ' line ', $call_details[2], ": $message");
1566        } else {
1567
203
988
                croak(__PACKAGE__, ' line ', $call_details[2], ": $message");
1568                # Be absolutely sure, sometimes croak doesn't die for me in Test::Most scripts
1569
0
0
                die (__PACKAGE__, ' line ', $call_details[2], ": $message");
1570        }
1571}
1572
1573# Helper to log warning or carp
1574sub _warn
1575{
1576
3
4
        my $logger = shift;
1577
3
6
        my $message = join('', @_);
1578
1579
3
5
        if($logger) {
1580
2
6
                $logger->warn(__PACKAGE__, ": $message");
1581        } else {
1582
1
5
                carp(__PACKAGE__, ": $message");
1583        }
1584}
1585
1586sub _apply_nested_defaults {
1587
46
35
        my ($input, $schema) = @_;
1588
46
66
        my %result = %$input;
1589
1590
46
40
        foreach my $key (keys %$schema) {
1591
108
74
                my $rules = $schema->{$key};
1592
1593
108
159
                if (ref $rules eq 'HASH' && exists $rules->{default} && !exists $result{$key}) {
1594
2
2
                        $result{$key} = $rules->{default};
1595                }
1596
1597                # Recursively handle nested schema
1598
108
173
                if((ref $rules eq 'HASH') && $rules->{schema} && (ref $result{$key} eq 'HASH')) {
1599
8
14
                        $result{$key} = _apply_nested_defaults($result{$key}, $rules->{schema});
1600                }
1601        }
1602
1603
46
55
        return \%result;
1604}
1605
1606 - 1755
=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 Nigel Horne.

This program is released under the following licence: GPL2

=cut
1756
17571;
1758