| File: | blib/lib/Params/Validate/Strict.pm |
| Coverage: | 80.7% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package 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 | ||||||
| 15 | our @ISA = qw(Exporter); | |||||
| 16 | our @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 | ||||||
| 28 | our $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 | ||||||
| 753 | sub 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 | |||||
| 1558 | sub _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 | |||||
| 1574 | sub _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 | ||||||
| 1586 | sub _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 | ||||||
| 1757 | 1; | |||||
| 1758 | ||||||