source: rdnap/lib/Params/ValidateXS.pm@ 379

Last change on this file since 379 was 203, checked in by Rick van der Zwet, 14 years ago

Little wrapper, as, the orginal one is gone.

File size: 2.8 KB
Line 
1package Params::Validate;
2
3use strict;
4use warnings;
5
6require XSLoader;
7XSLoader::load( 'Params::Validate', $Params::Validate::VERSION );
8
9
10my $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
38sub _check_regex_from_xs { return ( defined $_[0] ? $_[0] : '' ) =~ /$_[1]/ ? 1 : 0 }
39
40BEGIN
41{
42 if ( $] >= 5.006 && $] < 5.007 )
43 {
44 eval <<'EOF';
45sub 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
55sub 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
76sub 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
97sub 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}
125EOF
126
127 die $@ if $@;
128 }
129 else
130 {
131 *validate = \&_validate;
132 *validate_pos = \&_validate_pos;
133 *validate_with = \&_validate_with;
134 }
135}
136
1371;
138
139__END__
140
141=head1 NAME
142
143Params::ValidateXS - XS implementation of Params::Validate
144
145=head1 SYNOPSIS
146
147 See Params::Validate
148
149=head1 DESCRIPTION
150
151This is an XS implementation of Params::Validate. See the
152Params::Validate documentation for details.
153
154=head1 COPYRIGHT
155
156Copyright (c) 2004-2007 David Rolsky. All rights reserved. This
157program is free software; you can redistribute it and/or modify it
158under the same terms as Perl itself.
159
160=cut
Note: See TracBrowser for help on using the repository browser.