lib/Params/Validate/Strict.pm

        start → end → jump
        

    1: package Params::Validate::Strict;
    2: 
    3: use strict;
    4: use warnings;
    5: 
    6: # TODO: test cases - check 1e20 and -1e20 are accepted as integers
    7: 
    8: # TODOs inspired by Params::Smart (see SEE ALSO):
    9: #
   10: # TODO: named_only => 1 rule — marks a parameter as keyword-only; it may not
   11: #   be supplied by position even when the schema uses positional mode.  Mirrors
   12: #   the '+name' sigil in Params::Smart.  Useful for flags that would be
   13: #   dangerous or ambiguous if accidentally supplied by position (e.g. a boolean
   14: #   that happens to sit at the same index as a required string on a different
   15: #   call path).
   16: #
   17: # TODO: auto-detect positional vs named calling — allow a single schema to
   18: #   accept both f(1, 2, 3) and f(a=>1, b=>2, c=>3) by inspecting @_ at
   19: #   runtime and choosing the appropriate mode.  Params::Smart's heuristic
   20: #   checks whether the first element of @_ is a known parameter name; if so,
   21: #   named mode is assumed, otherwise positional.  Caveats: the heuristic can
   22: #   misfire when a positional value happens to be a string matching a param
   23: #   name — callers should be able to pass a hint (e.g. force_named => 1) to
   24: #   override.  The return value should include a '_named' key (as Params::Smart
   25: #   does) so the caller can diagnose which mode was used.
   26: #
   27: # TODO: needs => ['param1', 'param2'] per-parameter dependency shorthand —
   28: #   a convenience alternative to the schema-level 'relationships' system.
   29: #   Params::Smart uses { name => 'foo', needs => ['bar'] } directly in the
   30: #   parameter rule.  PVS already has the full dependency system via
   31: #   relationships => [{ type => 'dependency', ... }], but a per-parameter
   32: #   'needs' key would be more ergonomic for simple one-to-many dependencies
   33: #   without requiring a separate top-level 'relationships' entry.  Should be
   34: #   desugared to an equivalent dependency relationship before validation runs.
   35: #
   36: # TODO: '_named' diagnostic key in the return hashref — when auto-detect mode
   37: #   is active (see above), include a '_named' key in the returned args hashref
   38: #   that is true when named-parameter calling was inferred and false when
   39: #   positional calling was inferred.  Mirrors Params::Smart's behaviour.
   40: #   Even without full auto-detect, this key could be set unconditionally
   41: #   (true for hashref input, false for arrayref input) to let callers
   42: #   identify which mode was actually used.
   43: 
   44: # Remaining TODOs from Params::Util gap analysis (see SEE ALSO):
   45: #
   46: # TODO: element_isa => 'ClassName' rule — validates that every element of an
   47: #   arrayref parameter is a blessed object that passes ->isa('ClassName').
   48: #   Covers Params::Util's _SET (min => 1) and _SET0 (no min) patterns, which
   49: #   are not expressible with the existing element_type => 'object' rule alone
   50: #   (that only checks blessedness, not the inheritance chain).  Implementation:
   51: #   new 'element_isa' rule key processed inside the arrayref branch of the
   52: #   rule-dispatch loop, iterating each element and calling ->isa.
   53: #
   54: # TODO: 'can' rule extended to non-object types — three variants needed,
   55: #   mirroring _CLASSCAN / _INSTANCECAN / _INVOCANTCAN from Params::Util
   56: #   1.105_001 (unreleased) / Params::SomeUtil (listed but not yet implemented).
   57: #   The motivation is to avoid the UNIVERSAL::can pitfall: always call
   58: #   $value->can($method) as a method (which respects an overridden can()),
   59: #   never UNIVERSAL::can($value, $method) as a function.  PVS's existing 'can'
   60: #   rule for type => 'object' already calls ->can correctly.  The remaining
   61: #   two variants to add are:
   62: #     - type => 'invocant' + can: value is an object OR class-name string that
   63: #       can do the method (_INVOCANTCAN).
   64: #     - type => 'string' (class-name) + classcan: string class-name that can
   65: #       do the method (_CLASSCAN); symmetric with classisa / classdoes.
   66: 
   67: use Carp;
   68: use Exporter qw(import);	# Required for @EXPORT_OK
   69: use Encode qw(decode_utf8);
   70: use List::Util 1.33 qw(all any);	# Required for memberof/matches validation
   71: use Readonly::Values::Boolean;
   72: use Scalar::Util;
   73: 
   74: our @ISA = qw(Exporter);
   75: our @EXPORT_OK = qw(validate_strict compile_schema);
   76: 
   77: =head1 NAME
   78: 
   79: Params::Validate::Strict - Validates a set of parameters against a schema
   80: 
   81: =head1 VERSION
   82: 
   83: Version 0.41
   84: 
   85: =cut
   86: 
   87: our $VERSION = '0.41';
   88: 
   89: # Recursion depth counter — localised on every entry so it unwinds automatically.
   90: # Protects against mutations (or bugs) that turn the pipe-normalisation guard into
   91: # an infinite loop through the union-type ARRAY handler.
   92: our $_depth = 0;
   93: 
   94: =head1 SYNOPSIS
   95: 
   96:     my $schema = {
   97:         username => { type => 'string', min => 3, max => 50 },
   98:         age => { type => 'integer', min => 0, max => 150 },
   99:     };
  100: 
  101:     my $input = {
  102:          username => 'john_doe',
  103:          age => '30',	# Will be coerced to integer
  104:     };
  105: 
  106:     my $validated_input = validate_strict(schema => $schema, input => $input);
  107: 
  108:     if(defined($validated_input)) {
  109:         print "Example 1: Validation successful!\n";
  110:         print 'Username: ', $validated_input->{username}, "\n";
  111:         print 'Age: ', $validated_input->{age}, "\n";	# It's an integer now
  112:     } else {
  113:         print "Example 1: Validation failed: $@\n";
  114:     }
  115: 
  116: Upon first reading this may seem overly complex and full of scope creep in a sledgehammer to crack a nut sort of way,
  117: however two use cases make use of the extensive logic that comes with this code
  118: and I have a couple of other reasons for writing it.
  119: 
  120: =over 4
  121: 
  122: =item * Black Box Testing
  123: 
  124: The schema can be plumbed into L<App::Test::Generator> to automatically create a set of black-box test cases.
  125: 
  126: =item * WAF
  127: 
  128: The schema can be plumbed into a WAF,
  129: e.g., L<VWF|https://github.com/nigelhorne/VWF/>,
  130: to protect from random user input.
  131: 
  132: =item * Improved API Documentation
  133: 
  134: Even if you don't use this module,
  135: the specification syntax can help with documentation.
  136: 
  137: =item * I like it
  138: 
  139: I found it fun to write this,
  140: even if nobody else finds it useful,
  141: though I hope you will.
  142: 
  143: =back
  144: 
  145: =head1	METHODS
  146: 
  147: =head2 validate_strict
  148: 
  149: Validates a set of parameters against a schema.
  150: 
  151: This function takes two mandatory arguments:
  152: 
  153: =over 4
  154: 
  155: =item * C<schema> || C<members>
  156: 
  157: A reference to a hash that defines the validation rules for each parameter.
  158: 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.
  159: 
  160: As an alternative the schema may be supplied as an B<arrayref of parameter hashrefs>,
  161: where every element describes one parameter and carries a mandatory
  162: C<name> key:
  163: 
  164:   $schema = [
  165:     { name => 'username', type => 'string', min => 3, max => 50 },
  166:     { name => 'age',      type => 'integer', min => 0, max => 150 },
  167:     { name => 'role',     type => 'string', optional => 1, default => 'user' },
  168:   ];
  169: 
  170: The arrayref form is normalised to the standard hashref form before any further
  171: processing.  It is particularly useful when declaration order matters (e.g.
  172: for positional or mixed calling conventions used by some CPAN modules).  The
  173: C<name> key is consumed during normalisation and does not appear as a
  174: validation rule.
  175: 
  176: For some sort of compatibility with L<Data::Processor>,
  177: it is possible to wrap the schema within a hash like this:
  178: 
  179:   $schema = {
  180:     description => 'Describe what this schema does',
  181:     error_msg => 'An error message',
  182:     schema => {
  183:       # ... schema goes here
  184:     }
  185:   }
  186: 
  187: =item * C<args> || C<input>
  188: 
  189: A reference to a hash containing the parameters to be validated.
  190: The keys of the hash are the parameter names, and the values are the parameter values.
  191: 
  192: =back
  193: 
  194: It takes optional arguments:
  195: 
  196: =over 4
  197: 
  198: =item * C<description>
  199: 
  200: What the schema does,
  201: used in error messages.
  202: 
  203: =item * C<error_msg>
  204: 
  205: Overrides the default message when something doesn't validate.
  206: 
  207: =item * C<unknown_parameter_handler>
  208: 
  209: This parameter describes what to do when a parameter is given that is not in the schema of valid parameters.
  210: It must be one of C<die>, C<warn>, or C<ignore>.
  211: 
  212: It defaults to C<die> unless C<carp_on_warn> is given, in which case it defaults to C<warn>.
  213: 
  214: =item * C<logger>
  215: 
  216: A logging object that understands messages such as C<error> and C<warn>.
  217: 
  218: =item * C<custom_types>
  219: 
  220: A reference to a hash that defines reusable custom types.
  221: Custom types allow you to define validation rules once and reuse them throughout your schema,
  222: making your validation logic more maintainable and readable.
  223: 
  224: Each custom type is defined as a hash reference containing the same validation rules available for regular parameters
  225: (C<type>, C<min>, C<max>, C<matches>, C<memberof>, C<values>, C<enum>, C<notmemberof>, C<callback>, etc.).
  226: 
  227:   my $custom_types = {
  228:     email => {
  229:       type => 'string',
  230:       matches => qr/^[^@\s]+\@[^@\s]+\.[^@\s]+$/,
  231:       error_msg => 'Invalid email address format'
  232:     }, phone => {
  233:       type => 'string',
  234:       matches => qr/^\+?[1-9]\d{1,14}$/,
  235:       min => 10,
  236:       max => 15
  237:     }, percentage => {
  238:       type => 'number',
  239:       min => 0,
  240:       max => 100
  241:     }, status => {
  242:       type => 'string',
  243:       memberof => ['draft', 'published', 'archived']
  244:     }
  245:   };
  246: 
  247:   my $schema = {
  248:     user_email => { type => 'email' },
  249:     contact_number => { type => 'phone', optional => 1 },
  250:     completion => { type => 'percentage' },
  251:     post_status => { type => 'status' }
  252:   };
  253: 
  254:   my $validated = validate_strict(
  255:     schema => $schema,
  256:     input => $input,
  257:     custom_types => $custom_types
  258:   );
  259: 
  260: Custom types can be extended or overridden in the schema by specifying additional constraints:
  261: 
  262:   my $schema = {
  263:     admin_username => {
  264:       type => 'username',  # Uses custom type definition
  265:       min => 5,            # Overrides custom type's min value
  266:       max => 15            # Overrides custom type's max value
  267:     }
  268:   };
  269: 
  270: Custom types work seamlessly with nested schema, optional parameters, and all other validation features.
  271: 
  272: =back
  273: 
  274: The schema can define the following rules for each parameter:
  275: 
  276: =over 4
  277: 
  278: =item * C<type>
  279: 
  280: The data type of the parameter.
  281: Valid types are C<string>, C<integer>, C<number>, C<float>, C<boolean>, C<scalar>, C<scalarref>, C<stringref>, C<hashref>, C<arrayref>, C<object>, C<coderef>, C<regex>, C<handle>, C<arraylike>, C<hashlike>, C<codelike>, C<invocant> and C<void>.
  282: C<scalar> accepts any plain scalar value (string, number, boolean, etc.) but rejects references (arrayrefs, hashrefs, coderefs, objects).
  283: C<scalarref> accepts a reference to a scalar value (e.g. C<\$var>) but rejects plain scalars, arrayrefs, hashrefs, coderefs, and objects.
  284: C<stringref> accepts a reference to a scalar that contains a plain string (e.g. C<\$str>) and rejects plain scalars, references-to-references, arrayrefs, hashrefs, coderefs, and objects.
  285: C<void> asserts that the parameter value is C<undef> (the parameter represents a void return or absent output).
  286: When C<void> is used the schema must contain exactly one parameter.
  287: The C<min>/C<max> constraints apply to the B<length> (in characters) of the referenced string.
  288: All other string rules (C<matches>, C<nomatch>, C<memberof>, etc.) operate on the dereferenced string value.
  289: The validated return value is the dereferenced plain string.
  290: C<regex> accepts a compiled regular expression (C<qr//> object); the value is returned unchanged.
  291: C<handle> accepts a file handle: a glob reference with a defined C<fileno>, an C<IO::Handle> subclass instance, or any value for which C<fileno> returns a defined value.
  292: C<arraylike> accepts an array reference or a blessed object that overloads C<@{}> array dereferencing.
  293: C<hashlike> accepts a hash reference or a blessed object that overloads C<%{}> hash dereferencing.
  294: C<codelike> accepts a code reference or a blessed object that overloads C<&{}> code dereferencing.
  295: C<invocant> accepts either a blessed object instance or a plain string that is a syntactically valid Perl class name (e.g. C<'MyApp::Widget'>).
  296: 
  297: A type can be an arrayref when a parameter could have different types (e.g. a string or an object).
  298: 
  299:   $schema = {
  300:     username => [
  301:       { type => 'string', min => 3, max => 50 },	# Name
  302:       { type => 'integer', 'min' => 1 },	# UID that isn't root
  303:     ]
  304:   };
  305: 
  306: As a shorthand, C<type> itself may be an arrayref of type name strings (a I<union type>),
  307: or a pipe-separated string, when all other constraints are shared between the alternatives:
  308: 
  309:   $schema = {
  310:     data => { type => ['string', 'arrayref'] },
  311:     id   => { type => 'string|integer', optional => 1 },
  312:   };
  313: 
  314: This is equivalent to the full array-of-rules form but more concise.
  315: Whitespace around the C<|> is ignored, so C<'string | arrayref'> is the same as C<'string|arrayref'>.
  316: Every other key in the rule hash (C<optional>, C<min>, C<max>, C<matches>, etc.)
  317: is inherited by each candidate type and validated independently against it.
  318: Type names are tried left-to-right; the first match wins and its coercion
  319: (e.g. numeric types) is propagated back to the caller.
  320: If the value fails all candidate types, validation croaks with a message
  321: listing the union members.
  322: 
  323: =item * C<can>
  324: 
  325: The parameter must be an object that understands the method C<can>.
  326: C<can> can be a simple scalar string of a method name,
  327: or an arrayref of a list of method names, all of which must be supported by the object.
  328: 
  329:    $schema = {
  330:      gedcom => { type => object, can => 'get_individual' }
  331:    }
  332: 
  333: =item * C<isa>
  334: 
  335: The parameter must be an object of type C<isa>.
  336: Requires C<type =E<gt> 'object'>.
  337: 
  338: =item * C<does>
  339: 
  340: The parameter must be a blessed object that satisfies the role via C<-E<gt>DOES>.
  341: Requires C<type =E<gt> 'object'>.
  342: 
  343:   handler => { type => 'object', does => 'My::Role::Printable' }
  344: 
  345: =item * C<classisa>
  346: 
  347: The parameter must be a string holding a syntactically valid Perl class name
  348: that passes C<-E<gt>isa('Base::Class')>.
  349: The class must already be loaded (its C<@ISA> must be reachable).
  350: Does not accept blessed object references; use C<isa> for those.
  351: 
  352:   backend => { type => 'string', classisa => 'My::Backend::Base' }
  353: 
  354: =item * C<subclass>
  355: 
  356: Like C<classisa>, but requires a I<strict> subclass: the value must not equal
  357: the base class name itself.
  358: 
  359:   plugin => { type => 'string', subclass => 'My::Plugin::Base' }
  360: 
  361: =item * C<classdoes>
  362: 
  363: Like C<classisa>, but tests C<-E<gt>DOES> (role consumption) instead of C<-E<gt>isa>.
  364: 
  365:   consumer => { type => 'string', classdoes => 'My::Role::Loggable' }
  366: 
  367: =item * C<driver>
  368: 
  369: The parameter must be a valid class name that: (1) can be loaded via C<require>,
  370: and (2) passes C<-E<gt>isa('Base::Class')>.
  371: The module is actually loaded as a side effect of validation.
  372: 
  373:   store => { type => 'string', driver => 'Cache::Store' }
  374: 
  375: =item * C<memberof>
  376: 
  377: The parameter must be a member of the given arrayref.
  378: 
  379:   status => {
  380:     type => 'string',
  381:     memberof => ['draft', 'published', 'archived']
  382:   }
  383: 
  384:   priority => {
  385:     type => 'integer',
  386:     memberof => [1, 2, 3, 4, 5]
  387:   }
  388: 
  389: For string types, the comparison is case-sensitive by default. Use the C<case_sensitive>
  390: flag to control this behavior:
  391: 
  392:   # Case-sensitive (default) - must be exact match
  393:   code => {
  394:     type => 'string',
  395:     memberof => ['ABC', 'DEF', 'GHI']
  396:     # 'abc' will fail
  397:   }
  398: 
  399:   # Case-insensitive - any case accepted
  400:   code => {
  401:     type => 'string',
  402:     memberof => ['ABC', 'DEF', 'GHI'],
  403:     case_sensitive => 0
  404:     # 'abc', 'Abc', 'ABC' all pass, original case preserved
  405:   }
  406: 
  407: For numeric types (C<integer>, C<number>, C<float>), the comparison uses numeric
  408: equality (C<==> operator):
  409: 
  410:   rating => {
  411:     type => 'number',
  412:     memberof => [0.5, 1.0, 1.5, 2.0]
  413:   }
  414: 
  415: Note that C<memberof> cannot be combined with C<min> or C<max> constraints as they
  416: serve conflicting purposes - C<memberof> defines an explicit whitelist while C<min>/C<max>
  417: define ranges.
  418: 
  419: =item * C<enum>
  420: 
  421: Same as C<memberof>.
  422: 
  423: =item * C<values>
  424: 
  425: Same as C<memberof>.
  426: 
  427: =item * C<notmemberof>
  428: 
  429: The parameter must not be a member of the given arrayref (blacklist).
  430: This is the inverse of C<memberof>.
  431: 
  432:   username => {
  433:     type => 'string',
  434:     notmemberof => ['admin', 'root', 'system', 'administrator']
  435:   }
  436: 
  437:   port => {
  438:     type => 'integer',
  439:     notmemberof => [22, 23, 25, 80, 443]  # Reserved ports
  440:   }
  441: 
  442: Like C<memberof>, string comparisons are case-sensitive by default but can be controlled
  443: with the C<case_sensitive> flag:
  444: 
  445:   # Case-sensitive (default)
  446:   username => {
  447:     type => 'string',
  448:     notmemberof => ['Admin', 'Root']
  449:     # 'admin' would pass, 'Admin' would fail
  450:   }
  451: 
  452:   # Case-insensitive
  453:   username => {
  454:     type => 'string',
  455:     notmemberof => ['Admin', 'Root'],
  456:     case_sensitive => 0
  457:     # 'admin', 'ADMIN', 'Admin' all fail
  458:   }
  459: 
  460: The blacklist is checked after any C<transform> rules are applied, allowing you to
  461: normalize input before checking:
  462: 
  463:   username => {
  464:     type => 'string',
  465:     transform => sub { lc($_[0]) },  # Normalize to lowercase
  466:     notmemberof => ['admin', 'root', 'system']
  467:   }
  468: 
  469: C<notmemberof> can be combined with other validation rules:
  470: 
  471:   username => {
  472:     type => 'string',
  473:     notmemberof => ['admin', 'root', 'system'],
  474:     min => 3,
  475:     max => 20,
  476:     matches => qr/^[a-z0-9_]+$/
  477:   }
  478: 
  479: =item * C<case_sensitive>
  480: 
  481: A boolean value indicating whether string comparisons should be case-sensitive.
  482: This flag affects the C<memberof> and C<notmemberof> validation rules.
  483: The default value is C<1> (case-sensitive).
  484: 
  485: When set to C<0>, string comparisons are performed case-insensitively, allowing values
  486: with different casing to match. The original case of the input value is preserved in
  487: the validated output.
  488: 
  489:   # Case-sensitive (default)
  490:   status => {
  491:     type => 'string',
  492:     memberof => ['Draft', 'Published', 'Archived'] # Input 'draft' will fail - must match exact case
  493:   }
  494: 
  495:   # Case-insensitive
  496:   status => {
  497:     type => 'string',
  498:     memberof => ['Draft', 'Published', 'Archived'],
  499:     case_sensitive => 0 # Input 'draft', 'DRAFT', or 'DrAfT' will all pass
  500:   }
  501: 
  502:   country_code => {
  503:     type => 'string',
  504:     memberof => ['US', 'UK', 'CA', 'FR'],
  505:     case_sensitive => 0  # Accept 'us', 'US', 'Us', etc.
  506:   }
  507: 
  508: This flag has no effect on numeric types (C<integer>, C<number>, C<float>) as numbers
  509: do not have case.
  510: 
  511: =item * C<min>/C<minimum>
  512: 
  513: The minimum length (for strings in characters not bytes), value (for numbers) or number of keys (for hashrefs).
  514: 
  515: =item * C<max>
  516: 
  517: The maximum length (for strings in characters not bytes), value (for numbers) or number of keys (for hashrefs).
  518: 
  519: =item * C<matches>
  520: 
  521: A regular expression that the parameter value must match.
  522: Checks all members of arrayrefs.
  523: 
  524: =item * C<nomatch>
  525: 
  526: A regular expression that the parameter value must not match.
  527: Checks all members of arrayrefs.
  528: 
  529: =item * C<bnf>
  530: 
  531: An arrayref of BNF grammar lines that defines the set of strings the
  532: parameter value must belong to.
  533: The first rule in the grammar is the start rule; the value must match it
  534: exactly (anchored).
  535: 
  536: Each element is either a rule definition (C<< <name> ::= ... >>) or a
  537: continuation of the previous rule.  Terminals are double-quoted; non-terminals
  538: use angle brackets.  Alternatives are separated by C<|>.
  539: 
  540:   $schema = {
  541:     na_tel_no => {
  542:       type => 'string',
  543:       bnf  => [
  544:         '<telephone-number> ::= <country-code-opt> <area-code> <separator-opt>',
  545:         '<central-office-code> <separator-opt> <station-code>',
  546:         '<country-code-opt> ::= "" | "+1" | "1"',
  547:         '<separator-opt>    ::= "" | "-" | " " | "."',
  548:         '<area-code>        ::= <digit2-9> <digit0-9> <digit0-9>',
  549:         '<central-office-code> ::= <digit2-9> <digit0-9> <digit0-9>',
  550:         '<station-code>     ::= <digit0-9> <digit0-9> <digit0-9> <digit0-9>',
  551:         '<digit0-9> ::= "0"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9"',
  552:         '<digit2-9> ::= "2"|"3"|"4"|"5"|"6"|"7"|"8"|"9"',
  553:       ],
  554:     },
  555:   };
  556: 
  557: Implemented by L<Params::Validate::Strict::BNF>.  Recursive grammars are not
  558: supported.
  559: 
  560: =item * C<position>
  561: 
  562: For routines and methods that take positional args,
  563: this integer value defines which position the argument will be in.
  564: If this is set for all arguments,
  565: C<validate_strict> will return a reference to an array, rather than a reference to a hash.
  566: 
  567: =item * C<slurp>
  568: 
  569: Valid only in positional-argument schemas (those where every parameter has a
  570: C<position> value).  When C<slurp =E<gt> 1> is set, this parameter collects
  571: I<all> remaining positional arguments starting from C<position> into an
  572: arrayref, rather than taking only the single element at that index.
  573: 
  574:   # sub log_message($level, @messages)
  575:   my $schema = {
  576:     level    => { type => 'string',   position => 0 },
  577:     messages => { type => 'arrayref', position => 1, slurp => 1 },
  578:   };
  579: 
  580: The slurp parameter is implicitly optional: if there are no arguments at or
  581: beyond C<position>, the value is an empty arrayref.  Combine with C<min =E<gt>
  582: 1> to require at least one element:
  583: 
  584:   messages => { type => 'arrayref', position => 1, slurp => 1, min => 1 }
  585: 
  586: At most one slurp parameter may be defined per schema, and it must have the
  587: highest C<position> value.  The return value at that position is an arrayref.
  588: 
  589: =item * C<aliases>
  590: 
  591: An arrayref of alternative input-key names that are also accepted for this
  592: parameter.  When any alias is found in the input the parameter is stored
  593: under its canonical schema key; if both the canonical name and an alias are
  594: present the canonical name takes precedence.  Aliases are not treated as
  595: unknown parameters regardless of the C<unknown_parameter_handler> setting.
  596: 
  597:   colour => {
  598:     type    => 'string',
  599:     aliases => ['color'],
  600:     memberof => ['red', 'green', 'blue'],
  601:   }
  602: 
  603: Only named (hashref) input supports aliases; positional (arrayref) input
  604: ignores them.
  605: 
  606: =item * C<regex>
  607: 
  608: Synonym of matches
  609: 
  610: =item * C<description>
  611: 
  612: The description of the rule
  613: 
  614: =item * C<callback>
  615: 
  616: A code reference to a subroutine that performs custom validation logic.
  617: The subroutine should accept the parameter value, the argument list and the schema as arguments and return true if the value is valid, false otherwise.
  618: 
  619: Use this to test more complex examples:
  620: 
  621:   my $schema = {
  622:     even_number => {
  623:       type => 'integer',
  624:       callback => sub { $_[0] % 2 == 0 }
  625:   };
  626: 
  627:   # Specify the arguments for a routine which has a second, optional argument, which, if given, must be less than or equal to the first
  628:   my $schema = {
  629:     first => {
  630:       type => 'integer'
  631:     }, second => {
  632:       type => 'integer',
  633:       optional => 1,
  634:       callback => sub {
  635:         my($value, $args) = @_;
  636: 	# The 'defined' is needed in case 'second' is evaluated before 'first'
  637: 	return (defined($args->{first}) && $value <= $args->{first}) ? 1 : 0
  638:       }
  639:     }
  640:   };
  641: 
  642: =item * C<optional>
  643: 
  644: A boolean value indicating whether the parameter is optional.
  645: If true, the parameter is not required.
  646: If false or omitted, the parameter is required.
  647: 
  648: It can be a reference to a code snippet that will return true or false,
  649: to determine if the parameter is optional or not.
  650: The code will be called with two arguments: the value of the parameter and hash ref of all parameters:
  651: 
  652:   my $schema = {
  653:     optional_field => {
  654:       type => 'string',
  655:       optional => sub {
  656:         my ($value, $all_params) = @_;
  657:         return $all_params->{make_optional} ? 1 : 0;
  658:       }
  659:     },
  660:     make_optional => { type => 'boolean' }
  661:   };
  662: 
  663:   my $result = validate_strict(schema => $schema, input => { make_optional => 1 });
  664: 
  665: If the parameter is not optional, it can be passed an undef value, which will not flag an error.
  666: This is by design.
  667: So this will not say that the required parameter 's' is missing:
  668: 
  669:     validate_strict(
  670:         schema => { s => { type => 'string' } },
  671:         input  => { s => undef },
  672:     );
  673: 
  674: =item * C<default>
  675: 
  676: Populate missing optional parameters with the specified value.
  677: Note that this value is not validated.
  678: 
  679:   username => {
  680:     type => 'string',
  681:     optional => 1,
  682:     default => 'guest'
  683:   }
  684: 
  685: =item * C<element_type>
  686: 
  687: Extends the validation to individual elements of arrays.
  688: 
  689:   tags => {
  690:     type => 'arrayref',
  691:     element_type => 'number',	# Float means the same
  692:     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
  693:     max => 5
  694:   }
  695: 
  696: =item * C<error_msg>
  697: 
  698: The custom error message to be used in the event of a validation failure.
  699: 
  700:   age => {
  701:     type => 'integer',
  702:     min => 18,
  703:     error_msg => 'You must be at least 18 years old'
  704:   }
  705: 
  706: =item * C<nullable>
  707: 
  708: Like optional,
  709: though this cannot be a coderef,
  710: only a flag.
  711: 
  712: =item * C<schema>
  713: 
  714: You can validate nested hashrefs and arrayrefs using the C<schema> property:
  715: 
  716:     my $schema = {
  717:         user => {	# 'user' is a hashref
  718:             type => 'hashref',
  719:             schema => {	# Specify what the elements of the hash should be
  720:                 name => { type => 'string' },
  721:                 age => { type => 'integer', min => 0 },
  722:                 hobbies => {	# 'hobbies' is an array ref that this user has
  723:                     type => 'arrayref',
  724:                     schema => { type => 'string' }, # Validate each hobby
  725:                     min => 1 # At least one hobby
  726:                 }
  727:             }
  728:         }, metadata => {
  729:             type => 'hashref',
  730:             schema => {
  731:                 created => { type => 'string' },
  732:                 tags => {
  733:                     type => 'arrayref',
  734:                     schema => {
  735:                         type => 'string',
  736:                         matches => qr/^[a-z]+$/	# Or you can say matches => '^[a-z]+$'
  737:                     }
  738:                 }
  739:             }
  740:         }
  741:     };
  742: 
  743: =item * C<validate>
  744: 
  745: A snippet of code that validates the input.
  746: It's passed the input arguments,
  747: and return a string containing a reason for rejection,
  748: or undef if it's allowed.
  749: 
  750:     my $schema = {
  751:       user => {
  752:         type => 'string',
  753: 	validate => sub {
  754: 	  if($_[0]->{'password'} eq 'bar') {
  755: 	    return undef;
  756: 	  }
  757: 	  return 'Invalid password, try again';
  758: 	}
  759:       }, password => {
  760:          type => 'string'
  761:       }
  762:     };
  763: 
  764: =item * C<transform>
  765: 
  766: A code reference to a subroutine that transforms/sanitizes the parameter value before validation.
  767: The subroutine should accept the parameter value as an argument and return the transformed value.
  768: The transformation is applied before any validation rules are checked, allowing you to normalize
  769: or clean data before it is validated.
  770: 
  771: Common use cases include trimming whitespace, normalizing case, formatting phone numbers,
  772: sanitizing user input, and converting between data formats.
  773: 
  774:   # Simple string transformations
  775:   username => {
  776:     type => 'string',
  777:     transform => sub { lc(trim($_[0])) },  # lowercase and trim
  778:     matches => qr/^[a-z0-9_]+$/
  779:   }
  780: 
  781:   email => {
  782:     type => 'string',
  783:     transform => sub { lc(trim($_[0])) },  # normalize email
  784:     matches => qr/^[^@\s]+\@[^@\s]+\.[^@\s]+$/
  785:   }
  786: 
  787:   # Array transformations
  788:   tags => {
  789:     type => 'arrayref',
  790:     transform => sub { [map { lc($_) } @{$_[0]}] },  # lowercase all elements
  791:     element_type => 'string'
  792:   }
  793: 
  794:   keywords => {
  795:     type => 'arrayref',
  796:     transform => sub {
  797:       my @arr = map { lc(trim($_)) } @{$_[0]};
  798:       my %seen;
  799:       return [grep { !$seen{$_}++ } @arr];  # remove duplicates
  800:     }
  801:   }
  802: 
  803:   # Numeric transformations
  804:   quantity => {
  805:     type => 'integer',
  806:     transform => sub { int($_[0] + 0.5) },  # round to nearest integer
  807:     min => 1
  808:   }
  809: 
  810:   # Sanitization
  811:   slug => {
  812:     type => 'string',
  813:     transform => sub {
  814:       my $str = lc(trim($_[0]));
  815:       $str =~ s/[^\w\s-]//g;  # remove special characters
  816:       $str =~ s/\s+/-/g;      # replace spaces with hyphens
  817:       return $str;
  818:     },
  819:     matches => qr/^[a-z0-9-]+$/
  820:   }
  821: 
  822:   phone => {
  823:     type => 'string',
  824:     transform => sub {
  825:       my $str = $_[0];
  826:       $str =~ s/\D//g;  # remove all non-digits
  827:       return $str;
  828:     },
  829:     matches => qr/^\d{10}$/
  830:   }
  831: 
  832: The C<transform> function is applied to the value before any validation checks (C<min>/C<minimum>, C<max>,
  833: C<matches>, C<callback>, etc.), ensuring that validation rules are checked against the cleaned data.
  834: 
  835: Transformations work with all parameter types including nested structures:
  836: 
  837:   user => {
  838:     type => 'hashref',
  839:     schema => {
  840:       name => {
  841:         type => 'string',
  842:         transform => sub { trim($_[0]) }
  843:       }, email => {
  844:         type => 'string',
  845:         transform => sub { lc(trim($_[0])) }
  846:       }
  847:     }
  848:   }
  849: 
  850: Transformations can also be defined in custom types for reusability:
  851: 
  852:   my $custom_types = {
  853:     email => {
  854:       type => 'string',
  855:       transform => sub { lc(trim($_[0])) },
  856:       matches => qr/^[^@\s]+\@[^@\s]+\.[^@\s]+$/
  857:     }
  858:   };
  859: 
  860: Note that the transformed value is what gets returned in the validated result and is what
  861: subsequent validation rules will check against. If a transformation might fail, ensure it
  862: handles edge cases appropriately.
  863: It is the responsibility of the transformer to ensure that the type of the returned value is correct,
  864: since that is what will be validated.
  865: 
  866: Many validators also allow a code ref to be passed so that you can create your own, conditional validation rule, e.g.:
  867: 
  868:   $schema = {
  869:     age => {
  870:       type => 'integer',
  871:       min => sub {
  872:           my ($value, $all_params) = @_;
  873:           return $all_params->{country} eq 'US' ? 21 : 18;
  874:       }
  875:     }
  876:   }
  877: 
  878: =item * C<validator>
  879: 
  880: A synonym of C<validate>, for compatibility with L<Data::Processor>.
  881: 
  882: =item * C<cross_validation>
  883: 
  884: A reference to a hash that defines validation rules that depend on more than one parameter.
  885: Cross-field validations are performed after all individual parameter validations have passed,
  886: allowing you to enforce business logic that requires checking relationships between different fields.
  887: 
  888: Each cross-validation rule is a key-value pair where the key is a descriptive name for the validation
  889: and the value is a code reference that accepts a hash reference of all validated parameters.
  890: The subroutine should return C<undef> if the validation passes, or an error message string if it fails.
  891: 
  892:   my $schema = {
  893:     password => { type => 'string', min => 8 },
  894:     password_confirm => { type => 'string' }
  895:   };
  896: 
  897:   my $cross_validation = {
  898:     passwords_match => sub {
  899:       my $params = shift;
  900:       return $params->{password} eq $params->{password_confirm}
  901:         ? undef : "Passwords don't match";
  902:     }
  903:   };
  904: 
  905:   my $validated = validate_strict(
  906:     schema => $schema,
  907:     input => $input,
  908:     cross_validation => $cross_validation
  909:   );
  910: 
  911: Common use cases include password confirmation, date range validation, numeric comparisons,
  912: and conditional requirements:
  913: 
  914:   # Date range validation
  915:   my $cross_validation = {
  916:     date_range_valid => sub {
  917:       my $params = shift;
  918:       return $params->{start_date} le $params->{end_date}
  919:         ? undef : "Start date must be before or equal to end date";
  920:     }
  921:   };
  922: 
  923:   # Price range validation
  924:   my $cross_validation = {
  925:     price_range_valid => sub {
  926:       my $params = shift;
  927:       return $params->{min_price} <= $params->{max_price}
  928:         ? undef : "Minimum price must be less than or equal to maximum price";
  929:     }
  930:   };
  931: 
  932:   # Conditional required field
  933:   my $cross_validation = {
  934:     address_required_for_delivery => sub {
  935:       my $params = shift;
  936:       if ($params->{shipping_method} eq 'delivery' && !$params->{delivery_address}) {
  937:         return "Delivery address is required when shipping method is 'delivery'";
  938:       }
  939:       return undef;
  940:     }
  941:   };
  942: 
  943: Multiple cross-validations can be defined in the same hash, and they are all checked in order.
  944: If any cross-validation fails, the function will C<croak> with the error message returned by the validation:
  945: 
  946:   my $cross_validation = {
  947:     passwords_match => sub {
  948:       my $params = shift;
  949:       return $params->{password} eq $params->{password_confirm}
  950:         ? undef : "Passwords don't match";
  951:     },
  952:     emails_match => sub {
  953:       my $params = shift;
  954:       return $params->{email} eq $params->{email_confirm}
  955:         ? undef : "Email addresses don't match";
  956:     },
  957:     age_matches_birth_year => sub {
  958:       my $params = shift;
  959:       my $current_year = (localtime)[5] + 1900;
  960:       my $calculated_age = $current_year - $params->{birth_year};
  961:       return abs($calculated_age - $params->{age}) <= 1
  962:         ? undef : "Age doesn't match birth year";
  963:     }
  964:   };
  965: 
  966: Cross-validations receive the parameters after individual validation and transformation have been applied,
  967: so you can rely on the data being in the correct format and type:
  968: 
  969:   my $schema = {
  970:     email => {
  971:       type => 'string',
  972:       transform => sub { lc($_[0]) }  # Lowercased before cross-validation
  973:     },
  974:     email_confirm => {
  975:       type => 'string',
  976:       transform => sub { lc($_[0]) }
  977:     }
  978:   };
  979: 
  980:   my $cross_validation = {
  981:     emails_match => sub {
  982:       my $params = shift;
  983:       # Both emails are already lowercased at this point
  984:       return $params->{email} eq $params->{email_confirm}
  985:         ? undef : "Email addresses don't match";
  986:     }
  987:   };
  988: 
  989: Cross-validations can access nested structures and optional fields:
  990: 
  991:   my $cross_validation = {
  992:     guardian_required_for_minors => sub {
  993:       my $params = shift;
  994:       if ($params->{user}{age} < 18 && !$params->{guardian}) {
  995:         return "Guardian information required for users under 18";
  996:       }
  997:       return undef;
  998:     }
  999:   };
 1000: 
 1001: =item * metadata
 1002: 
 1003: Fields starting with <_> are generated by L<App::Test::Generator::SchemaExtractor>,
 1004: and are currently ignored.
 1005: 
 1006: =item * C<semantic>
 1007: 
 1008: A hint about the semantic meaning of the parameter value.
 1009: Supported values: C<unix_timestamp>, C<identifier>, C<class_name>.
 1010: 
 1011:   ts     => { type => 'integer', semantic => 'unix_timestamp' }
 1012:   func   => { type => 'string',  semantic => 'identifier' }
 1013:   module => { type => 'string',  semantic => 'class_name' }
 1014: 
 1015: When C<semantic> is C<unix_timestamp>, the value must be a non-negative integer no greater than
 1016: C<2147483647> (i.e. a valid 32-bit Unix epoch timestamp).
 1017: Values outside this range cause the function to C<croak>.
 1018: 
 1019: When C<semantic> is C<identifier>, the value must match C</\A[A-Za-z_]\w*\z/>, a single
 1020: valid Perl bareword identifier.  Package separators (C<::>) are not permitted; use
 1021: C<class_name> for those.
 1022: 
 1023: When C<semantic> is C<class_name>, the value must match
 1024: C</\A[A-Za-z_]\w*(?:::[A-Za-z_]\w*)*\z/>, a syntactically valid Perl class name such
 1025: as C<'Foo'> or C<'Foo::Bar::Baz'>.  The class does not need to be loaded.
 1026: 
 1027: Unknown semantic values emit a warning but do not cause an error.
 1028: 
 1029: =item * schematic
 1030: 
 1031: TODO: gives an idea of what the field will be, e.g. C<filename>.
 1032: 
 1033: All cross-validations must pass for the overall validation to succeed.
 1034: 
 1035: =item * C<relationships>
 1036: 
 1037: A reference to an array that defines validation rules based on relationships between parameters.
 1038: Relationship validations are performed after all individual parameter validations have passed,
 1039: but before cross-validations.
 1040: 
 1041: Each relationship is a hash reference with a C<type> field and additional fields depending on the type:
 1042: 
 1043: =over 4
 1044: 
 1045: =item * B<mutually_exclusive>
 1046: 
 1047: Parameters that cannot be specified together.
 1048: 
 1049:   relationships => [
 1050:     {
 1051:       type => 'mutually_exclusive',
 1052:       params => ['file', 'content'],
 1053:       description => 'Cannot specify both file and content'
 1054:     }
 1055:   ]
 1056: 
 1057: =item * B<required_group>
 1058: 
 1059: At least one parameter from the group must be specified.
 1060: 
 1061:   relationships => [
 1062:     {
 1063:       type => 'required_group',
 1064:       params => ['id', 'name'],
 1065:       logic => 'or',
 1066:       description => 'Must specify either id or name'
 1067:     }
 1068:   ]
 1069: 
 1070: =item * B<conditional_requirement>
 1071: 
 1072: If one parameter is specified, another becomes required.
 1073: 
 1074:   relationships => [
 1075:     {
 1076:       type => 'conditional_requirement',
 1077:       if => 'async',
 1078:       then_required => 'callback',
 1079:       description => 'When async is specified, callback is required'
 1080:     }
 1081:   ]
 1082: 
 1083: =item * B<dependency>
 1084: 
 1085: One parameter requires another to be present.
 1086: 
 1087:   relationships => [
 1088:     {
 1089:       type => 'dependency',
 1090:       param => 'port',
 1091:       requires => 'host',
 1092:       description => 'port requires host to be specified'
 1093:     }
 1094:   ]
 1095: 
 1096: =item * B<value_constraint>
 1097: 
 1098: Specific value requirements between parameters.
 1099: 
 1100:   relationships => [
 1101:     {
 1102:       type => 'value_constraint',
 1103:       if => 'ssl',
 1104:       then => 'port',
 1105:       operator => '==',
 1106:       value => 443,
 1107:       description => 'When ssl is specified, port must equal 443'
 1108:     }
 1109:   ]
 1110: 
 1111: =item * B<value_conditional>
 1112: 
 1113: Parameter required when another has a specific value.
 1114: 
 1115:   relationships => [
 1116:     {
 1117:       type => 'value_conditional',
 1118:       if => 'mode',
 1119:       equals => 'secure',
 1120:       then_required => 'key',
 1121:       description => "When mode equals 'secure', key is required"
 1122:     }
 1123:   ]
 1124: 
 1125: =back
 1126: 
 1127: If a parameter is optional and its value is C<undef>,
 1128: validation will be skipped for that parameter.
 1129: 
 1130: If the validation fails, the function will C<croak> with an error message describing the validation failure.
 1131: 
 1132: 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.
 1133: 
 1134: The C<description> field is optional but recommended for clearer error messages.
 1135: 
 1136: =back
 1137: 
 1138: =head2 Example Usage
 1139: 
 1140:   my $schema = {
 1141:     host => { type => 'string' },
 1142:     port => { type => 'integer' },
 1143:     ssl => { type => 'boolean' },
 1144:     file => { type => 'string', optional => 1 },
 1145:     content => { type => 'string', optional => 1 }
 1146:   };
 1147: 
 1148:   my $relationships = [
 1149:     {
 1150:       type => 'mutually_exclusive',
 1151:       params => ['file', 'content']
 1152:     }, {
 1153:       type => 'required_group',
 1154:       params => ['host', 'file']
 1155:     },
 1156:     {
 1157:       type => 'dependency',
 1158:       param => 'port',
 1159:       requires => 'host'
 1160:     },
 1161:     {
 1162:       type => 'value_constraint',
 1163:       if => 'ssl',
 1164:       then => 'port',
 1165:       operator => '==',
 1166:       value => 443
 1167:     }
 1168:   ];
 1169: 
 1170:   my $validated = validate_strict(
 1171:     schema => $schema,
 1172:     input => $input,
 1173:     relationships => $relationships
 1174:   );
 1175: 
 1176: =head1 MIGRATION FROM LEGACY VALIDATORS
 1177: 
 1178: =head2 From L<Params::Validate>
 1179: 
 1180:     # Old style
 1181:     validate(@_, {
 1182:         name => { type => SCALAR },
 1183:         age => { type => SCALAR, regex => qr/^\d+$/ }
 1184:     });
 1185: 
 1186:     # New style
 1187:     validate_strict(
 1188:         schema => {	# or "members"
 1189:             name => 'string',
 1190:             age => { type => 'integer', min => 0 }
 1191:         },
 1192:         args => { @_ }
 1193:     );
 1194: 
 1195: =head2 From L<Type::Params>
 1196: 
 1197:     # Old style
 1198:     my ($name, $age) = validate_positional \@_, Str, Int;
 1199: 
 1200:     # New style - requires converting to named parameters first
 1201:     my %args = (name => $_[0], age => $_[1]);
 1202:     my $validated = validate_strict(
 1203:         schema => { name => 'string', age => 'integer' },
 1204:         args => \%args
 1205:     );
 1206: 
 1207: =cut
 1208: 
 1209: sub validate_strict
 1210: {
●1211 → 1223 → 1231 1211: 	local $_depth = $_depth + 1;
 1212: 	Carp::croak('validate_strict: maximum call depth exceeded — possible infinite recursion in union-type schema')
 1213: 		if $_depth > 20;
  Mutants (Total: 3, Killed: 3, Survived: 0)
 1214: 
 1215: 	my %args = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_;
 1216: 	my $params = \%args;
 1217: 
 1218: 	my $schema = $params->{'schema'} || $params->{'members'};
 1219: 	my $args = $params->{'args'} || $params->{'input'};
 1220: 	my $logger = $params->{'logger'};
 1221: 	my $custom_types = $params->{'custom_types'};
 1222: 	my $unknown_parameter_handler = $params->{'unknown_parameter_handler'};
 1223: 	if(!defined($unknown_parameter_handler)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1224: 		if($params->{'carp_on_warn'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1225: 			$unknown_parameter_handler = 'warn';
 1226: 		} else {
 1227: 			$unknown_parameter_handler = 'die';
 1228: 		}
 1229: 	}
 1230: 
●1231 → 1235 → 1240 1231: 	return $args if(!defined($schema));	# No schema, allow all arguments
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1232: 
 1233: 	# Accept arrayref schema: [{ name=>'param', type=>'...', ... }, ...]
 1234: 	# Normalise to the standard named-parameter hashref form before further processing.
 1235: 	if(ref($schema) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1236: 		$schema = _schema_from_arrayref($schema, $logger);
 1237: 	}
 1238: 
 1239: 	# Check if schema and args are references to hashes
●1240 → 1240 → 1245 1240: 	if(ref($schema) ne 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1241: 		_error($logger, 'validate_strict: schema must be a hash reference');
 1242: 	}
 1243: 
 1244: 	# Inspired by Data::Processor
●1245 → 1248 → 1258 1245: 	my $schema_description = $params->{'description'} || 'validate_strict';
 1246: 	my $error_msg = $params->{'error_msg'};
 1247: 
 1248: 	if($schema->{'members'} && ($schema->{'description'} || $schema->{'error_msg'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1249: 		$schema_description = $schema->{'description'};
 1250: 		$error_msg = $schema->{'error_msg'};
 1251: 		$schema = $schema->{'members'};
 1252: 		# The members value may also be in arrayref form
 1253: 		if(ref($schema) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1254: 			$schema = _schema_from_arrayref($schema, $logger);
 1255: 		}
 1256: 	}
 1257: 
●1258 → 1258 → 1264 1258: 	if(exists($params->{'args'}) && (!defined($args))) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1259: 		$args = {};
 1260: 	} elsif((ref($args) ne 'HASH') && (ref($args) ne 'ARRAY')) {
 1261: 		_error($logger, $error_msg || "$schema_description: args must be a hash or array reference");
 1262: 	}
 1263: 
●1264 → 1264 → 1295 1264: 	if(ref($args) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1265: 		# Named args: build alias reverse-map first so aliased keys are not
 1266: 		# treated as unknown parameters.
 1267: 		my %_alias_to_canonical;
 1268: 		foreach my $canonical (keys %{$schema}) {
 1269: 			my $r = $schema->{$canonical};
 1270: 			if(ref($r) eq 'HASH' && ref($r->{'aliases'}) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1271: 				$_alias_to_canonical{$_} = $canonical for @{$r->{'aliases'}};
 1272: 			}
 1273: 		}
 1274: 
 1275: 		foreach my $key (keys %{$args}) {
 1276: 			if(!exists($schema->{$key}) && !exists($_alias_to_canonical{$key})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1277: 				if($unknown_parameter_handler eq 'die') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1278: 					_error($logger, "$schema_description: Unknown parameter '$key'");
 1279: 				} elsif($unknown_parameter_handler eq 'warn') {
 1280: 					_warn($logger, "$schema_description: Unknown parameter '$key'");
 1281: 					next;
 1282: 				} elsif($unknown_parameter_handler eq 'ignore') {
 1283: 					if($logger) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1284: 						$logger->debug(__PACKAGE__ . ": $schema_description: Unknown parameter '$key'");
 1285: 					}
 1286: 					next;
 1287: 				} else {
 1288: 					_error($logger, "$schema_description: '$unknown_parameter_handler' unknown_parameter_handler must be one of die, warn, ignore");
 1289: 				}
 1290: 			}
 1291: 		}
 1292: 	}
 1293: 
 1294: 	# Find out if this routine takes positional arguments
●1295 → 1296 → 1320 1295: 	my $are_positional_args = -1;
 1296: 	foreach my $key (keys %{$schema}) {
 1297: 		if(defined(my $rules = $schema->{$key})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1298: 			if(ref($rules) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1299: 				if($rules->{'slurp'} && !defined($rules->{'position'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1300: 					_error($logger, "::validate_strict: slurp parameter '$key' requires a 'position'");
 1301: 				}
 1302: 				if(!defined($rules->{'position'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1303: 					if($are_positional_args == 1) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1304: 						_error($logger, "::validate_strict: $key is missing position value");
 1305: 					}
 1306: 					$are_positional_args = 0;
 1307: 					last;
 1308: 				}
 1309: 				$are_positional_args = 1;
 1310: 			} else {
 1311: 				$are_positional_args = 0;
 1312: 				last;
 1313: 			}
 1314: 		} else {
 1315: 			$are_positional_args = 0;
 1316: 			last;
 1317: 		}
 1318: 	}
 1319: 
●1320 → 1322 → 2179 1320: 	my %validated_args;
 1321: 	my %invalid_args;
 1322: 	foreach my $key (keys %{$schema}) {
 1323: 		my $rules = $schema->{$key};
 1324: 
 1325: 		# For named-arg schemas: resolve which input key provides this parameter.
 1326: 		# If the canonical name is absent, try each alias in order.
 1327: 		my $lookup_key = $key;
 1328: 		if($are_positional_args != 1 && ref($rules) eq 'HASH'
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1329: 		   && ref($rules->{'aliases'}) eq 'ARRAY'
 1330: 		   && !exists($args->{$key})) {
 1331: 			for my $alias (@{$rules->{'aliases'}}) {
 1332: 				if(exists($args->{$alias})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1333: 					$lookup_key = $alias;
 1334: 					last;
 1335: 				}
 1336: 			}
 1337: 		}
 1338: 
 1339: 		my $value;
 1340: 		if($are_positional_args == 1) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1341: 			if(ref($args) ne 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1342: 				_error($logger, "::validate_strict: position $rules->{position} given for '$key', but args isn't an array");
 1343: 			}
 1344: 			if(ref($rules) eq 'HASH' && $rules->{'slurp'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1345: 				my $pos = $rules->{'position'};
 1346: 				$value = [@{$args}[$pos .. $#$args]];
 1347: 			} else {
 1348: 				$value = $args->[$rules->{'position'}];
 1349: 			}
 1350: 		} else {
 1351: 			$value = $args->{$lookup_key};
 1352: 		}
 1353: 
 1354: 		if(!defined($rules)) {	# Allow anything
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1355: 			$validated_args{$key} = $value;
 1356: 			next;
 1357: 		}
 1358: 
 1359: 		# If rules are a simple type string
 1360: 		if(ref($rules) eq '') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1361: 			$rules = { type => $rules };
 1362: 		}
 1363: 
 1364: 		my $is_optional = 0;
 1365: 
 1366: 		my $rule_description = $schema_description;	# Can be overridden in each element
 1367: 		my $param_label = "'$key'";
 1368: 
 1369: 		if(ref($rules) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1370: 			if(exists($rules->{'description'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1371: 				$param_label = "'$key' ($rules->{description})";
 1372: 			}
 1373: 			# For stringref: validate and dereference before transform so that
 1374: 			# transform (and all subsequent rule handlers) see the plain string.
 1375: 			# Preserve the original ref so optional => CODE receives what the caller passed.
 1376: 			my $pre_deref_value = $value;
 1377: 			my $is_stringref_type = defined($value) && defined($rules->{'type'}) && !ref($rules->{'type'}) && lc($rules->{'type'}) eq 'stringref';
 1378: 			if($is_stringref_type) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1379: 				if(ref($value) ne 'SCALAR') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1380: 					my $got = ref($value) ? 'a ' . ref($value) . ' reference' : 'a plain scalar';
 1381: 					_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be a string reference, not $got");
 1382: 				}
 1383: 				$value = ${$value};
 1384: 			}
 1385: 			if($rules->{'transform'} && defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1386: 				if(ref($rules->{'transform'}) eq 'CODE') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1387: 					$value = &{$rules->{'transform'}}($value);
 1388: 				} else {
 1389: 					_error($logger, "$rule_description: transforms must be a code ref");
 1390: 				}
 1391: 			}
 1392: 			if(exists($rules->{optional})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1393: 				if(ref($rules->{'optional'}) eq 'CODE') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1394: 					# For stringref the coderef receives the original SCALAR ref (what
 1395: 					# the caller supplied), not the internally-dereferenced plain string.
 1396: 					# For all other types the post-transform value is passed, as before.
 1397: 					my $opt_arg = $is_stringref_type ? $pre_deref_value : $value;
 1398: 					$is_optional = &{$rules->{optional}}($opt_arg, $args);
 1399: 				} else {
 1400: 					$is_optional = $rules->{'optional'};
 1401: 				}
 1402: 			} elsif($rules->{nullable}) {
 1403: 				$is_optional = $rules->{'nullable'};
 1404: 			} elsif(defined($rules->{'type'}) && !ref($rules->{'type'}) && lc($rules->{'type'}) eq 'void') {
 1405: 				$is_optional = 1;
 1406: 			} elsif($rules->{'slurp'}) {
 1407: 				$is_optional = 1;
 1408: 			}
 1409: 		}
 1410: 
 1411: 		# Handle optional parameters
 1412: 		if((ref($rules) eq 'HASH') && $is_optional) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1413: 			my $missing;
 1414: 			if($are_positional_args == 1) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1415: 				# A slurp parameter is never missing: at worst it yields an empty arrayref.
 1416: 				$missing = $rules->{'slurp'} ? 0 : !defined($args->[$rules->{position}]);
 1417: 			} else {
 1418: 				$missing = !exists($args->{$lookup_key});
 1419: 			}
 1420: 			if($missing) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1421: 				if($are_positional_args == 1) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1422: 					if(scalar(@{$args}) < $rules->{'position'}) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1423: 						# arg array is too short, so it must be missing
 1424: 						_error($logger, "$rule_description: Required parameter $param_label is missing");
 1425: 						next;
 1426: 					}
 1427: 				}
 1428: 				if(exists($rules->{'default'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1429: 					# Populate missing optional parameters with the specified output values
 1430: 					$validated_args{$key} //= $rules->{'default'};
 1431: 					next;	# default wins; do not fall through to the schema branch
 1432: 				}
 1433: 
 1434: 				if($rules->{'schema'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1435: 					$value = _apply_nested_defaults({}, $rules->{'schema'});
 1436: 					next unless scalar(%{$value});
 1437: 					# The nested schema has a default value
 1438: 				} else {
 1439: 					next;	# optional and missing
 1440: 				}
 1441: 			}
 1442: 		} elsif((ref($args) eq 'HASH') && !exists($args->{$lookup_key})) {
 1443: 			# The parameter is required
 1444: 			# Use exists rather than defined, so that an undefined value can be passed, but the key is there
 1445: 			_error($logger, "$rule_description: Required parameter $param_label is missing");
 1446: 		}
 1447: 
 1448: 		# Normalise union type shorthand: { type => ['string', 'integer'], ... }
 1449: 		# or pipe-separated string { type => 'string|integer' }
 1450: 		# into the array-of-rules form that the ARRAY handler below already supports.
 1451: 		# Each candidate type inherits all other constraints from the parent rule
 1452: 		# (min, max, matches, optional, etc.) so they are each fully validated.
 1453: 		# Must run after optional/transform handling above but before rule dispatch below.
 1454: 		if(ref($rules) eq 'HASH' && !ref($rules->{'type'}) && defined($rules->{'type'}) && $rules->{'type'} =~ /\|/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1455: 			$rules = { %$rules, type => [ split /\s*\|\s*/, $rules->{'type'} ] };
 1456: 		}
 1457: 		if(ref($rules) eq 'HASH' && ref($rules->{'type'}) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1458: 			my %base = %{$rules};
 1459: 			my @type_list = @{delete $base{'type'}};
 1460: 			if(!@type_list) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1461: 				_error($logger, "$rule_description: Parameter $param_label: union type list must not be empty");
 1462: 			}
 1463: 			# Expand into one full rule hash per candidate type
 1464: 			$rules = [ map { { %base, type => $_ } } @type_list ];
 1465: 		}
 1466: 
 1467: 		# Validate based on rules
 1468: 		if(ref($rules) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1469: 			if(defined(my $min = $rules->{'min'} // $rules->{'minimum'}) && defined(my $max = $rules->{'max'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1470: 				if($min > $max) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1471: 					_error($logger, "validate_strict($key): min must be <= max ($min > $max)");
 1472: 				}
 1473: 			}
 1474: 
 1475: 			# memberof and its synonym enum cannot be combined with min or max
 1476: 			if($rules->{'memberof'} || $rules->{'enum'} || $rules->{'values'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1477: 				if(defined(my $min = $rules->{'min'} // $rules->{'minimum'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1478: 					_error($logger, "validate_strict($key): min ($min) makes no sense with memberof/enum/values");
 1479: 				}
 1480: 				if(defined(my $max = $rules->{'max'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1481: 					_error($logger, "validate_strict($key): max ($max) makes no sense with memberof/enum/values");
 1482: 				}
 1483: 			}
 1484: 
 1485: 			foreach my $rule_name ('type', grep { $_ ne 'type' } keys %$rules) {
 1486: 				my $rule_value = $rules->{$rule_name};
 1487: 
 1488: 				if((ref($rule_value) eq 'CODE')
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1489: 					&& ($rule_name ne 'validate')
 1490: 					&& ($rule_name ne 'callback')
 1491: 					&& ($rule_name ne 'validator')
 1492: 					&& ($rule_name ne 'transform')	# already applied before this loop
 1493: 					&& ($rule_name ne 'optional')) {	# already applied before this loop
 1494: 					$rule_value = &{$rule_value}($value, $args);
 1495: 				}
 1496: 
 1497: 				# Better OOP, the routine has been given an object rather than a scalar
 1498: 				if(Scalar::Util::blessed($rule_value) && $rule_value->can('as_string')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1499: 					$rule_value = $rule_value->as_string();
 1500: 				}
 1501: 
 1502: 				if($rule_name eq 'type') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1503: 					my $type = lc($rule_value);
 1504: 
 1505: 					if(($type eq 'string') || ($type eq 'str')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1506: 						if(ref($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1507: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be a string");
 1508: 						}
 1509: 						unless((ref($value) eq '') || (defined($value) && length($value))) {	# Allow undef for optional strings
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1510: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be a string");
 1511: 						}
 1512: 					} elsif(($type eq 'integer') || ($type eq 'int')) {
 1513: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1514: 							next;	# Skip if number is undefined
 1515: 						}
 1516: 						if(!Scalar::Util::looks_like_number($value) || ($value - $value) != 0 || $value != int($value)) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1517: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label ($value) must be an integer");
 1518: 						}
 1519: 						$value = int($value); # Coerce to integer
 1520: 					} elsif(($type eq 'number') || ($type eq 'float') || ($type eq 'num') || ($type eq 'double')) {
 1521: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1522: 							next;	# Skip if number is undefined
 1523: 						}
 1524: 						if(!Scalar::Util::looks_like_number($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1525: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be a number");
 1526: 						}
 1527: 						# $value = eval $value; # Coerce to number (be careful with eval)
 1528: 						$value = 0 + $value;	# Numeric coercion
 1529: 					} elsif($type eq 'arrayref') {
 1530: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1531: 							next;	# Skip if arrayref is undefined
 1532: 						}
 1533: 						if(ref($value) ne 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1534: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be an arrayref, not " . ref($value));
 1535: 						}
 1536: 					} elsif($type eq 'hashref') {
 1537: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1538: 							next;	# Skip if hashref is undefined
 1539: 						}
 1540: 						if(ref($value) ne 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1541: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be an hashref");
 1542: 						}
 1543: 					} elsif($type eq 'scalar') {
 1544: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1545: 							next;	# Skip if undefined
 1546: 						}
 1547: 						if(ref($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1548: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be a scalar, not a " . ref($value) . ' reference');
 1549: 						}
 1550: 					} elsif($type eq 'scalarref') {
 1551: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1552: 							next;	# Skip if undefined
 1553: 						}
 1554: 						if(ref($value) ne 'SCALAR') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1555: 							my $got = ref($value) ? 'a ' . ref($value) . ' reference' : 'a plain scalar';
 1556: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be a scalar reference, not $got");
 1557: 						}
 1558: 					} elsif($type eq 'stringref') {
 1559: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1560: 							next;	# Skip if undefined
 1561: 						}
 1562: 						# The early-deref block validated the SCALAR ref and set $value to the
 1563: 						# plain string.  If transform subsequently returned a reference, reject it.
 1564: 						if(ref($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1565: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label stringref transform must return a plain string, not a " . ref($value) . ' reference');
 1566: 						}
 1567: 					} elsif($type eq 'void') {
 1568: 						if(scalar(keys %{$schema}) != 1) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1569: 							_error($logger, "$rule_description: type 'void' requires exactly one parameter in the schema");
 1570: 						}
 1571: 						if(defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1572: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be undef (void type accepts no value)");
 1573: 						}
 1574: 					} elsif(($type eq 'boolean') || ($type eq 'bool')) {
 1575: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1576: 							next;	# Skip if bool is undefined
 1577: 						}
 1578: 						if(defined(my $b = $Readonly::Values::Boolean::booleans{$value})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1579: 							$value = $b;
 1580: 						} else {
 1581: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label ($value) must be a boolean");
 1582: 						}
 1583: 					} elsif($type eq 'coderef') {
 1584: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1585: 							next;	# Skip if code is undefined
 1586: 						}
 1587: 						if(ref($value) ne 'CODE') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1588: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be a coderef, not a ref to " . ref($value));
 1589: 						}
 1590: 					} elsif($type eq 'regex') {
 1591: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1592: 							next;
 1593: 						}
 1594: 						if(ref($value) ne 'Regexp') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1595: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be a compiled regex (qr//)" .
 1596: 								(ref($value) ? ", not a " . ref($value) . " reference" : ", not a plain scalar"));
 1597: 						}
 1598: 					} elsif($type eq 'handle') {
 1599: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1600: 							next;
 1601: 						}
 1602: 						my $is_handle = 0;
 1603: 						if(ref($value) eq 'GLOB' && defined(fileno($value))) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1604: 							$is_handle = 1;
 1605: 						} elsif(Scalar::Util::blessed($value) && $value->isa('IO::Handle')) {
 1606: 							$is_handle = 1;
 1607: 						} else {
 1608: 							$is_handle = defined(eval { fileno($value) });
 1609: 						}
 1610: 						unless($is_handle) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1611: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be a file handle");
 1612: 						}
 1613: 					} elsif($type eq 'arraylike') {
 1614: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1615: 							next;
 1616: 						}
 1617: 						unless(ref($value) eq 'ARRAY' || (Scalar::Util::blessed($value) && overload::Method($value, '@{}'))) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1618: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be an array reference or array-like object");
 1619: 						}
 1620: 					} elsif($type eq 'hashlike') {
 1621: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1622: 							next;
 1623: 						}
 1624: 						unless(ref($value) eq 'HASH' || (Scalar::Util::blessed($value) && overload::Method($value, '%{}'))) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1625: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be a hash reference or hash-like object");
 1626: 						}
 1627: 					} elsif($type eq 'codelike') {
 1628: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1629: 							next;
 1630: 						}
 1631: 						unless(ref($value) eq 'CODE' || (Scalar::Util::blessed($value) && overload::Method($value, '&{}'))) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1632: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be a code reference or code-like object");
 1633: 						}
 1634: 					} elsif($type eq 'invocant') {
 1635: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1636: 							next;
 1637: 						}
 1638: 						unless(Scalar::Util::blessed($value) || (!ref($value) && $value =~ /\A[A-Za-z_]\w*(?:::[A-Za-z_]\w*)*\z/)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1639: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be a blessed object or a class name");
 1640: 						}
 1641: 					} elsif($type eq 'object') {
 1642: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1643: 							next;	# Skip if object is undefined
 1644: 						}
 1645: 						if(!Scalar::Util::blessed($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1646: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must be an object");
 1647: 						}
 1648: 					} elsif(my $custom_type = $custom_types->{$type}) {
 1649: 						if($custom_type->{'transform'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1650: 							# The custom type has a transform embedded within it
 1651: 							if(ref($custom_type->{'transform'}) eq 'CODE') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1652: 								$value = &{$custom_type->{'transform'}}($value);
 1653: 							} else {
 1654: 								_error($logger, "$rule_description: transforms must be a code ref");
 1655: 							}
 1656: 						}
 1657: 						validate_strict({ input => { $key => $value }, schema => { $key => $custom_type }, custom_types => $custom_types });
 1658: 					} else {
 1659: 						_error($logger, "$rule_description: Unknown type '$type'");
 1660: 					}
 1661: 				} elsif(($rule_name eq 'min') || ($rule_name eq 'minimum')) {
 1662: 					if(!defined($rules->{'type'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1663: 						_error($logger, "$rule_description: Don't know type of $param_label to determine its minimum value $rule_value");
 1664: 					}
 1665: 					my $type = lc($rules->{'type'});
 1666: 					if(exists($custom_types->{$type}->{'min'}) || exists($custom_types->{$type}->{minimum})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1667: 						$rule_value = $custom_types->{$type}->{'min'} // $custom_types->{$type}->{minimum};
 1668: 						$type = $custom_types->{$type}->{'type'};
 1669: 					}
 1670: 					if(($type eq 'string') || ($type eq 'str') || ($type eq 'stringref')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1671: 						if($rule_value < 0) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1672: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label has meaningless minimum value that is less than zero");
 1673: 						}
 1674: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1675: 							if($rule_value > 0 && !$is_optional) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1676: 								_rule_error($logger, $rules, "$rule_description: Parameter $param_label is undefined, but must be at least $rule_value character" . ($rule_value == 1 ? '' : 's'));

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
NUM_BOUNDARY_1676_154_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 1677: 								$invalid_args{$key} = 1;
 1678: 							}
 1679: 							next;
 1680: 						}
 1681: 						if(defined(my $len = _number_of_characters($value))) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1682: 							if($len < $rule_value) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1683: 								_rule_error($logger, $rules, "$rule_description: Parameter $param_label too short, ($len characters), must be at least $rule_value characters");
 1684: 								$invalid_args{$key} = 1;
 1685: 							}
 1686: 						} else {
 1687: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label can't be decoded");
 1688: 							$invalid_args{$key} = 1;
 1689: 						}
 1690: 					} elsif($type eq 'arrayref') {
 1691: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1692: 							if($rule_value > 0 && !$is_optional) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1693: 								_rule_error($logger, $rules, "$rule_description: Parameter $param_label is undefined, but must have at least $rule_value member" . ($rule_value > 1 ? 's' : ''));

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1693_153_<: Numeric boundary flip > to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1693_153_>=: Numeric boundary flip > to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1693_153_<=: Numeric boundary flip > to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 1694: 								$invalid_args{$key} = 1;
 1695: 							}
 1696: 							next;
 1697: 						}
 1698: 						if(scalar(@{$value}) < $rule_value) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1699: 						_rule_error($logger, $rules, "$rule_description: Parameter $param_label must have at least $rule_value member" . (($rule_value > 1) ? 's' : ''));

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1699_134_<: Numeric boundary flip > to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1699_134_>=: Numeric boundary flip > to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1699_134_<=: Numeric boundary flip > to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 1700: 						$invalid_args{$key} = 1;
 1701: 					}
 1702: 					} elsif($type eq 'hashref') {
 1703: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1704: 							if($rule_value > 0 && !$is_optional) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1705: 								_rule_error($logger, $rules, "$rule_description: Parameter $param_label is undefined, but must contain at least $rule_value keys");
 1706: 								$invalid_args{$key} = 1;
 1707: 							}
 1708: 							next;
 1709: 						}
 1710: 						if(scalar(keys(%{$value})) < $rule_value) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1711: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must contain at least $rule_value keys");
 1712: 							$invalid_args{$key} = 1;
 1713: 						}
 1714: 					} elsif(($type eq 'integer') || ($type eq 'number') || ($type eq 'float')) {
 1715: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1716: 							if($rule_value > 0 && !$is_optional) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1717: 								_rule_error($logger, $rules, "$rule_description: Parameter $param_label is undefined, but must be at least $rule_value");
 1718: 								$invalid_args{$key} = 1;
 1719: 							}
 1720: 							next;
 1721: 						}
 1722: 						if(Scalar::Util::looks_like_number($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1723: 							if($value < $rule_value) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1724: 								if($rules->{'error_msg'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1725: 									_error($logger, $rules->{'error_msg'});
 1726: 								} elsif(($type eq 'integer') && ($value == 0)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1727: 									_error($logger, "$rule_description: Parameter $param_label ($value) must be a positive number");
 1728: 								} elsif(($type eq 'integer') && ($value == 1)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1729: 									_error($logger, "$rule_description: Parameter $param_label ($value) must be a positive, non-zero number");
 1730: 								} else {
 1731: 									_error($logger, "$rule_description: Parameter $param_label ($value) must be at least $rule_value");
 1732: 								}
 1733: 								$invalid_args{$key} = 1;
 1734: 								next;
 1735: 							}
 1736: 						} else {
 1737: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label ($value) must be a number");
 1738: 							next;
 1739: 						}
 1740: 					} else {
 1741: 						_error($logger, "$rule_description: Parameter $param_label of type '$type' has meaningless min value $rule_value");
 1742: 					}
 1743: 				} elsif($rule_name eq 'max') {
 1744: 					if(!defined($rules->{'type'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1745: 						_error($logger, "$rule_description: Don't know type of $param_label to determine its maximum value $rule_value");
 1746: 					}
 1747: 					my $type = lc($rules->{'type'});
 1748: 					if(exists($custom_types->{$type}->{'max'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1749: 						$rule_value = $custom_types->{$type}->{'max'};
 1750: 						$type = $custom_types->{$type}->{'type'};
 1751: 					}
 1752: 					if(($type eq 'string') || ($type eq 'str') || ($type eq 'stringref')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1753: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1754: 							next;	# Skip if string is undefined
 1755: 						}
 1756: 						if(defined(my $len = _number_of_characters($value))) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1757: 							if($len > $rule_value) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1758: 								_rule_error($logger, $rules, "$rule_description: Parameter $param_label too long, ($len characters), must be no longer than $rule_value");
 1759: 								$invalid_args{$key} = 1;
 1760: 							}
 1761: 						} else {
 1762: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label can't be decoded");
 1763: 							$invalid_args{$key} = 1;
 1764: 						}
 1765: 					} elsif($type eq 'arrayref') {
 1766: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1767: 							next;	# Skip if string is undefined
 1768: 						}
 1769: 						if(scalar(@{$value}) > $rule_value) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1770: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must contain no more than $rule_value items");
 1771: 							$invalid_args{$key} = 1;
 1772: 						}
 1773: 					} elsif($type eq 'hashref') {
 1774: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1775: 							next;	# Skip if hash is undefined
 1776: 						}
 1777: 						if(scalar(keys(%{$value})) > $rule_value) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1778: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label must contain no more than $rule_value keys");
 1779: 							$invalid_args{$key} = 1;
 1780: 						}
 1781: 					} elsif(($type eq 'integer') || ($type eq 'number') || ($type eq 'float')) {
 1782: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1783: 							next;	# Skip if hash is undefined
 1784: 						}
 1785: 						if(Scalar::Util::looks_like_number($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1786: 							if($value > $rule_value) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1787: 								if($rules->{'error_msg'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1788: 									_error($logger, $rules->{'error_msg'});
 1789: 								} elsif(($type eq 'integer') && ($value == 0)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1790: 									_error($logger, "$rule_description: Parameter $param_label ($value) must be a negative number");
 1791: 								} elsif(($type eq 'integer') && ($value == -1)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1792: 									_error($logger, "$rule_description: Parameter $param_label ($value) must be a negative, non-zero number");
 1793: 								} else {
 1794: 									_error($logger, "$rule_description: Parameter $param_label ($value) must be no more than $rule_value");
 1795: 								}
 1796: 								$invalid_args{$key} = 1;
 1797: 								next;
 1798: 							}
 1799: 						} else {
 1800: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label ($value) must be a number");
 1801: 							next;
 1802: 						}
 1803: 					} else {
 1804: 						_error($logger, "$rule_description: Parameter $param_label of type '$type' has meaningless max value $rule_value");
 1805: 					}
 1806: 				} elsif(($rule_name eq 'matches') || ($rule_name eq 'regex')) {
 1807: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1808: 						next;	# Skip if string is undefined
 1809: 					}
 1810: 					eval {
 1811: 						my $re = (ref($rule_value) eq 'Regexp') ? $rule_value : qr/\Q$rule_value\E/;
 1812: 						if(($rules->{'type'} eq 'arrayref') || ($rules->{'type'} eq 'ArrayRef')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1813: 							# all{} short-circuits on first failure and allocates no temp array
 1814: 							unless(all { $_ =~ $re } @{$value}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1815: 								_rule_error($logger, $rules, "$rule_description: All members of parameter $param_label [", join(', ', @{$value}), "] must match pattern '$rule_value'");
 1816: 							}
 1817: 						} elsif($value !~ $re) {
 1818: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label ($value) must match pattern '$re'");
 1819: 						}
 1820: 						1;
 1821: 					};
 1822: 					if($@) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1823: 						_rule_error($logger, $rules, "$rule_description: Parameter $param_label regex '$rule_value' error: $@");
 1824: 						$invalid_args{$key} = 1;
 1825: 					}
 1826: 				} elsif($rule_name eq 'nomatch') {
 1827: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1828: 						next;	# Skip if string is undefined
 1829: 					}
 1830: 					# Compile string patterns with \Q...\E so metacharacters are
 1831: 					# treated as literals, matching the behaviour of 'matches'.
 1832: 					my $re = (ref($rule_value) eq 'Regexp') ? $rule_value : qr/\Q$rule_value\E/;
 1833: 					eval {
 1834: 						if(($rules->{'type'} eq 'arrayref') || ($rules->{'type'} eq 'ArrayRef')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1835: 							# any{} short-circuits on first match and allocates no temp array
 1836: 							if(any { $_ =~ $re } @{$value}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1837: 								_rule_error($logger, $rules, "$rule_description: No member of parameter $param_label [", join(', ', @{$value}), "] must match pattern '$rule_value'");
 1838: 							}
 1839: 						} elsif($value =~ $re) {
 1840: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label ($value) must not match pattern '$rule_value'");
 1841: 							$invalid_args{$key} = 1;
 1842: 						}
 1843: 						1;
 1844: 					};
 1845: 					if($@) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1846: 						_rule_error($logger, $rules, "$rule_description: Parameter $param_label regex '$rule_value' error: $@");
 1847: 						$invalid_args{$key} = 1;
 1848: 					}
 1849: 				} elsif($rule_name eq 'bnf') {
 1850: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1851: 						next;	# Skip if value is undefined
 1852: 					}
 1853: 					if(ref($rule_value) ne 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1854: 						_error($logger, "$rule_description: Parameter $param_label 'bnf' rule must be an arrayref of grammar lines");
 1855: 					}
 1856: 					require Params::Validate::Strict::BNF;
 1857: 					my $matcher = Params::Validate::Strict::BNF::bnf_to_matcher($rule_value);
 1858: 					unless($matcher->($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1859: 						_rule_error($logger, $rules, "$rule_description: Parameter $param_label ($value) does not match the BNF grammar");
 1860: 						$invalid_args{$key} = 1;
 1861: 					}
 1862: 				} elsif(($rule_name eq 'memberof') || ($rule_name eq 'enum') || ($rule_name eq 'values')) {
 1863: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1864: 						next;	# Skip if string is undefined
 1865: 					}
 1866: 					if(ref($rule_value) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1867: 						unless(_value_in_list($value, $rule_value, $rules->{'type'} // '', $rules->{'case_sensitive'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1868: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label ($value) must be one of ", join(', ', @{$rule_value}));
 1869: 							$invalid_args{$key} = 1;
 1870: 						}
 1871: 					} else {
 1872: 						_rule_error($logger, $rules, "$rule_description: Parameter $param_label rule ($rule_value) must be an array reference");
 1873: 					}
 1874: 				} elsif($rule_name eq 'notmemberof') {
 1875: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1876: 						next;	# Skip if string is undefined
 1877: 					}
 1878: 					if(ref($rule_value) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1879: 						if(_value_in_list($value, $rule_value, $rules->{'type'} // '', $rules->{'case_sensitive'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1880: 							_rule_error($logger, $rules, "$rule_description: Parameter $param_label ($value) must not be one of ", join(', ', @{$rule_value}));
 1881: 							$invalid_args{$key} = 1;
 1882: 						}
 1883: 					} else {
 1884: 						_rule_error($logger, $rules, "$rule_description: Parameter $param_label rule ($rule_value) must be an array reference");
 1885: 					}
 1886: 				} elsif($rule_name eq 'isa') {
 1887: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1888: 						next;	# Skip if object not given
 1889: 					}
 1890: 					if($rules->{'type'} eq 'object') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1891: 						if(!$value->isa($rule_value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1892: 							_error($logger, "$rule_description: Parameter $param_label must be a '$rule_value' object got a " . (ref($value) ? ref($value) : $value) . ' object instead');
 1893: 							$invalid_args{$key} = 1;
 1894: 						}
 1895: 					} else {
 1896: 						_error($logger, "$rule_description: Parameter $param_label has meaningless isa value $rule_value");
 1897: 					}
 1898: 				} elsif($rule_name eq 'can') {
 1899: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1900: 						next;	# Skip if object not given
 1901: 					}
 1902: 					if($rules->{'type'} eq 'object') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1903: 						if(ref($rule_value) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1904: 							# List of methods
 1905: 							foreach my $method(@{$rule_value}) {
 1906: 								if(!$value->can($method)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1907: 									_error($logger, "$rule_description: Parameter $param_label must be an object that understands the $method method");
 1908: 									$invalid_args{$key} = 1;
 1909: 								}
 1910: 							}
 1911: 						} elsif(!ref($rule_value)) {
 1912: 							if(!$value->can($rule_value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1913: 								_error($logger, "$rule_description: Parameter $param_label must be an object that understands the $rule_value method");
 1914: 								$invalid_args{$key} = 1;
 1915: 							}
 1916: 						} else {
 1917: 							_error($logger, "$rule_description: 'can' rule for Parameter $param_label must be either a scalar or an arrayref");
 1918: 						}
 1919: 					} else {
 1920: 						_error($logger, "$rule_description: Parameter $param_label has meaningless can value '$rule_value' for parameter type $rules->{type}");
 1921: 					}
 1922: 				} elsif($rule_name eq 'does') {
 1923: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1924: 						next;	# Skip if object not given
 1925: 					}
 1926: 					if($rules->{'type'} eq 'object') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1927: 						unless(Scalar::Util::blessed($value) && $value->DOES($rule_value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1928: 							_error($logger, "$rule_description: Parameter $param_label must be an object that does '$rule_value'");
 1929: 							$invalid_args{$key} = 1;
 1930: 						}
 1931: 					} else {
 1932: 						_error($logger, "$rule_description: Parameter $param_label has meaningless does value '$rule_value' for parameter type $rules->{type}");
 1933: 					}
 1934: 				} elsif($rule_name eq 'classisa') {
 1935: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1936: 						next;
 1937: 					}
 1938: 					unless(!ref($value) && $value =~ /\A[A-Za-z_]\w*(?:::[A-Za-z_]\w*)*\z/ && $value->isa($rule_value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1939: 						_error($logger, "$rule_description: Parameter $param_label ($value) must be a class that isa '$rule_value'");
 1940: 						$invalid_args{$key} = 1;
 1941: 					}
 1942: 				} elsif($rule_name eq 'subclass') {
 1943: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1944: 						next;
 1945: 					}
 1946: 					unless(!ref($value) && $value =~ /\A[A-Za-z_]\w*(?:::[A-Za-z_]\w*)*\z/
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1947: 						&& $value ne $rule_value && $value->isa($rule_value)) {
 1948: 						_error($logger, "$rule_description: Parameter $param_label ($value) must be a strict subclass of '$rule_value'");
 1949: 						$invalid_args{$key} = 1;
 1950: 					}
 1951: 				} elsif($rule_name eq 'classdoes') {
 1952: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1953: 						next;
 1954: 					}
 1955: 					unless(!ref($value) && $value =~ /\A[A-Za-z_]\w*(?:::[A-Za-z_]\w*)*\z/ && $value->DOES($rule_value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1956: 						_error($logger, "$rule_description: Parameter $param_label ($value) must be a class that does '$rule_value'");
 1957: 						$invalid_args{$key} = 1;
 1958: 					}
 1959: 				} elsif($rule_name eq 'driver') {
 1960: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1961: 						next;
 1962: 					}
 1963: 					unless(!ref($value) && $value =~ /\A[A-Za-z_]\w*(?:::[A-Za-z_]\w*)*\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1964: 						_error($logger, "$rule_description: Parameter $param_label must be a valid class name");
 1965: 						$invalid_args{$key} = 1;
 1966: 						next;
 1967: 					}
 1968: 					(my $file = $value) =~ s{::}{/}g;
 1969: 					$file .= '.pm';
 1970: 					eval { require $file };
 1971: 					if($@) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1972: 						_error($logger, "$rule_description: Parameter $param_label ($value) could not be loaded: $@");
 1973: 						$invalid_args{$key} = 1;
 1974: 						next;
 1975: 					}
 1976: 					unless($value->isa($rule_value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1977: 						_error($logger, "$rule_description: Parameter $param_label ($value) must be a class that isa '$rule_value'");
 1978: 						$invalid_args{$key} = 1;
 1979: 					}
 1980: 				} elsif($rule_name eq 'element_type') {
 1981: 					if(($rules->{'type'} eq 'arrayref') || ($rules->{'type'} eq 'ArrayRef')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1982: 						my $type = $rule_value;
 1983: 						my $custom_type = $custom_types->{$rule_value};
 1984: 						if($custom_type && $custom_type->{'type'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1985: 							$type = $custom_type->{'type'};
 1986: 						}
 1987: 						foreach my $member(@{$value}) {
 1988: 							if($custom_type && $custom_type->{'transform'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1989: 								# The custom type has a transform embedded within it
 1990: 								if(ref($custom_type->{'transform'}) eq 'CODE') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1991: 									$member = &{$custom_type->{'transform'}}($member);
 1992: 								} else {
 1993: 									_error($logger, "$rule_description: transforms must be a code ref");
 1994: 								}
 1995: 							}
 1996: 							if(($type eq 'string') || ($type eq 'Str')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1997: 								if(ref($member)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1998: 									_rule_error($logger, $rules, "$param_label can only contain strings");
 1999: 									$invalid_args{$key} = 1;
 2000: 								}
 2001: 							} elsif($type eq 'integer') {
 2002: 								if(ref($member) || ($member =~ /\D/)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2003: 									_rule_error($logger, $rules, "$param_label can only contain integers (found $member)");
 2004: 									$invalid_args{$key} = 1;
 2005: 								}
 2006: 							} elsif(($type eq 'number') || ($rule_value eq 'float')) {
 2007: 								if(ref($member) || ($member !~ /^[-+]?(?:\d+(?:\.\d*)?|\.\d+)$/)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2008: 									_rule_error($logger, $rules, "$param_label can only contain numbers (found $member)");
 2009: 									$invalid_args{$key} = 1;
 2010: 								}
 2011: 							} elsif($type eq 'object') {
 2012: 								if(!Scalar::Util::blessed($member)) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2012_9: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2013: 									_rule_error($logger, $rules, "$param_label can only contain objects (found $member)");
 2014: 									$invalid_args{$key} = 1;
 2015: 								}
 2016: 							} else {
 2017: 								_error($logger, "BUG: Add $type to element_type list");
 2018: 							}
 2019: 						}
 2020: 					} else {
 2021: 						_error($logger, "$rule_description: Parameter $param_label has meaningless element_type value $rule_value");
 2022: 					}
 2023: 				} elsif($rule_name eq 'optional') {
 2024: 					# Already handled at the beginning of the loop
 2025: 				} elsif($rule_name eq 'nullable') {
 2026: 					# Already handled at the beginning of the loop (same as optional)
 2027: 				} elsif($rule_name eq 'default') {
 2028: 					# Handled earlier
 2029: 				} elsif($rule_name eq 'error_msg') {
 2030: 					# Handled inline
 2031: 				} elsif($rule_name eq 'transform') {
 2032: 					# Handled before the loop
 2033: 				} elsif($rule_name eq 'case_sensitive') {
 2034: 					# Handled inline
 2035: 				} elsif($rule_name eq 'description') {
 2036: 					# A la, Data::Processor
 2037: 				} elsif($rule_name =~ /^_/) {
 2038: 					# Ignore internal/metadata fields from schema extraction
 2039: 				} elsif($rule_name eq 'semantic') {
 2040: 					if($rule_value eq 'unix_timestamp') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2041: 						if($value < 0 || $value > 2147483647) {
  Mutants (Total: 7, Killed: 7, Survived: 0)
 2042: 							_error($logger, "Invalid Unix timestamp: $value");
 2043: 						}
 2044: 					} elsif($rule_value eq 'identifier') {
 2045: 						if(defined($value) && $value !~ /\A[A-Za-z_]\w*\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2046: 							_error($logger, "Invalid Perl identifier: $value");
 2047: 						}
 2048: 					} elsif($rule_value eq 'class_name') {
 2049: 						if(defined($value) && $value !~ /\A[A-Za-z_]\w*(?:::[A-Za-z_]\w*)*\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2050: 							_error($logger, "Invalid Perl class name: $value");
 2051: 						}
 2052: 					} else {
 2053: 						_warn($logger, "semantic type $rule_value is not yet supported");
 2054: 					}
 2055: 				} elsif($rule_name eq 'schema') {
 2056: 					# Nested schema Run the given schema against each element of the array
 2057: 					if(($rules->{'type'} eq 'arrayref') || ($rules->{'type'} eq 'ArrayRef')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2058: 						if(ref($value) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2059: 							foreach my $member(@{$value}) {
 2060: 								# Distinguish two schema forms:
 2061: 								# (a) Rule hash   — has a top-level 'type' key, e.g. { type=>'string', matches=>qr/.../ }
 2062: 								#     => validate each element against that rule directly.
 2063: 								# (b) Field-schema hash — keys are field names whose values are rule hashes,
 2064: 								#     e.g. { name=>{type=>'string'}, age=>{type=>'integer'} }
 2065: 								#     => validate each hashref element against the field schema directly.
 2066: 								my $is_field_schema = (ref($rule_value) eq 'HASH') && !exists($rule_value->{'type'});
 2067: 								my %inner = (custom_types => $custom_types);
 2068: 								if($is_field_schema) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2069: 									$inner{input}  = $member;
 2070: 									$inner{schema} = $rule_value;
 2071: 								} else {
 2072: 									$inner{input}  = { $key => $member };
 2073: 									$inner{schema} = { $key => $rule_value };
 2074: 								}
 2075: 								if(!validate_strict(\%inner)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2076: 									$invalid_args{$key} = 1;
 2077: 								}
 2078: 							}
 2079: 						} elsif(defined($value)) {	# Allow undef for optional values
 2080: 							_error($logger, "$rule_description: nested schema: Parameter '$value' must be an arrayref");
 2081: 						}
 2082: 					} elsif($rules->{'type'} eq 'hashref') {
 2083: 						if(ref($rule_value) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2084: 							# Apply nested defaults before validation
 2085: 							my $nested_with_defaults = _apply_nested_defaults($value, $rule_value);
 2086: 							if(scalar keys(%{$nested_with_defaults})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2087: 								if(my $new_args = validate_strict({ input => $nested_with_defaults, schema => $rule_value, custom_types => $custom_types })) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2088: 									$value = $new_args;
 2089: 								} else {
 2090: 									$invalid_args{$key} = 1;
 2091: 								}
 2092: 							}
 2093: 						} else {
 2094: 							_error($logger, "$rule_description: nested schema: Parameter '$value' must be an hashref");
 2095: 						}
 2096: 					} else {
 2097: 						_error($logger, "$rule_description: Parameter $param_label: 'schema' only supports arrayref and hashref, not $rules->{type}");
 2098: 					}
 2099: 				} elsif(($rule_name eq 'validate') || ($rule_name eq 'validator')) {
 2100: 					if(ref($rule_value) eq 'CODE') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2101: 						if(my $error = &{$rule_value}($args)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2102: 							_error($logger, "$rule_description: $param_label not valid: $error");
 2103: 							$invalid_args{$key} = 1;
 2104: 						}
 2105: 					} else {
 2106: 						# _error($logger, "$rule_description: Parameter $param_label: 'validate' only supports coderef, not $value");
 2107: 						_error($logger, "$rule_description: Parameter $param_label: 'validate' only supports coderef, not " . ref($rule_value) // $rule_value);
 2108: 					}
 2109: 				} elsif ($rule_name eq 'callback') {
 2110: 					# Custom validation code
 2111: 					unless (defined &$rule_value) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2112: 						_error($logger, "$rule_description: callback for $param_label must be a code reference");
 2113: 					}
 2114: 					my $res = $rule_value->($value, $args, $schema);
 2115: 					unless ($res) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2116: 						_rule_error($logger, $rules, "$rule_description: Parameter $param_label failed custom validation");
 2117: 						$invalid_args{$key} = 1;
 2118: 					}
 2119: 				} elsif($rule_name eq 'position') {
 2120: 					if($rule_value < 0) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 2121: 						_error($logger, "$rule_description: Parameter $param_label: 'position' must be a positive integer, not $value");
 2122: 					}
 2123: 					if($rule_value =~ /\D/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2124: 						_error($logger, "$rule_description: Parameter $param_label: 'position' must be a positive integer");
 2125: 					}
 2126: 				} elsif($rule_name eq 'slurp') {
 2127: 					if($rule_value && $are_positional_args != 1) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2128: 						_error($logger, "$rule_description: Parameter $param_label: 'slurp' is only valid in positional-argument schemas (all parameters need a 'position')");
 2129: 					}
 2130: 					# Pre-processed: value was already collected as arrayref of remaining positional args
 2131: 				} elsif($rule_name eq 'aliases') {
 2132: 					# Pre-processed: alternative input-key names resolved during value fetch
 2133: 				} else {
 2134: 					_error($logger, "$rule_description: Unknown rule '$rule_name'");
 2135: 				}
 2136: 			}
 2137: 		} elsif(ref($rules) eq 'ARRAY') {
 2138: 			if(scalar(@{$rules})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2139: 				# An argument can be one of several different types.
 2140: 				# This path handles both explicit array-of-rules schemas and the
 2141: 				# normalised form of union type shorthand (type => ['a', 'b', ...]).
 2142: 				my $rc = 0;
 2143: 				my @types;
 2144: 				foreach my $rule(@{$rules}) {
 2145: 					if(ref($rule) ne 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2146: 						_error($logger, "$rule_description: Parameter $param_label rules must be a hash reference");
 2147: 					}
 2148: 					if(!defined($rule->{'type'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2149: 						_error($logger, "$rule_description: Parameter $param_label is missing a type in an alternative");
 2150: 					}
 2151: 					push @types, $rule->{'type'};
 2152: 					my $result;
 2153: 					eval {
 2154: 						$result = validate_strict({ input => { $key => $value }, schema => { $key => $rule }, logger => undef, custom_types => $custom_types });
 2155: 					};
 2156: 					if(!$@) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2157: 						# Capture coercion performed by the successful sub-validation
 2158: 						# (e.g. integer/number coercion) so the outer scope sees it.
 2159: 						$value = $result->{$key} if(defined($result));
 2160: 						$rc = 1;
 2161: 						last;
 2162: 					}
 2163: 				}
 2164: 				if(!$rc) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2165: 					_error($logger, "$rule_description: Parameter $param_label must be one of " . join(', ', @types));
 2166: 					$invalid_args{$key} = 1;
 2167: 				}
 2168: 			} else {
 2169: 				_error($logger, "$rule_description: Parameter $param_label schema is empty arrayref");
 2170: 			}
 2171: 		} elsif(ref($rules)) {
 2172: 			_error($logger, 'rules must be a hash reference or string');
 2173: 		}
 2174: 
 2175: 		$validated_args{$key} = $value;
 2176: 	}
 2177: 
 2178: 	# Validate parameter relationships
●2179 → 2179 → 2183 2179: 	if (my $relationships = $params->{'relationships'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2180: 		_validate_relationships(\%validated_args, $relationships, $logger, $schema_description);
 2181: 	}
 2182: 
●2183 → 2183 → 2198 2183: 	if(my $cross_validation = $params->{'cross_validation'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2184: 		foreach my $validator_name(keys %{$cross_validation}) {
 2185: 			my $validator = $cross_validation->{$validator_name};
 2186: 			if((!ref($validator)) || (ref($validator) ne 'CODE')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2187: 				_error($logger, "$schema_description: cross_validation $validator is not a code snippet");
 2188: 				next;
 2189: 			}
 2190: 			if(my $error = &{$validator}(\%validated_args, $validator)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2191: 				_error($logger, $error);
 2192: 				# We have no idea which parameters are still valid, so let's invalidate them all
 2193: 				return;
 2194: 			}
 2195: 		}
 2196: 	}
 2197: 
●2198 → 2198 → 2202 2198: 	foreach my $key(keys %invalid_args) {
 2199: 		delete $validated_args{$key};
 2200: 	}
 2201: 
●2202 → 2202 → 2219 2202: 	if($are_positional_args == 1) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2203: 		my @rc;
 2204: 		foreach my $key (keys %{$schema}) {
 2205: 			# Use exists() rather than if(my $value = ...) so that falsy but
 2206: 			# valid coerced values (integer 0, empty string, undef from an
 2207: 			# absent optional) are not silently dropped from the return array.
 2208: 			if(exists $validated_args{$key}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2209: 				my $value = delete $validated_args{$key};
 2210: 				my $position = $schema->{$key}->{'position'};
 2211: 				if(defined($rc[$position])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2212: 					_error($logger, "$schema_description: $key: position $position appears twice");
 2213: 				}
 2214: 				$rc[$position] = $value;
 2215: 			}
 2216: 		}
 2217: 		return \@rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2218: 	}
 2219: 	return \%validated_args;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2220: }
 2221: 
 2222: =head2 compile_schema
 2223: 
 2224:   my $validator = compile_schema(\%schema);
 2225:   my $result    = $validator->(\%input);
 2226: 
 2227:   # with optional keyword args
 2228:   my $validator = compile_schema(\%schema,
 2229:       description            => 'User registration',
 2230:       custom_types           => \%types,
 2231:       unknown_parameter_handler => 'warn',
 2232:   );
 2233: 
 2234: Pre-captures a schema (and any optional keyword arguments accepted by
 2235: C<validate_strict>) into a reusable validator closure.  Calling the returned
 2236: coderef is equivalent to:
 2237: 
 2238:   validate_strict(schema => \%schema, input => \%input, %opts);
 2239: 
 2240: but avoids the overhead of argument parsing on every call - useful when the
 2241: same schema is applied repeatedly in a hot path.
 2242: 
 2243: =head3 Arguments
 2244: 
 2245: =over 4
 2246: 
 2247: =item * C<\%schema> (required)
 2248: 
 2249: The validation schema as a hashref or arrayref, identical to the C<schema>
 2250: argument of C<validate_strict>.
 2251: 
 2252: =item * C<%opts> (optional)
 2253: 
 2254: Any keyword arguments accepted by C<validate_strict> other than C<schema>
 2255: and C<input>: C<description>, C<custom_types>,
 2256: C<unknown_parameter_handler>, C<logger>, C<relationships>,
 2257: C<cross_validation>, etc.
 2258: 
 2259: =back
 2260: 
 2261: =head3 Returns
 2262: 
 2263: A code reference C<sub ($input) -E<gt> \%validated>.
 2264: 
 2265: =cut
 2266: 
 2267: sub compile_schema
 2268: {
●2269 → 2270 → 2273 2269: 	my ($schema, %opts) = @_;
 2270: 	unless(ref($schema) eq 'HASH' || ref($schema) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2271: 		Carp::croak('compile_schema: schema must be a hash or array reference');
 2272: 	}
 2273: 	return sub {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2274: 		my $input = shift;
 2275: 		return validate_strict(schema => $schema, input => $input, %opts);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2276: 	};
 2277: }
 2278: 
 2279: # _schema_from_arrayref($arrayref, $logger)
 2280: #
 2281: # Normalise an arrayref schema:
 2282: #   [ { name => 'param', type => 'string', ... }, ... ]
 2283: # to the standard named-parameter hashref form:
 2284: #   { param => { type => 'string', ... }, ... }
 2285: #
 2286: # The 'name' key is consumed during conversion and does not become a rule.
 2287: # Croaks if any element is not a hashref, is missing 'name', or if a name
 2288: # appears more than once.
 2289: sub _schema_from_arrayref
 2290: {
●2291 → 2294 → 2305 2291: 	my ($arrayref, $logger) = @_;
 2292: 
 2293: 	my %schema;
 2294: 	foreach my $spec (@{$arrayref}) {
 2295: 		_error($logger, "validate_strict: each arrayref schema element must be a hashref")
 2296: 			unless ref($spec) eq 'HASH';
 2297: 		_error($logger, "validate_strict: arrayref schema element must have a 'name' key")
 2298: 			unless exists($spec->{'name'});
 2299: 		my %rule = %{$spec};
 2300: 		my $name = delete $rule{'name'};
 2301: 		_error($logger, "validate_strict: duplicate parameter '$name' in arrayref schema")
 2302: 			if exists($schema{$name});
 2303: 		$schema{$name} = \%rule;
 2304: 	}
 2305: 	return \%schema;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2306: }
 2307: 
 2308: # Return number of visible characters not number of bytes
 2309: # Ensure string is decoded into Perl characters
 2310: sub _number_of_characters
 2311: {
●2312 → 2316 → 2320 2312: 	my $value = $_[0];
 2313: 
 2314: 	return if(!defined($value));
 2315: 
 2316: 	if($value !~ /[^[:ascii:]]/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2317: 		return length($value);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2318: 	}
 2319: 	# Decode only if it's not already a Perl character string
 2320: 	$value = decode_utf8($value) unless utf8::is_utf8($value);
 2321: 
 2322: 	# Count grapheme clusters (visible characters).
 2323: 	# \X matches one extended grapheme cluster; Perl's Unicode tables are kept
 2324: 	# current with each release, correctly handling ZWJ sequences and emoji
 2325: 	# modifier sequences that Unicode::GCString 2013.10 could not.
 2326: 	return scalar(() = $value =~ /\X/g);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2327: }
 2328: 
 2329: sub _apply_nested_defaults {
●2330 → 2333 → 2346 2330: 	my ($input, $schema) = @_;
 2331: 	my %result = %$input;
 2332: 
 2333: 	foreach my $key (keys %$schema) {
 2334: 		my $rules = $schema->{$key};
 2335: 
 2336: 		if (ref $rules eq 'HASH' && exists $rules->{default} && !exists $result{$key}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2337: 			$result{$key} //= $rules->{default};
 2338: 		}
 2339: 
 2340: 		# Recursively handle nested schema
 2341: 		if((ref $rules eq 'HASH') && $rules->{schema} && (ref $result{$key} eq 'HASH')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2342: 			$result{$key} = _apply_nested_defaults($result{$key}, $rules->{schema});
 2343: 		}
 2344: 	}
 2345: 
 2346: 	return \%result;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2347: }
 2348: 
 2349: sub _validate_relationships {
●2350 → 2354 → 0 2350: 	my ($validated_args, $relationships, $logger, $description) = @_;
 2351: 
 2352: 	return unless ref($relationships) eq 'ARRAY';
 2353: 
 2354: 	foreach my $rel (@$relationships) {
 2355: 		my $type = $rel->{type} or next;
 2356: 
 2357: 		if ($type eq 'mutually_exclusive') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2358: 			_validate_mutually_exclusive($validated_args, $rel, $logger, $description);
 2359: 		} elsif ($type eq 'required_group') {
 2360: 			_validate_required_group($validated_args, $rel, $logger, $description);
 2361: 		} elsif ($type eq 'conditional_requirement') {
 2362: 			_validate_conditional_requirement($validated_args, $rel, $logger, $description);
 2363: 		} elsif ($type eq 'dependency') {
 2364: 			_validate_dependency($validated_args, $rel, $logger, $description);
 2365: 		} elsif ($type eq 'value_constraint') {
 2366: 			_validate_value_constraint($validated_args, $rel, $logger, $description);
 2367: 		} elsif ($type eq 'value_conditional') {
 2368: 			_validate_value_conditional($validated_args, $rel, $logger, $description);
 2369: 		} else {
 2370: 			_error($logger, "Unknown relationship type $type");
 2371: 		}
 2372: 	}
 2373: }
 2374: 
 2375: sub _validate_mutually_exclusive {
●2376 → 2383 → 0 2376: 	my ($args, $rel, $logger, $description) = @_;
 2377: 
 2378: 	my @params = @{$rel->{params} || []};
 2379: 	return unless @params >= 2;
  Mutants (Total: 3, Killed: 3, Survived: 0)
 2380: 
 2381: 	my @present = grep { _param_defined($args, $_) } @params;
 2382: 
 2383: 	if (@present > 1) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 2384: 		my $msg = $rel->{description} || 'Cannot specify both ' . join(' and ', @present);
 2385: 		_error($logger, "$description: $msg");
 2386: 	}
 2387: }
 2388: 
 2389: sub _validate_required_group {
●2390 → 2397 → 0 2390: 	my ($args, $rel, $logger, $description) = @_;
 2391: 
 2392: 	my @params = @{$rel->{params} || []};
 2393: 	return unless @params >= 2;
  Mutants (Total: 3, Killed: 3, Survived: 0)
 2394: 
 2395: 	my @present = grep { _param_defined($args, $_) } @params;
 2396: 
 2397: 	if (@present == 0) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2398: 		my $msg = $rel->{description} ||
 2399: 			'Must specify at least one of: ' . join(', ', @params);
 2400: 		_error($logger, "$description: $msg");
 2401: 	}
 2402: }
 2403: 
 2404: sub _validate_conditional_requirement {
●2405 → 2411 → 0 2405: 	my ($args, $rel, $logger, $description) = @_;
 2406: 
 2407: 	my $if_param = $rel->{if} or return;
 2408: 	my $then_param = $rel->{then_required} or return;
 2409: 
 2410: 	# If the condition parameter is present and defined
 2411: 	if (_param_defined($args, $if_param)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2412: 		# Check if it's truthy (for booleans and general values)
 2413: 		if ($args->{$if_param}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2414: 			# Then the required parameter must also be present
 2415: 			unless (_param_defined($args, $then_param)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2416: 				my $msg = $rel->{description} || "When $if_param is specified, $then_param is required";
 2417: 				_error($logger, "$description: $msg");
 2418: 			}
 2419: 		}
 2420: 	}
 2421: }
 2422: 
 2423: sub _validate_dependency {
●2424 → 2430 → 0 2424: 	my ($args, $rel, $logger, $description) = @_;
 2425: 
 2426: 	my $param = $rel->{param} or return;
 2427: 	my $requires = $rel->{requires} or return;
 2428: 
 2429: 	# If param is present, requires must also be present
 2430: 	if (_param_defined($args, $param)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2431: 		unless (_param_defined($args, $requires)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2432: 			my $msg = $rel->{description} || "$param requires $requires to be specified";
 2433: 			_error($logger, "$description: $msg");
 2434: 		}
 2435: 	}
 2436: }
 2437: 
 2438: sub _validate_value_constraint {
●2439 → 2448 → 0 2439: 	my ($args, $rel, $logger, $description) = @_;
 2440: 
 2441: 	my $if_param = $rel->{if} or return;
 2442: 	my $then_param = $rel->{then} or return;
 2443: 	my $operator = $rel->{operator} or return;
 2444: 	my $value = $rel->{value};
 2445: 	return unless defined $value;
 2446: 
 2447: 	# If the condition parameter is present and truthy
 2448: 	if (_param_defined($args, $if_param) && $args->{$if_param}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2449: 		# Check if the then parameter exists
 2450: 		if (_param_defined($args, $then_param)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2451: 			my $actual = $args->{$then_param};
 2452: 			my $valid = 0;
 2453: 
 2454: 			if ($operator eq '==') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2455: 				$valid = ($actual == $value);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2456: 			} elsif ($operator eq '!=') {
 2457: 				$valid = ($actual != $value);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2458: 			} elsif ($operator eq '<') {
 2459: 				$valid = ($actual < $value);
  Mutants (Total: 3, Killed: 3, Survived: 0)
 2460: 			} elsif ($operator eq '<=') {
 2461: 				$valid = ($actual <= $value);
  Mutants (Total: 3, Killed: 3, Survived: 0)
 2462: 			} elsif ($operator eq '>') {
 2463: 				$valid = ($actual > $value);
  Mutants (Total: 3, Killed: 3, Survived: 0)
 2464: 			} elsif ($operator eq '>=') {
 2465: 				$valid = ($actual >= $value);
  Mutants (Total: 3, Killed: 3, Survived: 0)
 2466: 			}
 2467: 
 2468: 			unless ($valid) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2469: 				my $msg = $rel->{description} || "When $if_param is specified, $then_param must be $operator $value (got $actual)";
 2470: 				_error($logger, "$description: $msg");
 2471: 			}
 2472: 		}
 2473: 	}
 2474: }
 2475: 
 2476: sub _validate_value_conditional {
●2477 → 2485 → 0 2477: 	my ($args, $rel, $logger, $description) = @_;
 2478: 
 2479: 	my $if_param = $rel->{if} or return;
 2480: 	my $equals = $rel->{equals};
 2481: 	my $then_param = $rel->{then_required} or return;
 2482: 	return unless defined $equals;
 2483: 
 2484: 	# If the parameter has the specific value
 2485: 	if (_param_defined($args, $if_param)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2486: 		if ($args->{$if_param} eq $equals) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2487: 			# Then the required parameter must be present
 2488: 			unless (_param_defined($args, $then_param)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2489: 				my $msg = $rel->{description} ||
 2490: 					"When $if_param equals '$equals', $then_param is required";
 2491: 				_error($logger, "$description: $msg");
 2492: 			}
 2493: 		}
 2494: 	}
 2495: }
 2496: 
 2497: # Emit either the rule's custom error_msg or the supplied default message.
 2498: # Accepts a list for @default_parts so callers can pass join() fragments
 2499: # without pre-allocating a concatenated string.
 2500: sub _rule_error
 2501: {
 2502: 	my ($logger, $rules, @default_parts) = @_;
 2503: 	_error($logger, $rules->{'error_msg'} || join('', @default_parts));
 2504: }
 2505: 
 2506: # Package-level cache: maps "refaddr(list):mode" -> [weak_list_ref, lookup_hash].
 2507: # Each entry holds a WEAK reference to the original list arrayref alongside the
 2508: # compiled lookup hash.  When the list goes out of scope and is freed, the weak
 2509: # reference becomes undef; the next access detects the stale entry and rebuilds,
 2510: # preventing false cache hits after address reuse.
 2511: my %_pvs_memberof_cache;
 2512: 
 2513: # Return true if $value is present in $list, respecting numeric vs string
 2514: # comparison and the case_sensitive flag.  Used by both memberof and notmemberof.
 2515: # On the first call for a given ($list, mode) pair the lookup hash is built
 2516: # (O(k)); subsequent calls with the same live list object are O(1).
 2517: sub _value_in_list
 2518: {
●2519 → 2530 → 2535 2519: 	my ($value, $list, $type, $case_sensitive) = @_;
 2520: 	my $is_numeric = ($type eq 'integer') || ($type eq 'number') || ($type eq 'float');
 2521: 	my $is_icase   = !$is_numeric && defined($case_sensitive) && !$case_sensitive;
 2522: 
 2523: 	# Key combines address and comparison mode so the same list object can be
 2524: 	# cached under multiple modes without collision.
 2525: 	my $ckey = Scalar::Util::refaddr($list) . ($is_numeric ? 'n' : $is_icase ? 'i' : 's');
 2526: 	my $entry = $_pvs_memberof_cache{$ckey};
 2527: 
 2528: 	# Stale check: if the weak ref is dead the list was freed and its address
 2529: 	# may have been reused by a different list — discard the cached hash.
 2530: 	if(defined($entry) && !defined($entry->[0])) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2530_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2531: 		delete $_pvs_memberof_cache{$ckey};
 2532: 		$entry = undef;
 2533: 	}
 2534: 
●2535 → 2535 → 2552 2535: 	unless(defined $entry) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2536: 		my $lookup;
 2537: 		if($is_numeric) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2538: 			# Normalise to numeric value so "1" and "1.0" hash identically.
 2539: 			$lookup = { map { ($_ + 0) => 1 } @{$list} };
 2540: 		} elsif($is_icase) {
 2541: 			$lookup = { map { lc($_) => 1 } @{$list} };
 2542: 		} else {
 2543: 			$lookup = { map { $_ => 1 } @{$list} };
 2544: 		}
 2545: 		# Store [weak_ref_to_list, lookup_hash] — weak ref does not prevent GC.
 2546: 		my $weak = $list;
 2547: 		Scalar::Util::weaken($weak);
 2548: 		$_pvs_memberof_cache{$ckey} = [$weak, $lookup];
 2549: 		$entry = $_pvs_memberof_cache{$ckey};
 2550: 	}
 2551: 
 2552: 	my $lookup = $entry->[1];
 2553: 	return $is_numeric ? exists($lookup->{$value + 0})
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2554: 	     : $is_icase   ? exists($lookup->{lc($value)})
 2555: 	     :               exists($lookup->{$value});
 2556: }
 2557: 
 2558: # Return true when $args->{$param} is both present (exists) and defined.
 2559: sub _param_defined
 2560: {
 2561: 	my ($args, $param) = @_;
 2562: 	return exists($args->{$param}) && defined($args->{$param});
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2563: }
 2564: 
 2565: # Helper to log error or croak
 2566: sub _error
 2567: {
●2568 → 2575 → 2578 2568: 	my $logger = shift;
 2569: 	my $message = join('', @_);
 2570: 	# Strip ASCII control characters to prevent log-injection / CRLF attacks
 2571: 	# when user-supplied values appear in the message.
 2572: 	$message =~ s/[[:cntrl:]]/ /g;
 2573: 
 2574: 	my @call_details = caller(0);
 2575: 	if($logger) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2576: 		$logger->error(__PACKAGE__, ' line ', $call_details[2], ": $message");
 2577: 	}
 2578: 	croak(__PACKAGE__, ' line ', $call_details[2], ": $message");
 2579: }
 2580: 
 2581: # Helper to log warning or carp
 2582: sub _warn
 2583: {
●2584 → 2589 → 0 2584: 	my $logger = shift;
 2585: 	my $message = join('', @_);
 2586: 	# Strip ASCII control characters to prevent log-injection / CRLF attacks.
 2587: 	$message =~ s/[[:cntrl:]]/ /g;
 2588: 
 2589: 	if($logger) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2590: 		$logger->warn(__PACKAGE__, ": $message");
 2591: 	} else {
 2592: 		carp(__PACKAGE__, ": $message");
 2593: 	}
 2594: }
 2595: 
 2596: =head1 AUTHOR
 2597: 
 2598: Nigel Horne, C<< <njh at nigelhorne.com> >>
 2599: 
 2600: =encoding utf-8
 2601: 
 2602: =head1 FORMAL SPECIFICATION
 2603: 
 2604:     [PARAM_NAME, VALUE, TYPE_NAME, CONSTRAINT_VALUE]
 2605: 
 2606:     ValidationRule ::= SimpleType | ComplexRule | UnionType
 2607: 
 2608:     SimpleType ::= string | integer | number | float | boolean | scalar
 2609:                | scalarref | stringref | arrayref | hashref | coderef
 2610:                | object | void | regex | handle
 2611:                | arraylike | hashlike | codelike | invocant
 2612: 
 2613:     UnionType ::= seq SimpleType    -- at least two members; written as type => ['a', 'b']
 2614: 
 2615:     ComplexRule == [
 2616:         type: SimpleType | UnionType;
 2617:         min: ℕ₁;
 2618:         max: ℕ₁;
 2619:         optional: 𝔹;
 2620:         matches: REGEX;
 2621:         regex: REGEX;
 2622:         nomatch: REGEX;
 2623:         memberof: seq VALUE;
 2624:         enum: seq VALUE;
 2625:         values: seq VALUE;
 2626:         notmemberof: seq VALUE;
 2627:         callback: FUNCTION;
 2628:         isa: TYPE_NAME;
 2629:         does: ROLE_NAME;
 2630:         can: METHOD_NAME | seq METHOD_NAME;
 2631:         classisa: TYPE_NAME;
 2632:         subclass: TYPE_NAME;
 2633:         classdoes: ROLE_NAME;
 2634:         driver: TYPE_NAME;
 2635:         semantic: 'unix_timestamp' | 'identifier' | 'class_name';
 2636:         aliases: seq PARAM_NAME;
 2637:         slurp: 𝔹;
 2638:         position: â„•â‚€;
 2639:         default: VALUE;
 2640:         transform: FUNCTION;
 2641:         error_msg: STRING
 2642:     ]
 2643: 
 2644:     Schema == PARAM_NAME ⇸ ValidationRule
 2645: 
 2646:     Arguments == PARAM_NAME ⇸ VALUE
 2647: 
 2648:     ValidatedResult == PARAM_NAME ⇸ VALUE
 2649: 
 2650:     ∀ rule: ComplexRule •
 2651:       rule.min ≤ rule.max ∧
 2652:       ¬((rule.memberof ∨ rule.enum ∨ rule.values) ∧ rule.min) ∧
 2653:       ¬((rule.memberof ∨ rule.enum ∨ rule.values) ∧ rule.max) ∧
 2654:       ¬(rule.notmemberof ∧ rule.min) ∧
 2655:       ¬(rule.notmemberof ∧ rule.max)
 2656: 
 2657:     ∀ schema: Schema; args: Arguments •
 2658:       dom(validate_strict(schema, args)) ⊆ dom(schema) ∪ dom(args)
 2659: 
 2660:     validate_strict: Schema × Arguments → ValidatedResult
 2661: 
 2662:     ∀ schema: Schema; args: Arguments •
 2663:       let result == validate_strict(schema, args) •
 2664:         (∀ name: dom(schema) ∩ dom(args) •
 2665:           name ∈ dom(result) ⇒
 2666:           type_matches(result(name), schema(name))) ∧
 2667:         (∀ name: dom(schema) •
 2668:           ¬optional(schema(name)) ⇒ name ∈ dom(args))
 2669: 
 2670:     type_matches: VALUE × ValidationRule → 𝔹
 2671: 
 2672: =head1 EXAMPLE
 2673: 
 2674:     use Params::Get;
 2675:     use Params::Validate::Strict;
 2676: 
 2677:     sub where_am_i
 2678:     {
 2679:         my $params = Params::Validate::Strict::validate_strict({
 2680:             args => Params::Get::get_params(undef, \@_),
 2681: 	    description => 'Print a string of latitude and longitude',
 2682: 	    error_msg => 'Latitude is a number between +/- 90, longitude is a number between +/- 180',
 2683:             members => {
 2684:                 'latitude' => {
 2685:                     type => 'number',
 2686:                     min => -90,
 2687:                     max => 90
 2688:                 }, 'longitude' => {
 2689:                     type => 'number',
 2690:                     min => -180,
 2691:                     max => 180
 2692:                 }
 2693:             }
 2694:         });
 2695: 
 2696:         print 'You are at ', $params->{'latitude'}, ', ', $params->{'longitude'}, "\n";
 2697:     }
 2698: 
 2699:     where_am_i({ latitude => 3.14, longitude => -155 });
 2700: 
 2701: =head1 BUGS
 2702: 
 2703: =head1 SECURITY
 2704: 
 2705: =head2 Taint mode
 2706: 
 2707: This module does B<not> untaint its return values.
 2708: When running under Perl's taint mode (C<-T>), any value that was derived from
 2709: tainted external input (C<$ENV{}>, C<STDIN>, etc.) will remain tainted in the
 2710: validated result, even if the module accepted it.
 2711: Callers that require untainted values must perform their own regex capture after
 2712: validation, for example:
 2713: 
 2714:     my $validated = validate_strict(%args);
 2715:     my ($safe_name) = ($validated->{name} =~ /\A([\w\s]+)\z/);
 2716: 
 2717: =head2 User-supplied regex patterns
 2718: 
 2719: The C<matches> rule accepts pre-compiled C<qr//> objects supplied by the caller.
 2720: A pathologically constructed pattern (e.g. C<qr/(a+)+b/>) can cause catastrophic
 2721: backtracking and peg a CPU core when matched against a hostile input value.
 2722: Use possessive quantifiers (C<++>) or atomic groups (C<< (?>...) >>) in any
 2723: C<matches> pattern that will be applied to untrusted data.
 2724: 
 2725: =head2 Error message content
 2726: 
 2727: Error and warning messages produced by this module may include the parameter
 2728: value supplied by the caller.
 2729: The module strips ASCII control characters (including CR and LF) from all
 2730: messages before passing them to the logger or croaking, to prevent log-injection
 2731: and HTTP response-splitting attacks.
 2732: Callers should nevertheless apply their own output encoding before including any
 2733: validated value in an HTTP response, HTML page, or structured log entry.
 2734: 
 2735: =head1 SEE ALSO
 2736: 
 2737: =over 4
 2738: 
 2739: =item * L<Test Dashboard|https://nigelhorne.github.io/Params-Validate-Strict/coverage/>
 2740: 
 2741: =item * L<Data::Processor>
 2742: 
 2743: =item * L<Params::Get>
 2744: 
 2745: =item * L<Params::Smart>
 2746: 
 2747: This is where the ideas for C<aliases>, C<slurp> and C<compile_schema> came from.
 2748: 
 2749: =item * L<Params::Util>
 2750: 
 2751: This is where the ideas for C<regex>, C<handle>, C<arraylike>, C<hashlike>, C<codelike>, C<invocant> came from.
 2752: 
 2753: =item * L<Params::SomeUtil>
 2754: 
 2755: A maintained fork of L<Params::Util> 1.07 with bug fixes.  The same type-predicate ideas apply.
 2756: 
 2757: =item * L<Params::Validate>
 2758: 
 2759: =item * L<Return::Set>
 2760: 
 2761: =item * L<App::Test::Generator>
 2762: 
 2763: =back
 2764: 
 2765: =head1 SUPPORT
 2766: 
 2767: This module is provided as-is without any warranty.
 2768: 
 2769: Please report any bugs or feature requests to C<bug-params-validate-strict at rt.cpan.org>,
 2770: or through the web interface at
 2771: L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Params-Validate-Strict>.
 2772: I will be notified, and then you'll
 2773: automatically be notified of progress on your bug as I make changes.
 2774: 
 2775: You can find documentation for this module with the perldoc command.
 2776: 
 2777:     perldoc Params::Validate::Strict
 2778: 
 2779: You can also look for information at:
 2780: 
 2781: =over 4
 2782: 
 2783: =item * MetaCPAN
 2784: 
 2785: L<https://metacpan.org/dist/Params-Validate-Strict>
 2786: 
 2787: =item * RT: CPAN's request tracker
 2788: 
 2789: L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Params-Validate-Strict>
 2790: 
 2791: =item * CPAN Testers' Matrix
 2792: 
 2793: L<http://matrix.cpantesters.org/?dist=Params-Validate-Strict>
 2794: 
 2795: =item * CPAN Testers Dependencies
 2796: 
 2797: L<http://deps.cpantesters.org/?module=Params::Validate::Strict>
 2798: 
 2799: =back
 2800: 
 2801: =head1 LICENSE AND COPYRIGHT
 2802: 
 2803: Copyright 2025-2026 Nigel Horne.
 2804: 
 2805: This program is released under the following licence: GPL2.
 2806: If you use it,
 2807: please let me know.
 2808: 
 2809: =cut
 2810: 
 2811: 1;
 2812: 
 2813: __END__