lib/Params/Validate/Strict.pm

        start → end → jump
        

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

					

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

				
NUM_BOUNDARY_1433_128_<: 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_1433_128_>=: 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_1433_128_<=: 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' );

								
							
 1434: 						$invalid_args{$key} = 1;
 1435: 					}
 1436: 					} elsif($type eq 'hashref') {
 1437: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1438: 							next;	# Skip if hash is undefined
 1439: 						}
 1440: 						if(scalar(keys(%{$value})) < $rule_value) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1441: 							_rule_error($logger, $rules, "$rule_description: Parameter '$key' must contain at least $rule_value keys");
 1442: 							$invalid_args{$key} = 1;
 1443: 						}
 1444: 					} elsif(($type eq 'integer') || ($type eq 'number') || ($type eq 'float')) {
 1445: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1446: 							next;	# Skip if hash is undefined
 1447: 						}
 1448: 						if(Scalar::Util::looks_like_number($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1449: 							if($value < $rule_value) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1450: 								if($rules->{'error_msg'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1451: 									_error($logger, $rules->{'error_msg'});
 1452: 								} elsif(($type eq 'integer') && ($value == 0)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1453: 									_error($logger, "$rule_description: Parameter '$key' ($value) must be a positive number");
 1454: 								} elsif(($type eq 'integer') && ($value == 1)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1455: 									_error($logger, "$rule_description: Parameter '$key' ($value) must be a positive, non-zero number");
 1456: 								} else {
 1457: 									_error($logger, "$rule_description: Parameter '$key' ($value) must be at least $rule_value");
 1458: 								}
 1459: 								$invalid_args{$key} = 1;
 1460: 								next;
 1461: 							}
 1462: 						} else {
 1463: 							_rule_error($logger, $rules, "$rule_description: Parameter '$key' ($value) must be a number");
 1464: 							next;
 1465: 						}
 1466: 					} else {
 1467: 						_error($logger, "$rule_description: Parameter '$key' of type '$type' has meaningless min value $rule_value");
 1468: 					}
 1469: 				} elsif($rule_name eq 'max') {
 1470: 					if(!defined($rules->{'type'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1471: 						_error($logger, "$rule_description: Don't know type of '$key' to determine its maximum value $rule_value");
 1472: 					}
 1473: 					my $type = lc($rules->{'type'});
 1474: 					if(exists($custom_types->{$type}->{'max'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1475: 						$rule_value = $custom_types->{$type}->{'max'};
 1476: 						$type = $custom_types->{$type}->{'type'};
 1477: 					}
 1478: 					if(($type eq 'string') || ($type eq 'str') || ($type eq 'stringref')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1479: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1480: 							next;	# Skip if string is undefined
 1481: 						}
 1482: 						if(defined(my $len = _number_of_characters($value))) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1483: 							if($len > $rule_value) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1484: 								_rule_error($logger, $rules, "$rule_description: String parameter '$key' too long, ($len characters), must be no longer than $rule_value");
 1485: 								$invalid_args{$key} = 1;
 1486: 							}
 1487: 						} else {
 1488: 							_rule_error($logger, $rules, "$rule_description: '$key' can't be decoded");
 1489: 							$invalid_args{$key} = 1;
 1490: 						}
 1491: 					} elsif($type eq 'arrayref') {
 1492: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1493: 							next;	# Skip if string is undefined
 1494: 						}
 1495: 						if(scalar(@{$value}) > $rule_value) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1496: 							_rule_error($logger, $rules, "$rule_description: Parameter '$key' must contain no more than $rule_value items");
 1497: 							$invalid_args{$key} = 1;
 1498: 						}
 1499: 					} elsif($type eq 'hashref') {
 1500: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1501: 							next;	# Skip if hash is undefined
 1502: 						}
 1503: 						if(scalar(keys(%{$value})) > $rule_value) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1504: 							_rule_error($logger, $rules, "$rule_description: Parameter '$key' must contain no more than $rule_value keys");
 1505: 							$invalid_args{$key} = 1;
 1506: 						}
 1507: 					} elsif(($type eq 'integer') || ($type eq 'number') || ($type eq 'float')) {
 1508: 						if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1509: 							next;	# Skip if hash is undefined
 1510: 						}
 1511: 						if(Scalar::Util::looks_like_number($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1512: 							if($value > $rule_value) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1513: 								if($rules->{'error_msg'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1514: 									_error($logger, $rules->{'error_msg'});
 1515: 								} elsif(($type eq 'integer') && ($value == 0)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1516: 									_error($logger, "$rule_description: Parameter '$key' ($value) must be a negative number");
 1517: 								} elsif(($type eq 'integer') && ($value == -1)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1518: 									_error($logger, "$rule_description: Parameter '$key' ($value) must be a negative, non-zero number");
 1519: 								} else {
 1520: 									_error($logger, "$rule_description: Parameter '$key' ($value) must be no more than $rule_value");
 1521: 								}
 1522: 								$invalid_args{$key} = 1;
 1523: 								next;
 1524: 							}
 1525: 						} else {
 1526: 							_rule_error($logger, $rules, "$rule_description: Parameter '$key' ($value) must be a number");
 1527: 							next;
 1528: 						}
 1529: 					} else {
 1530: 						_error($logger, "$rule_description: Parameter '$key' of type '$type' has meaningless max value $rule_value");
 1531: 					}
 1532: 				} elsif(($rule_name eq 'matches') || ($rule_name eq 'regex')) {
 1533: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1534: 						next;	# Skip if string is undefined
 1535: 					}
 1536: 					eval {
 1537: 						my $re = (ref($rule_value) eq 'Regexp') ? $rule_value : qr/\Q$rule_value\E/;
 1538: 						if(($rules->{'type'} eq 'arrayref') || ($rules->{'type'} eq 'ArrayRef')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1539: 							# all{} short-circuits on first failure and allocates no temp array
 1540: 							unless(all { $_ =~ $re } @{$value}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1541: 								_rule_error($logger, $rules, "$rule_description: All members of parameter '$key' [", join(', ', @{$value}), "] must match pattern '$rule_value'");
 1542: 							}
 1543: 						} elsif($value !~ $re) {
 1544: 							_rule_error($logger, $rules, "$rule_description: Parameter '$key' ($value) must match pattern '$re'");
 1545: 						}
 1546: 						1;
 1547: 					};
 1548: 					if($@) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1549: 						_rule_error($logger, $rules, "$rule_description: Parameter '$key' regex '$rule_value' error: $@");
 1550: 						$invalid_args{$key} = 1;
 1551: 					}
 1552: 				} elsif($rule_name eq 'nomatch') {
 1553: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1554: 						next;	# Skip if string is undefined
 1555: 					}
 1556: 					# Compile string patterns with \Q...\E so metacharacters are
 1557: 					# treated as literals, matching the behaviour of 'matches'.
 1558: 					my $re = (ref($rule_value) eq 'Regexp') ? $rule_value : qr/\Q$rule_value\E/;
 1559: 					eval {
 1560: 						if(($rules->{'type'} eq 'arrayref') || ($rules->{'type'} eq 'ArrayRef')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1561: 							# any{} short-circuits on first match and allocates no temp array
 1562: 							if(any { $_ =~ $re } @{$value}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1563: 								_rule_error($logger, $rules, "$rule_description: No member of parameter '$key' [", join(', ', @{$value}), "] must match pattern '$rule_value'");
 1564: 							}
 1565: 						} elsif($value =~ $re) {
 1566: 							_rule_error($logger, $rules, "$rule_description: Parameter '$key' ($value) must not match pattern '$rule_value'");
 1567: 							$invalid_args{$key} = 1;
 1568: 						}
 1569: 						1;
 1570: 					};
 1571: 					if($@) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1572: 						_rule_error($logger, $rules, "$rule_description: Parameter '$key' regex '$rule_value' error: $@");
 1573: 						$invalid_args{$key} = 1;
 1574: 					}
 1575: 				} elsif(($rule_name eq 'memberof') || ($rule_name eq 'enum') || ($rule_name eq 'values')) {
 1576: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1577: 						next;	# Skip if string is undefined
 1578: 					}
 1579: 					if(ref($rule_value) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1580: 						unless(_value_in_list($value, $rule_value, $rules->{'type'} // '', $rules->{'case_sensitive'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1581: 							_rule_error($logger, $rules, "$rule_description: Parameter '$key' ($value) must be one of ", join(', ', @{$rule_value}));
 1582: 							$invalid_args{$key} = 1;
 1583: 						}
 1584: 					} else {
 1585: 						_rule_error($logger, $rules, "$rule_description: Parameter '$key' rule ($rule_value) must be an array reference");
 1586: 					}
 1587: 				} elsif($rule_name eq 'notmemberof') {
 1588: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1589: 						next;	# Skip if string is undefined
 1590: 					}
 1591: 					if(ref($rule_value) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1592: 						if(_value_in_list($value, $rule_value, $rules->{'type'} // '', $rules->{'case_sensitive'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1593: 							_rule_error($logger, $rules, "$rule_description: Parameter '$key' ($value) must not be one of ", join(', ', @{$rule_value}));
 1594: 							$invalid_args{$key} = 1;
 1595: 						}
 1596: 					} else {
 1597: 						_rule_error($logger, $rules, "$rule_description: Parameter '$key' rule ($rule_value) must be an array reference");
 1598: 					}
 1599: 				} elsif($rule_name eq 'isa') {
 1600: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1601: 						next;	# Skip if object not given
 1602: 					}
 1603: 					if($rules->{'type'} eq 'object') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1604: 						if(!$value->isa($rule_value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1605: 							_error($logger, "$rule_description: Parameter '$key' must be a '$rule_value' object got a " . (ref($value) ? ref($value) : $value) . ' object instead');
 1606: 							$invalid_args{$key} = 1;
 1607: 						}
 1608: 					} else {
 1609: 						_error($logger, "$rule_description: Parameter '$key' has meaningless isa value $rule_value");
 1610: 					}
 1611: 				} elsif($rule_name eq 'can') {
 1612: 					if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1613: 						next;	# Skip if object not given
 1614: 					}
 1615: 					if($rules->{'type'} eq 'object') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1616: 						if(ref($rule_value) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1617: 							# List of methods
 1618: 							foreach my $method(@{$rule_value}) {
 1619: 								if(!$value->can($method)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1620: 									_error($logger, "$rule_description: Parameter '$key' must be an object that understands the $method method");
 1621: 									$invalid_args{$key} = 1;
 1622: 								}
 1623: 							}
 1624: 						} elsif(!ref($rule_value)) {
 1625: 							if(!$value->can($rule_value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1626: 								_error($logger, "$rule_description: Parameter '$key' must be an object that understands the $rule_value method");
 1627: 								$invalid_args{$key} = 1;
 1628: 							}
 1629: 						} else {
 1630: 							_error($logger, "$rule_description: 'can' rule for Parameter '$key must be either a scalar or an arrayref");
 1631: 						}
 1632: 					} else {
 1633: 						_error($logger, "$rule_description: Parameter '$key' has meaningless can value '$rule_value' for parameter type $rules->{type}");
 1634: 					}
 1635: 				} elsif($rule_name eq 'element_type') {
 1636: 					if(($rules->{'type'} eq 'arrayref') || ($rules->{'type'} eq 'ArrayRef')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1637: 						my $type = $rule_value;
 1638: 						my $custom_type = $custom_types->{$rule_value};
 1639: 						if($custom_type && $custom_type->{'type'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1640: 							$type = $custom_type->{'type'};
 1641: 						}
 1642: 						foreach my $member(@{$value}) {
 1643: 							if($custom_type && $custom_type->{'transform'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1644: 								# The custom type has a transform embedded within it
 1645: 								if(ref($custom_type->{'transform'}) eq 'CODE') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1646: 									$member = &{$custom_type->{'transform'}}($member);
 1647: 								} else {
 1648: 									_error($logger, "$rule_description: transforms must be a code ref");
 1649: 								}
 1650: 							}
 1651: 							if(($type eq 'string') || ($type eq 'Str')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1652: 								if(ref($member)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1653: 									_rule_error($logger, $rules, "$key can only contain strings");
 1654: 									$invalid_args{$key} = 1;
 1655: 								}
 1656: 							} elsif($type eq 'integer') {
 1657: 								if(ref($member) || ($member =~ /\D/)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1658: 									_rule_error($logger, $rules, "$key can only contain integers (found $member)");
 1659: 									$invalid_args{$key} = 1;
 1660: 								}
 1661: 							} elsif(($type eq 'number') || ($rule_value eq 'float')) {
 1662: 								if(ref($member) || ($member !~ /^[-+]?(?:\d+(?:\.\d*)?|\.\d+)$/)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1663: 									_rule_error($logger, $rules, "$key can only contain numbers (found $member)");
 1664: 									$invalid_args{$key} = 1;
 1665: 								}
 1666: 							} elsif($type eq 'object') {
 1667: 								if(!Scalar::Util::blessed($member)) {

					

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

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

 1668: 									_rule_error($logger, $rules, "$key can only contain objects (found $member)");
 1669: 									$invalid_args{$key} = 1;
 1670: 								}
 1671: 							} else {
 1672: 								_error($logger, "BUG: Add $type to element_type list");
 1673: 							}
 1674: 						}
 1675: 					} else {
 1676: 						_error($logger, "$rule_description: Parameter '$key' has meaningless element_type value $rule_value");
 1677: 					}
 1678: 				} elsif($rule_name eq 'optional') {
 1679: 					# Already handled at the beginning of the loop
 1680: 				} elsif($rule_name eq 'nullable') {
 1681: 					# Already handled at the beginning of the loop (same as optional)
 1682: 				} elsif($rule_name eq 'default') {
 1683: 					# Handled earlier
 1684: 				} elsif($rule_name eq 'error_msg') {
 1685: 					# Handled inline
 1686: 				} elsif($rule_name eq 'transform') {
 1687: 					# Handled before the loop
 1688: 				} elsif($rule_name eq 'case_sensitive') {
 1689: 					# Handled inline
 1690: 				} elsif($rule_name eq 'description') {
 1691: 					# A la, Data::Processor
 1692: 				} elsif($rule_name =~ /^_/) {
 1693: 					# Ignore internal/metadata fields from schema extraction
 1694: 				} elsif($rule_name eq 'semantic') {
 1695: 					if($rule_value eq 'unix_timestamp') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1696: 						if($value < 0 || $value > 2147483647) {
  Mutants (Total: 7, Killed: 7, Survived: 0)
 1697: 							_error($logger, "Invalid Unix timestamp: $value");
 1698: 						}
 1699: 					} else {
 1700: 						_warn($logger, "semantic type $rule_value is not yet supported");
 1701: 					}
 1702: 				} elsif($rule_name eq 'schema') {
 1703: 					# Nested schema Run the given schema against each element of the array
 1704: 					if(($rules->{'type'} eq 'arrayref') || ($rules->{'type'} eq 'ArrayRef')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1705: 						if(ref($value) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1706: 							foreach my $member(@{$value}) {
 1707: 								# Distinguish two schema forms:
 1708: 								# (a) Rule hash   — has a top-level 'type' key, e.g. { type=>'string', matches=>qr/.../ }
 1709: 								#     → validate each element against that rule directly.
 1710: 								# (b) Field-schema hash — keys are field names whose values are rule hashes,
 1711: 								#     e.g. { name=>{type=>'string'}, age=>{type=>'integer'} }
 1712: 								#     → validate each hashref element against the field schema directly.
 1713: 								my $is_field_schema = (ref($rule_value) eq 'HASH') && !exists($rule_value->{'type'});
 1714: 								my %inner = (custom_types => $custom_types);
 1715: 								if($is_field_schema) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1716: 									$inner{input}  = $member;
 1717: 									$inner{schema} = $rule_value;
 1718: 								} else {
 1719: 									$inner{input}  = { $key => $member };
 1720: 									$inner{schema} = { $key => $rule_value };
 1721: 								}
 1722: 								if(!validate_strict(\%inner)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1723: 									$invalid_args{$key} = 1;
 1724: 								}
 1725: 							}
 1726: 						} elsif(defined($value)) {	# Allow undef for optional values
 1727: 							_error($logger, "$rule_description: nested schema: Parameter '$value' must be an arrayref");
 1728: 						}
 1729: 					} elsif($rules->{'type'} eq 'hashref') {
 1730: 						if(ref($rule_value) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1731: 							# Apply nested defaults before validation
 1732: 							my $nested_with_defaults = _apply_nested_defaults($value, $rule_value);
 1733: 							if(scalar keys(%{$nested_with_defaults})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1734: 								if(my $new_args = validate_strict({ input => $nested_with_defaults, schema => $rule_value, custom_types => $custom_types })) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1735: 									$value = $new_args;
 1736: 								} else {
 1737: 									$invalid_args{$key} = 1;
 1738: 								}
 1739: 							}
 1740: 						} else {
 1741: 							_error($logger, "$rule_description: nested schema: Parameter '$value' must be an hashref");
 1742: 						}
 1743: 					} else {
 1744: 						_error($logger, "$rule_description: Parameter '$key': 'schema' only supports arrayref and hashref, not $rules->{type}");
 1745: 					}
 1746: 				} elsif(($rule_name eq 'validate') || ($rule_name eq 'validator')) {
 1747: 					if(ref($rule_value) eq 'CODE') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1748: 						if(my $error = &{$rule_value}($args)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1749: 							_error($logger, "$rule_description: $key not valid: $error");
 1750: 							$invalid_args{$key} = 1;
 1751: 						}
 1752: 					} else {
 1753: 						# _error($logger, "$rule_description: Parameter '$key': 'validate' only supports coderef, not $value");
 1754: 						_error($logger, "$rule_description: Parameter '$key': 'validate' only supports coderef, not " . ref($rule_value) // $rule_value);
 1755: 					}
 1756: 				} elsif ($rule_name eq 'callback') {
 1757: 					# Custom validation code
 1758: 					unless (defined &$rule_value) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1759: 						_error($logger, "$rule_description: callback for '$key' must be a code reference");
 1760: 					}
 1761: 					my $res = $rule_value->($value, $args, $schema);
 1762: 					unless ($res) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1763: 						_rule_error($logger, $rules, "$rule_description: Parameter '$key' failed custom validation");
 1764: 						$invalid_args{$key} = 1;
 1765: 					}
 1766: 				} elsif($rule_name eq 'position') {
 1767: 					if($rule_value < 0) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1768: 						_error($logger, "$rule_description: Parameter '$key': 'position' must be a positive integer, not $value");
 1769: 					}
 1770: 					if($rule_value =~ /\D/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1771: 						_error($logger, "$rule_description: Parameter '$key': 'position' must be a positive integer");
 1772: 					}
 1773: 				} else {
 1774: 					_error($logger, "$rule_description: Unknown rule '$rule_name'");
 1775: 				}
 1776: 			}
 1777: 		} elsif(ref($rules) eq 'ARRAY') {
 1778: 			if(scalar(@{$rules})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1779: 				# An argument can be one of several different types.
 1780: 				# This path handles both explicit array-of-rules schemas and the
 1781: 				# normalised form of union type shorthand (type => ['a', 'b', ...]).
 1782: 				my $rc = 0;
 1783: 				my @types;
 1784: 				foreach my $rule(@{$rules}) {
 1785: 					if(ref($rule) ne 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1786: 						_error($logger, "$rule_description: Parameter '$key' rules must be a hash reference");
 1787: 					}
 1788: 					if(!defined($rule->{'type'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1789: 						_error($logger, "$rule_description: Parameter '$key' is missing a type in an alternative");
 1790: 					}
 1791: 					push @types, $rule->{'type'};
 1792: 					my $result;
 1793: 					eval {
 1794: 						$result = validate_strict({ input => { $key => $value }, schema => { $key => $rule }, logger => undef, custom_types => $custom_types });
 1795: 					};
 1796: 					if(!$@) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1797: 						# Capture coercion performed by the successful sub-validation
 1798: 						# (e.g. integer/number coercion) so the outer scope sees it.
 1799: 						$value = $result->{$key} if(defined($result));
 1800: 						$rc = 1;
 1801: 						last;
 1802: 					}
 1803: 				}
 1804: 				if(!$rc) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1805: 					_error($logger, "$rule_description: Parameter: '$key': must be one of " . join(', ', @types));
 1806: 					$invalid_args{$key} = 1;
 1807: 				}
 1808: 			} else {
 1809: 				_error($logger, "$rule_description: Parameter: '$key': schema is empty arrayref");
 1810: 			}
 1811: 		} elsif(ref($rules)) {
 1812: 			_error($logger, 'rules must be a hash reference or string');
 1813: 		}
 1814: 
 1815: 		$validated_args{$key} = $value;
 1816: 	}
 1817: 
 1818: 	# Validate parameter relationships
●1819 → 1819 → 1823 1819: 	if (my $relationships = $params->{'relationships'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1820: 		_validate_relationships(\%validated_args, $relationships, $logger, $schema_description);
 1821: 	}
 1822: 
●1823 → 1823 → 1838 1823: 	if(my $cross_validation = $params->{'cross_validation'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1824: 		foreach my $validator_name(keys %{$cross_validation}) {
 1825: 			my $validator = $cross_validation->{$validator_name};
 1826: 			if((!ref($validator)) || (ref($validator) ne 'CODE')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1827: 				_error($logger, "$schema_description: cross_validation $validator is not a code snippet");
 1828: 				next;
 1829: 			}
 1830: 			if(my $error = &{$validator}(\%validated_args, $validator)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1831: 				_error($logger, $error);
 1832: 				# We have no idea which parameters are still valid, so let's invalidate them all
 1833: 				return;
 1834: 			}
 1835: 		}
 1836: 	}
 1837: 
●1838 → 1838 → 1842 1838: 	foreach my $key(keys %invalid_args) {
 1839: 		delete $validated_args{$key};
 1840: 	}
 1841: 
●1842 → 1842 → 1859 1842: 	if($are_positional_args == 1) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1843: 		my @rc;
 1844: 		foreach my $key (keys %{$schema}) {
 1845: 			# Use exists() rather than if(my $value = ...) so that falsy but
 1846: 			# valid coerced values (integer 0, empty string, undef from an
 1847: 			# absent optional) are not silently dropped from the return array.
 1848: 			if(exists $validated_args{$key}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1849: 				my $value = delete $validated_args{$key};
 1850: 				my $position = $schema->{$key}->{'position'};
 1851: 				if(defined($rc[$position])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1852: 					_error($logger, "$schema_description: $key: position $position appears twice");
 1853: 				}
 1854: 				$rc[$position] = $value;
 1855: 			}
 1856: 		}
 1857: 		return \@rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1858: 	}
 1859: 	return \%validated_args;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1860: }
 1861: 
 1862: # _schema_from_arrayref($arrayref, $logger)
 1863: #
 1864: # Normalise an arrayref schema:
 1865: #   [ { name => 'param', type => 'string', ... }, ... ]
 1866: # to the standard named-parameter hashref form:
 1867: #   { param => { type => 'string', ... }, ... }
 1868: #
 1869: # The 'name' key is consumed during conversion and does not become a rule.
 1870: # Croaks if any element is not a hashref, is missing 'name', or if a name
 1871: # appears more than once.
 1872: sub _schema_from_arrayref
 1873: {
●1874 → 1877 → 1888 1874: 	my ($arrayref, $logger) = @_;
 1875: 
 1876: 	my %schema;
 1877: 	foreach my $spec (@{$arrayref}) {
 1878: 		_error($logger, "validate_strict: each arrayref schema element must be a hashref")
 1879: 			unless ref($spec) eq 'HASH';
 1880: 		_error($logger, "validate_strict: arrayref schema element must have a 'name' key")
 1881: 			unless exists($spec->{'name'});
 1882: 		my %rule = %{$spec};
 1883: 		my $name = delete $rule{'name'};
 1884: 		_error($logger, "validate_strict: duplicate parameter '$name' in arrayref schema")
 1885: 			if exists($schema{$name});
 1886: 		$schema{$name} = \%rule;
 1887: 	}
 1888: 	return \%schema;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1889: }
 1890: 
 1891: # Return number of visible characters not number of bytes
 1892: # Ensure string is decoded into Perl characters
 1893: sub _number_of_characters
 1894: {
●1895 → 1899 → 1903 1895: 	my $value = $_[0];
 1896: 
 1897: 	return if(!defined($value));
 1898: 
 1899: 	if($value !~ /[^[:ascii:]]/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1900: 		return length($value);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1901: 	}
 1902: 	# Decode only if it's not already a Perl character string
 1903: 	$value = decode_utf8($value) unless utf8::is_utf8($value);
 1904: 
 1905: 	# Count grapheme clusters (visible characters)
 1906: 	# The pseudo-operator () = forces list context to count matches
 1907: 	# return scalar( () = $value =~ /\X/g );
 1908: 
 1909: 	return Unicode::GCString->new($value)->length();
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1910: }
 1911: 
 1912: sub _apply_nested_defaults {
●1913 → 1916 → 1929 1913: 	my ($input, $schema) = @_;
 1914: 	my %result = %$input;
 1915: 
 1916: 	foreach my $key (keys %$schema) {
 1917: 		my $rules = $schema->{$key};
 1918: 
 1919: 		if (ref $rules eq 'HASH' && exists $rules->{default} && !exists $result{$key}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1920: 			$result{$key} = $rules->{default};
 1921: 		}
 1922: 
 1923: 		# Recursively handle nested schema
 1924: 		if((ref $rules eq 'HASH') && $rules->{schema} && (ref $result{$key} eq 'HASH')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1925: 			$result{$key} = _apply_nested_defaults($result{$key}, $rules->{schema});
 1926: 		}
 1927: 	}
 1928: 
 1929: 	return \%result;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1930: }
 1931: 
 1932: sub _validate_relationships {
●1933 → 1937 → 0 1933: 	my ($validated_args, $relationships, $logger, $description) = @_;
 1934: 
 1935: 	return unless ref($relationships) eq 'ARRAY';
 1936: 
 1937: 	foreach my $rel (@$relationships) {
 1938: 		my $type = $rel->{type} or next;
 1939: 
 1940: 		if ($type eq 'mutually_exclusive') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1941: 			_validate_mutually_exclusive($validated_args, $rel, $logger, $description);
 1942: 		} elsif ($type eq 'required_group') {
 1943: 			_validate_required_group($validated_args, $rel, $logger, $description);
 1944: 		} elsif ($type eq 'conditional_requirement') {
 1945: 			_validate_conditional_requirement($validated_args, $rel, $logger, $description);
 1946: 		} elsif ($type eq 'dependency') {
 1947: 			_validate_dependency($validated_args, $rel, $logger, $description);
 1948: 		} elsif ($type eq 'value_constraint') {
 1949: 			_validate_value_constraint($validated_args, $rel, $logger, $description);
 1950: 		} elsif ($type eq 'value_conditional') {
 1951: 			_validate_value_conditional($validated_args, $rel, $logger, $description);
 1952: 		} else {
 1953: 			_error($logger, "Unknown relationship type $type");
 1954: 		}
 1955: 	}
 1956: }
 1957: 
 1958: sub _validate_mutually_exclusive {
●1959 → 1966 → 0 1959: 	my ($args, $rel, $logger, $description) = @_;
 1960: 
 1961: 	my @params = @{$rel->{params} || []};
 1962: 	return unless @params >= 2;
  Mutants (Total: 3, Killed: 3, Survived: 0)
 1963: 
 1964: 	my @present = grep { _param_defined($args, $_) } @params;
 1965: 
 1966: 	if (@present > 1) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1967: 		my $msg = $rel->{description} || 'Cannot specify both ' . join(' and ', @present);
 1968: 		_error($logger, "$description: $msg");
 1969: 	}
 1970: }
 1971: 
 1972: sub _validate_required_group {
●1973 → 1980 → 0 1973: 	my ($args, $rel, $logger, $description) = @_;
 1974: 
 1975: 	my @params = @{$rel->{params} || []};
 1976: 	return unless @params >= 2;
  Mutants (Total: 3, Killed: 3, Survived: 0)
 1977: 
 1978: 	my @present = grep { _param_defined($args, $_) } @params;
 1979: 
 1980: 	if (@present == 0) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1981: 		my $msg = $rel->{description} ||
 1982: 			'Must specify at least one of: ' . join(', ', @params);
 1983: 		_error($logger, "$description: $msg");
 1984: 	}
 1985: }
 1986: 
 1987: sub _validate_conditional_requirement {
●1988 → 1994 → 0 1988: 	my ($args, $rel, $logger, $description) = @_;
 1989: 
 1990: 	my $if_param = $rel->{if} or return;
 1991: 	my $then_param = $rel->{then_required} or return;
 1992: 
 1993: 	# If the condition parameter is present and defined
 1994: 	if (_param_defined($args, $if_param)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1995: 		# Check if it's truthy (for booleans and general values)
 1996: 		if ($args->{$if_param}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1997: 			# Then the required parameter must also be present
 1998: 			unless (_param_defined($args, $then_param)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1999: 				my $msg = $rel->{description} || "When $if_param is specified, $then_param is required";
 2000: 				_error($logger, "$description: $msg");
 2001: 			}
 2002: 		}
 2003: 	}
 2004: }
 2005: 
 2006: sub _validate_dependency {
●2007 → 2013 → 0 2007: 	my ($args, $rel, $logger, $description) = @_;
 2008: 
 2009: 	my $param = $rel->{param} or return;
 2010: 	my $requires = $rel->{requires} or return;
 2011: 
 2012: 	# If param is present, requires must also be present
 2013: 	if (_param_defined($args, $param)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2014: 		unless (_param_defined($args, $requires)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2015: 			my $msg = $rel->{description} || "$param requires $requires to be specified";
 2016: 			_error($logger, "$description: $msg");
 2017: 		}
 2018: 	}
 2019: }
 2020: 
 2021: sub _validate_value_constraint {
●2022 → 2031 → 0 2022: 	my ($args, $rel, $logger, $description) = @_;
 2023: 
 2024: 	my $if_param = $rel->{if} or return;
 2025: 	my $then_param = $rel->{then} or return;
 2026: 	my $operator = $rel->{operator} or return;
 2027: 	my $value = $rel->{value};
 2028: 	return unless defined $value;
 2029: 
 2030: 	# If the condition parameter is present and truthy
 2031: 	if (_param_defined($args, $if_param) && $args->{$if_param}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2032: 		# Check if the then parameter exists
 2033: 		if (_param_defined($args, $then_param)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2034: 			my $actual = $args->{$then_param};
 2035: 			my $valid = 0;
 2036: 
 2037: 			if ($operator eq '==') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2038: 				$valid = ($actual == $value);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2039: 			} elsif ($operator eq '!=') {
 2040: 				$valid = ($actual != $value);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2041: 			} elsif ($operator eq '<') {
 2042: 				$valid = ($actual < $value);
  Mutants (Total: 3, Killed: 3, Survived: 0)
 2043: 			} elsif ($operator eq '<=') {
 2044: 				$valid = ($actual <= $value);
  Mutants (Total: 3, Killed: 3, Survived: 0)
 2045: 			} elsif ($operator eq '>') {
 2046: 				$valid = ($actual > $value);
  Mutants (Total: 3, Killed: 3, Survived: 0)
 2047: 			} elsif ($operator eq '>=') {
 2048: 				$valid = ($actual >= $value);
  Mutants (Total: 3, Killed: 3, Survived: 0)
 2049: 			}
 2050: 
 2051: 			unless ($valid) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2052: 				my $msg = $rel->{description} || "When $if_param is specified, $then_param must be $operator $value (got $actual)";
 2053: 				_error($logger, "$description: $msg");
 2054: 			}
 2055: 		}
 2056: 	}
 2057: }
 2058: 
 2059: sub _validate_value_conditional {
●2060 → 2068 → 0 2060: 	my ($args, $rel, $logger, $description) = @_;
 2061: 
 2062: 	my $if_param = $rel->{if} or return;
 2063: 	my $equals = $rel->{equals};
 2064: 	my $then_param = $rel->{then_required} or return;
 2065: 	return unless defined $equals;
 2066: 
 2067: 	# If the parameter has the specific value
 2068: 	if (_param_defined($args, $if_param)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2069: 		if ($args->{$if_param} eq $equals) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2070: 			# Then the required parameter must be present
 2071: 			unless (_param_defined($args, $then_param)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2072: 				my $msg = $rel->{description} ||
 2073: 					"When $if_param equals '$equals', $then_param is required";
 2074: 				_error($logger, "$description: $msg");
 2075: 			}
 2076: 		}
 2077: 	}
 2078: }
 2079: 
 2080: # Emit either the rule's custom error_msg or the supplied default message.
 2081: # Accepts a list for @default_parts so callers can pass join() fragments
 2082: # without pre-allocating a concatenated string.
 2083: sub _rule_error
 2084: {
 2085: 	my ($logger, $rules, @default_parts) = @_;
 2086: 	_error($logger, $rules->{'error_msg'} || join('', @default_parts));
 2087: }
 2088: 
 2089: # Package-level cache: maps "refaddr(list):mode" -> [weak_list_ref, lookup_hash].
 2090: # Each entry holds a WEAK reference to the original list arrayref alongside the
 2091: # compiled lookup hash.  When the list goes out of scope and is freed, the weak
 2092: # reference becomes undef; the next access detects the stale entry and rebuilds,
 2093: # preventing false cache hits after address reuse.
 2094: my %_pvs_memberof_cache;
 2095: 
 2096: # Return true if $value is present in $list, respecting numeric vs string
 2097: # comparison and the case_sensitive flag.  Used by both memberof and notmemberof.
 2098: # On the first call for a given ($list, mode) pair the lookup hash is built
 2099: # (O(k)); subsequent calls with the same live list object are O(1).
 2100: sub _value_in_list
 2101: {
●2102 → 2113 → 2118 2102: 	my ($value, $list, $type, $case_sensitive) = @_;
 2103: 	my $is_numeric = ($type eq 'integer') || ($type eq 'number') || ($type eq 'float');
 2104: 	my $is_icase   = !$is_numeric && defined($case_sensitive) && !$case_sensitive;
 2105: 
 2106: 	# Key combines address and comparison mode so the same list object can be
 2107: 	# cached under multiple modes without collision.
 2108: 	my $ckey = Scalar::Util::refaddr($list) . ($is_numeric ? 'n' : $is_icase ? 'i' : 's');
 2109: 	my $entry = $_pvs_memberof_cache{$ckey};
 2110: 
 2111: 	# Stale check: if the weak ref is dead the list was freed and its address
 2112: 	# may have been reused by a different list — discard the cached hash.
 2113: 	if(defined($entry) && !defined($entry->[0])) {

					

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

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

 2114: 		delete $_pvs_memberof_cache{$ckey};
 2115: 		$entry = undef;
 2116: 	}
 2117: 
●2118 → 2118 → 2135 2118: 	unless(defined $entry) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2119: 		my $lookup;
 2120: 		if($is_numeric) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2121: 			# Normalise to numeric value so "1" and "1.0" hash identically.
 2122: 			$lookup = { map { ($_ + 0) => 1 } @{$list} };
 2123: 		} elsif($is_icase) {
 2124: 			$lookup = { map { lc($_) => 1 } @{$list} };
 2125: 		} else {
 2126: 			$lookup = { map { $_ => 1 } @{$list} };
 2127: 		}
 2128: 		# Store [weak_ref_to_list, lookup_hash] — weak ref does not prevent GC.
 2129: 		my $weak = $list;
 2130: 		Scalar::Util::weaken($weak);
 2131: 		$_pvs_memberof_cache{$ckey} = [$weak, $lookup];
 2132: 		$entry = $_pvs_memberof_cache{$ckey};
 2133: 	}
 2134: 
 2135: 	my $lookup = $entry->[1];
 2136: 	return $is_numeric ? exists($lookup->{$value + 0})
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2137: 	     : $is_icase   ? exists($lookup->{lc($value)})
 2138: 	     :               exists($lookup->{$value});
 2139: }
 2140: 
 2141: # Return true when $args->{$param} is both present (exists) and defined.
 2142: sub _param_defined
 2143: {
 2144: 	my ($args, $param) = @_;
 2145: 	return exists($args->{$param}) && defined($args->{$param});
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2146: }
 2147: 
 2148: # Helper to log error or croak
 2149: sub _error
 2150: {
●2151 → 2158 → 2161 2151: 	my $logger = shift;
 2152: 	my $message = join('', @_);
 2153: 	# Strip ASCII control characters to prevent log-injection / CRLF attacks
 2154: 	# when user-supplied values appear in the message.
 2155: 	$message =~ s/[[:cntrl:]]/ /g;
 2156: 
 2157: 	my @call_details = caller(0);
 2158: 	if($logger) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2159: 		$logger->error(__PACKAGE__, ' line ', $call_details[2], ": $message");
 2160: 	}
 2161: 	croak(__PACKAGE__, ' line ', $call_details[2], ": $message");
 2162: }
 2163: 
 2164: # Helper to log warning or carp
 2165: sub _warn
 2166: {
●2167 → 2172 → 0 2167: 	my $logger = shift;
 2168: 	my $message = join('', @_);
 2169: 	# Strip ASCII control characters to prevent log-injection / CRLF attacks.
 2170: 	$message =~ s/[[:cntrl:]]/ /g;
 2171: 
 2172: 	if($logger) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2173: 		$logger->warn(__PACKAGE__, ": $message");
 2174: 	} else {
 2175: 		carp(__PACKAGE__, ": $message");
 2176: 	}
 2177: }
 2178: 
 2179: =head1 AUTHOR
 2180: 
 2181: Nigel Horne, C<< <njh at nigelhorne.com> >>
 2182: 
 2183: =encoding utf-8
 2184: 
 2185: =head1 FORMAL SPECIFICATION
 2186: 
 2187:     [PARAM_NAME, VALUE, TYPE_NAME, CONSTRAINT_VALUE]
 2188: 
 2189:     ValidationRule ::= SimpleType | ComplexRule | UnionType
 2190: 
 2191:     SimpleType ::= string | integer | number | scalar | scalarref | stringref | arrayref | hashref | coderef | object
 2192: 
 2193:     UnionType ::= seq SimpleType    -- at least two members; written as type => ['a', 'b']
 2194: 
 2195:     ComplexRule == [
 2196:         type: SimpleType | UnionType;
 2197:         min: ℕ₁;
 2198:         max: ℕ₁;
 2199:         optional: 𝔹;
 2200:         matches: REGEX;
 2201:         regex: REGEX;
 2202:         nomatch: REGEX;
 2203: 	memberof: seq VALUE;
 2204:         enum: seq VALUE;
 2205:         values: seq VALUE;
 2206:         notmemberof: seq VALUE;
 2207:         callback: FUNCTION;
 2208:         isa: TYPE_NAME;
 2209:         can: METHOD_NAME
 2210:     ]
 2211: 
 2212:     Schema == PARAM_NAME ⇸ ValidationRule
 2213: 
 2214:     Arguments == PARAM_NAME ⇸ VALUE
 2215: 
 2216:     ValidatedResult == PARAM_NAME ⇸ VALUE
 2217: 
 2218:     ∀ rule: ComplexRule •
 2219:       rule.min ≤ rule.max ∧
 2220:       ¬((rule.memberof ∨ rule.enum ∨ rule.values) ∧ rule.min) ∧
 2221:       ¬((rule.memberof ∨ rule.enum ∨ rule.values) ∧ rule.max) ∧
 2222:       ¬(rule.notmemberof ∧ rule.min) ∧
 2223:       ¬(rule.notmemberof ∧ rule.max)
 2224: 
 2225:     ∀ schema: Schema; args: Arguments •
 2226:       dom(validate_strict(schema, args)) ⊆ dom(schema) ∪ dom(args)
 2227: 
 2228:     validate_strict: Schema × Arguments → ValidatedResult
 2229: 
 2230:     ∀ schema: Schema; args: Arguments •
 2231:       let result == validate_strict(schema, args) •
 2232:         (∀ name: dom(schema) ∩ dom(args) •
 2233:           name ∈ dom(result) ⇒
 2234:           type_matches(result(name), schema(name))) ∧
 2235:         (∀ name: dom(schema) •
 2236:           ¬optional(schema(name)) ⇒ name ∈ dom(args))
 2237: 
 2238:     type_matches: VALUE × ValidationRule → 𝔹
 2239: 
 2240: =head1 EXAMPLE
 2241: 
 2242:     use Params::Get;
 2243:     use Params::Validate::Strict;
 2244: 
 2245:     sub where_am_i
 2246:     {
 2247:         my $params = Params::Validate::Strict::validate_strict({
 2248:             args => Params::Get::get_params(undef, \@_),
 2249: 	    description => 'Print a string of latitude and longitude',
 2250: 	    error_msg => 'Latitude is a number between +/- 90, longitude is a number between +/- 180',
 2251:             members => {
 2252:                 'latitude' => {
 2253:                     type => 'number',
 2254:                     min => -90,
 2255:                     max => 90
 2256:                 }, 'longitude' => {
 2257:                     type => 'number',
 2258:                     min => -180,
 2259:                     max => 180
 2260:                 }
 2261:             }
 2262:         });
 2263: 
 2264:         print 'You are at ', $params->{'latitude'}, ', ', $params->{'longitude'}, "\n";
 2265:     }
 2266: 
 2267:     where_am_i({ latitude => 3.14, longitude => -155 });
 2268: 
 2269: =head1 BUGS
 2270: 
 2271: =head1 SECURITY
 2272: 
 2273: =head2 Taint mode
 2274: 
 2275: This module does B<not> untaint its return values.
 2276: When running under Perl's taint mode (C<-T>), any value that was derived from
 2277: tainted external input (C<$ENV{}>, C<STDIN>, etc.) will remain tainted in the
 2278: validated result, even if the module accepted it.
 2279: Callers that require untainted values must perform their own regex capture after
 2280: validation, for example:
 2281: 
 2282:     my $validated = validate_strict(%args);
 2283:     my ($safe_name) = ($validated->{name} =~ /\A([\w\s]+)\z/);
 2284: 
 2285: =head2 User-supplied regex patterns
 2286: 
 2287: The C<matches> rule accepts pre-compiled C<qr//> objects supplied by the caller.
 2288: A pathologically constructed pattern (e.g. C<qr/(a+)+b/>) can cause catastrophic
 2289: backtracking and peg a CPU core when matched against a hostile input value.
 2290: Use possessive quantifiers (C<++>) or atomic groups (C<< (?>...) >>) in any
 2291: C<matches> pattern that will be applied to untrusted data.
 2292: 
 2293: =head2 Error message content
 2294: 
 2295: Error and warning messages produced by this module may include the parameter
 2296: value supplied by the caller.
 2297: The module strips ASCII control characters (including CR and LF) from all
 2298: messages before passing them to the logger or croaking, to prevent log-injection
 2299: and HTTP response-splitting attacks.
 2300: Callers should nevertheless apply their own output encoding before including any
 2301: validated value in an HTTP response, HTML page, or structured log entry.
 2302: 
 2303: =head1 SEE ALSO
 2304: 
 2305: =over 4
 2306: 
 2307: =item * L<Test Dashboard|https://nigelhorne.github.io/Params-Validate-Strict/coverage/>
 2308: 
 2309: =item * L<Data::Processor>
 2310: 
 2311: =item * L<Params::Get>
 2312: 
 2313: =item * L<Params::Smart>
 2314: 
 2315: =item * L<Params::Validate>
 2316: 
 2317: =item * L<Return::Set>
 2318: 
 2319: =item * L<App::Test::Generator>
 2320: 
 2321: =back
 2322: 
 2323: =head1 SUPPORT
 2324: 
 2325: This module is provided as-is without any warranty.
 2326: 
 2327: Please report any bugs or feature requests to C<bug-params-validate-strict at rt.cpan.org>,
 2328: or through the web interface at
 2329: L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Params-Validate-Strict>.
 2330: I will be notified, and then you'll
 2331: automatically be notified of progress on your bug as I make changes.
 2332: 
 2333: You can find documentation for this module with the perldoc command.
 2334: 
 2335:     perldoc Params::Validate::Strict
 2336: 
 2337: You can also look for information at:
 2338: 
 2339: =over 4
 2340: 
 2341: =item * MetaCPAN
 2342: 
 2343: L<https://metacpan.org/dist/Params-Validate-Strict>
 2344: 
 2345: =item * RT: CPAN's request tracker
 2346: 
 2347: L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Params-Validate-Strict>
 2348: 
 2349: =item * CPAN Testers' Matrix
 2350: 
 2351: L<http://matrix.cpantesters.org/?dist=Params-Validate-Strict>
 2352: 
 2353: =item * CPAN Testers Dependencies
 2354: 
 2355: L<http://deps.cpantesters.org/?module=Params::Validate::Strict>
 2356: 
 2357: =back
 2358: 
 2359: =head1 LICENSE AND COPYRIGHT
 2360: 
 2361: Copyright 2025-2026 Nigel Horne.
 2362: 
 2363: This program is released under the following licence: GPL2.
 2364: If you use it,
 2365: please let me know.
 2366: 
 2367: =cut
 2368: 
 2369: 1;
 2370: 
 2371: __END__