[203] | 1 | package Params::Validate;
|
---|
| 2 |
|
---|
| 3 | use strict;
|
---|
| 4 | use warnings;
|
---|
| 5 |
|
---|
| 6 | require XSLoader;
|
---|
| 7 | XSLoader::load( 'Params::Validate', $Params::Validate::VERSION );
|
---|
| 8 |
|
---|
| 9 |
|
---|
| 10 | my $default_fail = sub { require Carp;
|
---|
| 11 | Carp::confess($_[0]) };
|
---|
| 12 |
|
---|
| 13 | {
|
---|
| 14 | my %defaults = ( ignore_case => 0,
|
---|
| 15 | strip_leading => 0,
|
---|
| 16 | allow_extra => 0,
|
---|
| 17 | on_fail => $default_fail,
|
---|
| 18 | stack_skip => 1,
|
---|
| 19 | normalize_keys => undef,
|
---|
| 20 | );
|
---|
| 21 |
|
---|
| 22 | *set_options = \&validation_options;
|
---|
| 23 | sub validation_options
|
---|
| 24 | {
|
---|
| 25 | my %opts = @_;
|
---|
| 26 |
|
---|
| 27 | my $caller = caller;
|
---|
| 28 |
|
---|
| 29 | foreach ( keys %defaults )
|
---|
| 30 | {
|
---|
| 31 | $opts{$_} = $defaults{$_} unless exists $opts{$_};
|
---|
| 32 | }
|
---|
| 33 |
|
---|
| 34 | $OPTIONS{$caller} = \%opts;
|
---|
| 35 | }
|
---|
| 36 | }
|
---|
| 37 |
|
---|
| 38 | sub _check_regex_from_xs { return ( defined $_[0] ? $_[0] : '' ) =~ /$_[1]/ ? 1 : 0 }
|
---|
| 39 |
|
---|
| 40 | BEGIN
|
---|
| 41 | {
|
---|
| 42 | if ( $] >= 5.006 && $] < 5.007 )
|
---|
| 43 | {
|
---|
| 44 | eval <<'EOF';
|
---|
| 45 | sub check_for_error
|
---|
| 46 | {
|
---|
| 47 | if ( defined $Params::Validate::ERROR )
|
---|
| 48 | {
|
---|
| 49 | $Params::Validate::ON_FAIL ||= sub { require Carp; Carp::croak( $_[0] ) };
|
---|
| 50 |
|
---|
| 51 | $Params::Validate::ON_FAIL->($Params::Validate::ERROR)
|
---|
| 52 | }
|
---|
| 53 | }
|
---|
| 54 |
|
---|
| 55 | sub validate_pos (\@@)
|
---|
| 56 | {
|
---|
| 57 | local $Params::Validate::ERROR;
|
---|
| 58 | local $Params::Validate::ON_FAIL;
|
---|
| 59 | local $Params::Validate::CALLER = caller;
|
---|
| 60 |
|
---|
| 61 | my $r;
|
---|
| 62 | if (defined wantarray)
|
---|
| 63 | {
|
---|
| 64 | $r = &_validate_pos;
|
---|
| 65 | }
|
---|
| 66 | else
|
---|
| 67 | {
|
---|
| 68 | &_validate_pos;
|
---|
| 69 | }
|
---|
| 70 |
|
---|
| 71 | check_for_error();
|
---|
| 72 |
|
---|
| 73 | return wantarray ? @$r : $r if defined wantarray;
|
---|
| 74 | }
|
---|
| 75 |
|
---|
| 76 | sub validate (\@$)
|
---|
| 77 | {
|
---|
| 78 | local $Params::Validate::ERROR;
|
---|
| 79 | local $Params::Validate::ON_FAIL;
|
---|
| 80 | local $Params::Validate::CALLER = caller;
|
---|
| 81 |
|
---|
| 82 | my $r;
|
---|
| 83 | if (defined wantarray)
|
---|
| 84 | {
|
---|
| 85 | $r = &_validate;
|
---|
| 86 | }
|
---|
| 87 | else
|
---|
| 88 | {
|
---|
| 89 | &_validate;
|
---|
| 90 | }
|
---|
| 91 |
|
---|
| 92 | check_for_error();
|
---|
| 93 |
|
---|
| 94 | return wantarray ? %$r : $r if defined wantarray;
|
---|
| 95 | }
|
---|
| 96 |
|
---|
| 97 | sub validate_with
|
---|
| 98 | {
|
---|
| 99 | local $Params::Validate::ERROR;
|
---|
| 100 | local $Params::Validate::ON_FAIL;
|
---|
| 101 | local $Params::Validate::CALLER = caller;
|
---|
| 102 |
|
---|
| 103 | my $r;
|
---|
| 104 | if (defined wantarray)
|
---|
| 105 | {
|
---|
| 106 | $r = &_validate_with;
|
---|
| 107 | }
|
---|
| 108 | else
|
---|
| 109 | {
|
---|
| 110 | &_validate_with;
|
---|
| 111 | }
|
---|
| 112 |
|
---|
| 113 | check_for_error();
|
---|
| 114 |
|
---|
| 115 | my %p = @_;
|
---|
| 116 | if ( UNIVERSAL::isa( $p{spec}, 'ARRAY' ) )
|
---|
| 117 | {
|
---|
| 118 | return wantarray ? @$r : $r if defined wantarray;
|
---|
| 119 | }
|
---|
| 120 | else
|
---|
| 121 | {
|
---|
| 122 | return wantarray ? %$r : $r if defined wantarray;
|
---|
| 123 | }
|
---|
| 124 | }
|
---|
| 125 | EOF
|
---|
| 126 |
|
---|
| 127 | die $@ if $@;
|
---|
| 128 | }
|
---|
| 129 | else
|
---|
| 130 | {
|
---|
| 131 | *validate = \&_validate;
|
---|
| 132 | *validate_pos = \&_validate_pos;
|
---|
| 133 | *validate_with = \&_validate_with;
|
---|
| 134 | }
|
---|
| 135 | }
|
---|
| 136 |
|
---|
| 137 | 1;
|
---|
| 138 |
|
---|
| 139 | __END__
|
---|
| 140 |
|
---|
| 141 | =head1 NAME
|
---|
| 142 |
|
---|
| 143 | Params::ValidateXS - XS implementation of Params::Validate
|
---|
| 144 |
|
---|
| 145 | =head1 SYNOPSIS
|
---|
| 146 |
|
---|
| 147 | See Params::Validate
|
---|
| 148 |
|
---|
| 149 | =head1 DESCRIPTION
|
---|
| 150 |
|
---|
| 151 | This is an XS implementation of Params::Validate. See the
|
---|
| 152 | Params::Validate documentation for details.
|
---|
| 153 |
|
---|
| 154 | =head1 COPYRIGHT
|
---|
| 155 |
|
---|
| 156 | Copyright (c) 2004-2007 David Rolsky. All rights reserved. This
|
---|
| 157 | program is free software; you can redistribute it and/or modify it
|
---|
| 158 | under the same terms as Perl itself.
|
---|
| 159 |
|
---|
| 160 | =cut
|
---|