Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Kwalify.pm |
Statements | Executed 3290 statements in 5.99ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
22 | 1 | 1 | 1.28ms | 4.24ms | validate_map | Kwalify::Validator::
89 | 3 | 1 | 626µs | 4.71ms | _validate (recurses: max depth 2, inclusive time 5.82ms) | Kwalify::Validator::
66 | 2 | 1 | 465µs | 595µs | _additional_rules | Kwalify::Validator::
154 | 3 | 1 | 429µs | 475µs | _append_path | Kwalify::Validator::
396 | 4 | 1 | 288µs | 288µs | CORE:match (opcode) | Kwalify::Validator::
133 | 3 | 1 | 241µs | 321µs | _get_boolean | Kwalify::Validator::
44 | 1 | 1 | 191µs | 624µs | validate_str | Kwalify::Validator::
1 | 1 | 1 | 142µs | 4.69ms | validate_seq | Kwalify::Validator::
22 | 1 | 1 | 63µs | 256µs | validate_any | Kwalify::Validator::
1 | 1 | 1 | 23µs | 4.76ms | validate | Kwalify::
1 | 1 | 1 | 13µs | 17µs | BEGIN@16 | Kwalify::
1 | 1 | 1 | 11µs | 11µs | new | Kwalify::Validator::
1 | 1 | 1 | 10µs | 17µs | BEGIN@142 | Kwalify::Validator::
1 | 1 | 1 | 8µs | 24µs | BEGIN@121 | Kwalify::Validator::
1 | 1 | 1 | 8µs | 79µs | BEGIN@18 | Kwalify::
1 | 1 | 1 | 7µs | 4.72ms | validate | Kwalify::Validator::
1 | 1 | 1 | 7µs | 39µs | BEGIN@19 | Kwalify::
1 | 1 | 1 | 4µs | 4µs | BEGIN@24 | Kwalify::
1 | 1 | 1 | 4µs | 4µs | BEGIN@45 | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | __ANON__[:143] | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | __ANON__[:144] | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | __ANON__[:145] | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | __ANON__[:146] | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | _base_path | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | _die | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | _error | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | validate_bool | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | validate_date | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | validate_float | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | validate_int | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | validate_number | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | validate_scalar | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | validate_text | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | validate_time | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | validate_timestamp | Kwalify::Validator::
0 | 0 | 0 | 0s | 0s | __ANON__[:27] | Kwalify::
0 | 0 | 0 | 0s | 0s | __ANON__[:28] | Kwalify::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # -*- mode: cperl; coding: latin-2 -*- | ||||
2 | |||||
3 | # | ||||
4 | # Author: Slaven Rezic | ||||
5 | # | ||||
6 | # Copyright (C) 2006,2007,2008,2009 Slaven Rezic. All rights reserved. | ||||
7 | # This package is free software; you can redistribute it and/or | ||||
8 | # modify it under the same terms as Perl itself. | ||||
9 | # | ||||
10 | # Mail: srezic@cpan.org | ||||
11 | # WWW: http://www.rezic.de/eserte/ | ||||
12 | # | ||||
13 | |||||
14 | package Kwalify; | ||||
15 | |||||
16 | 3 | 22µs | 2 | 20µs | # spent 17µs (13+3) within Kwalify::BEGIN@16 which was called:
# once (13µs+3µs) by Test::Fixture::DBIC::Schema::BEGIN@8 at line 16 # spent 17µs making 1 call to Kwalify::BEGIN@16
# spent 3µs making 1 call to strict::import |
17 | |||||
18 | 3 | 22µs | 2 | 150µs | # spent 79µs (8+71) within Kwalify::BEGIN@18 which was called:
# once (8µs+71µs) by Test::Fixture::DBIC::Schema::BEGIN@8 at line 18 # spent 79µs making 1 call to Kwalify::BEGIN@18
# spent 71µs making 1 call to base::import |
19 | 3 | 81µs | 2 | 71µs | # spent 39µs (7+32) within Kwalify::BEGIN@19 which was called:
# once (7µs+32µs) by Test::Fixture::DBIC::Schema::BEGIN@8 at line 19 # spent 39µs making 1 call to Kwalify::BEGIN@19
# spent 32µs making 1 call to vars::import |
20 | 1 | 2µs | @EXPORT_OK = qw(validate); | ||
21 | |||||
22 | 1 | 300ns | $VERSION = '1.21'; | ||
23 | |||||
24 | # spent 4µs within Kwalify::BEGIN@24 which was called:
# once (4µs+0s) by Test::Fixture::DBIC::Schema::BEGIN@8 at line 30 | ||||
25 | 1 | 5µs | if ($] < 5.006) { | ||
26 | $INC{"warnings.pm"} = 1; | ||||
27 | *warnings::import = sub { }; | ||||
28 | *warnings::unimport = sub { }; | ||||
29 | } | ||||
30 | 1 | 99µs | 1 | 4µs | } # spent 4µs making 1 call to Kwalify::BEGIN@24 |
31 | |||||
32 | # spent 4.76ms (23µs+4.73) within Kwalify::validate which was called:
# once (23µs+4.73ms) by Test::Fixture::DBIC::Schema::_validate_fixture at line 43 of Test/Fixture/DBIC/Schema.pm | ||||
33 | 1 | 1µs | my($schema, $data) = @_; | ||
34 | 1 | 6µs | 1 | 11µs | my $self = Kwalify::Validator->new; # spent 11µs making 1 call to Kwalify::Validator::new |
35 | 1 | 3µs | 1 | 4.72ms | $self->validate($schema, $data, "/"); # spent 4.72ms making 1 call to Kwalify::Validator::validate |
36 | 1 | 11µs | if (@{$self->{errors}}) { | ||
37 | die join("\n", map { " - $_" } @{$self->{errors}}) . "\n"; | ||||
38 | } else { | ||||
39 | 1 | 300ns | 1; | ||
40 | } | ||||
41 | } | ||||
42 | |||||
43 | package Kwalify::Validator; | ||||
44 | |||||
45 | 3 | 382µs | 1 | 4µs | # spent 4µs within Kwalify::Validator::BEGIN@45 which was called:
# once (4µs+0s) by Test::Fixture::DBIC::Schema::BEGIN@8 at line 45 # spent 4µs making 1 call to Kwalify::Validator::BEGIN@45 |
46 | |||||
47 | # spent 11µs within Kwalify::Validator::new which was called:
# once (11µs+0s) by Kwalify::validate at line 34 | ||||
48 | 1 | 700ns | my($class) = @_; | ||
49 | 1 | 12µs | bless { errors => [] }, $class; | ||
50 | } | ||||
51 | |||||
52 | # spent 4.72ms (7µs+4.71) within Kwalify::Validator::validate which was called:
# once (7µs+4.71ms) by Kwalify::validate at line 35 | ||||
53 | 1 | 1µs | my($self, $schema, $data, $path, $args) = @_; | ||
54 | 1 | 1µs | $self->{done} = {}; | ||
55 | 1 | 6µs | 1 | 4.71ms | $self->_validate($schema, $data, $path, $args); # spent 4.71ms making 1 call to Kwalify::Validator::_validate |
56 | } | ||||
57 | |||||
58 | # spent 4.71ms (626µs+4.09) within Kwalify::Validator::_validate which was called 89 times, avg 53µs/call:
# 66 times (449µs+-449µs) by Kwalify::Validator::validate_map at line 366, avg 0s/call
# 22 times (156µs+-156µs) by Kwalify::Validator::validate_seq at line 289, avg 0s/call
# once (21µs+4.69ms) by Kwalify::Validator::validate at line 55 | ||||
59 | 89 | 48µs | my($self, $schema, $data, $path, $args) = @_; | ||
60 | 89 | 25µs | $self->{path} = $path; | ||
61 | |||||
62 | 89 | 161µs | 89 | 43µs | if (!UNIVERSAL::isa($schema, "HASH")) { # spent 43µs making 89 calls to UNIVERSAL::isa, avg 489ns/call |
63 | $self->_die("Schema structure must be a hash reference"); | ||||
64 | } | ||||
65 | |||||
66 | 89 | 28µs | my $type = $schema->{type}; | ||
67 | 89 | 13µs | if (!defined $type) { | ||
68 | $type = 'str'; # default type; | ||||
69 | } | ||||
70 | 89 | 29µs | my $type_check_method = "validate_" . $type; | ||
71 | 89 | 197µs | 89 | 63µs | if (!$self->can($type_check_method)) { # spent 63µs making 89 calls to UNIVERSAL::can, avg 706ns/call |
72 | $self->_die("Invalid or unimplemented type '$type'"); | ||||
73 | } | ||||
74 | |||||
75 | 89 | 228µs | 89 | 9.81ms | $self->$type_check_method($schema, $data, $path, $args); # spent 4.69ms making 1 call to Kwalify::Validator::validate_seq
# spent 4.24ms making 22 calls to Kwalify::Validator::validate_map, avg 193µs/call
# spent 624µs making 44 calls to Kwalify::Validator::validate_str, avg 14µs/call
# spent 256µs making 22 calls to Kwalify::Validator::validate_any, avg 12µs/call |
76 | } | ||||
77 | |||||
78 | sub _additional_rules { | ||||
79 | 66 | 31µs | my($self, $schema, $data, $path) = @_; | ||
80 | 66 | 144µs | for my $schema_key (keys %$schema) { | ||
81 | 132 | 106µs | if (defined $schema->{$schema_key}) { | ||
82 | 132 | 360µs | 132 | 130µs | if ($schema_key eq 'pattern') { # spent 130µs making 132 calls to Kwalify::Validator::CORE:match, avg 987ns/call |
83 | (my $pattern = $schema->{pattern}) =~ s{^/(.*)/$}{$1}; | ||||
84 | if ($data !~ qr{$pattern}) { | ||||
85 | $self->_error("Non-valid data '$data' does not match /$pattern/"); | ||||
86 | } | ||||
87 | } elsif ($schema_key eq 'length') { | ||||
88 | if (!UNIVERSAL::isa($schema->{'length'}, "HASH")) { | ||||
89 | $self->_die("'length' must be a hash with keys max and/or min"); | ||||
90 | } | ||||
91 | my $length = length($data); | ||||
92 | for my $sub_schema_key (keys %{ $schema->{'length'} }) { | ||||
93 | if ($sub_schema_key eq 'min') { | ||||
94 | my $min = $schema->{'length'}->{min}; | ||||
95 | if ($length < $min) { | ||||
96 | $self->_error("'$data' is too short (length $length < min $min)"); | ||||
97 | } | ||||
98 | } elsif ($sub_schema_key eq 'min-ex') { | ||||
99 | my $min = $schema->{'length'}->{'min-ex'}; | ||||
100 | if ($length <= $min) { | ||||
101 | $self->_error("'$data' is too short (length $length <= min $min)"); | ||||
102 | } | ||||
103 | } elsif ($sub_schema_key eq 'max') { | ||||
104 | my $max = $schema->{'length'}->{max}; | ||||
105 | if ($length > $max) { | ||||
106 | $self->_error("'$data' is too long (length $length > max $max)"); | ||||
107 | } | ||||
108 | } elsif ($sub_schema_key eq 'max-ex') { | ||||
109 | my $max = $schema->{'length'}->{'max-ex'}; | ||||
110 | if ($length >= $max) { | ||||
111 | $self->_error("'$data' is too long (length $length >= max $max)"); | ||||
112 | } | ||||
113 | } else { | ||||
114 | $self->_die("Unexpected key '$sub_schema_key' in length specification, expected min, max, min-ex and/or max-ex"); | ||||
115 | } | ||||
116 | } | ||||
117 | } elsif ($schema_key eq 'enum') { | ||||
118 | if (!UNIVERSAL::isa($schema->{enum}, 'ARRAY')) { | ||||
119 | $self->_die("'enum' must be an array"); | ||||
120 | } | ||||
121 | 3 | 98µs | 2 | 39µs | # spent 24µs (8+15) within Kwalify::Validator::BEGIN@121 which was called:
# once (8µs+15µs) by Test::Fixture::DBIC::Schema::BEGIN@8 at line 121 # spent 24µs making 1 call to Kwalify::Validator::BEGIN@121
# spent 15µs making 1 call to warnings::unimport |
122 | my %valid = map { ($_,1) } @{ $schema->{enum} }; | ||||
123 | if (!exists $valid{$data}) { | ||||
124 | $self->_error("'$data': invalid " . _base_path($path) . " value"); | ||||
125 | } | ||||
126 | } elsif ($schema_key eq 'range') { | ||||
127 | if (!UNIVERSAL::isa($schema->{range}, "HASH")) { | ||||
128 | $self->_die("'range' must be a hash with keys max and/or min"); | ||||
129 | } | ||||
130 | my($lt, $le, $gt, $ge); | ||||
131 | ## yes? no? | ||||
132 | # if (eval { require Scalar::Util; defined &Scalar::Util::looks_like_number }) { | ||||
133 | # if (Scalar::Util::looks_like_number($data)) { | ||||
134 | # $lt = sub { $_[0] < $_[1] }; | ||||
135 | # $gt = sub { $_[0] > $_[1] }; | ||||
136 | # } else { | ||||
137 | # $lt = sub { $_[0] lt $_[1] }; | ||||
138 | # $gt = sub { $_[0] gt $_[1] }; | ||||
139 | # } | ||||
140 | # } else { | ||||
141 | # warn "Cannot determine whether $data is a number, assume so..."; # XXX show only once | ||||
142 | 3 | 1.41ms | 2 | 24µs | # spent 17µs (10+7) within Kwalify::Validator::BEGIN@142 which was called:
# once (10µs+7µs) by Test::Fixture::DBIC::Schema::BEGIN@8 at line 142 # spent 17µs making 1 call to Kwalify::Validator::BEGIN@142
# spent 7µs making 1 call to warnings::unimport |
143 | $lt = sub { $_[0] < $_[1] }; | ||||
144 | $gt = sub { $_[0] > $_[1] }; | ||||
145 | $le = sub { $_[0] <= $_[1] }; | ||||
146 | $ge = sub { $_[0] >= $_[1] }; | ||||
147 | # } | ||||
148 | |||||
149 | for my $sub_schema_key (keys %{ $schema->{range} }) { | ||||
150 | if ($sub_schema_key eq 'min') { | ||||
151 | my $min = $schema->{range}->{min}; | ||||
152 | if ($lt->($data, $min)) { | ||||
153 | $self->_error("'$data' is too small (< min $min)"); | ||||
154 | } | ||||
155 | } elsif ($sub_schema_key eq 'min-ex') { | ||||
156 | my $min = $schema->{range}->{'min-ex'}; | ||||
157 | if ($le->($data, $min)) { | ||||
158 | $self->_error("'$data' is too small (<= min $min)"); | ||||
159 | } | ||||
160 | } elsif ($sub_schema_key eq 'max') { | ||||
161 | my $max = $schema->{range}->{max}; | ||||
162 | if ($gt->($data, $max)) { | ||||
163 | $self->_error("'$data' is too large (> max $max)"); | ||||
164 | } | ||||
165 | } elsif ($sub_schema_key eq 'max-ex') { | ||||
166 | my $max = $schema->{range}->{'max-ex'}; | ||||
167 | if ($ge->($data, $max)) { | ||||
168 | $self->_error("'$data' is too large (>= max $max)"); | ||||
169 | } | ||||
170 | } else { | ||||
171 | $self->_die("Unexpected key '$sub_schema_key' in range specification, expected min, max, min-ex and/or max-ex"); | ||||
172 | } | ||||
173 | } | ||||
174 | } elsif ($schema_key eq 'assert') { | ||||
175 | $self->_die("'assert' is not yet implemented"); | ||||
176 | } elsif ($schema_key !~ m{^(type|required|unique|name|classname|class|desc)$}) { | ||||
177 | $self->_die("Unexpected key '$schema_key' in type specification"); | ||||
178 | } | ||||
179 | } | ||||
180 | } | ||||
181 | } | ||||
182 | |||||
183 | sub validate_text { | ||||
184 | my($self, $schema, $data, $path) = @_; | ||||
185 | if (!defined $data || ref $data) { | ||||
186 | return $self->_error("Non-valid data '" . (defined $data ? $data : 'undef') . "', expected text"); | ||||
187 | } | ||||
188 | $self->_additional_rules($schema, $data, $path); | ||||
189 | } | ||||
190 | |||||
191 | # spent 624µs (191+433) within Kwalify::Validator::validate_str which was called 44 times, avg 14µs/call:
# 44 times (191µs+433µs) by Kwalify::Validator::_validate at line 75, avg 14µs/call | ||||
192 | 44 | 22µs | my($self, $schema, $data, $path) = @_; | ||
193 | 44 | 95µs | 44 | 32µs | if (!defined $data || ref $data || $data =~ m{^\d+(\.\d+)?$}) { # spent 32µs making 44 calls to Kwalify::Validator::CORE:match, avg 725ns/call |
194 | return $self->_error("Non-valid data '" . (defined $data ? $data : 'undef') . "', expected a str"); | ||||
195 | } | ||||
196 | 44 | 103µs | 44 | 402µs | $self->_additional_rules($schema, $data, $path); # spent 402µs making 44 calls to Kwalify::Validator::_additional_rules, avg 9µs/call |
197 | } | ||||
198 | |||||
199 | sub validate_int { | ||||
200 | my($self, $schema, $data, $path) = @_; | ||||
201 | if ($data !~ m{^[+-]?\d+$}) { # XXX what about scientific notation? | ||||
202 | $self->_error("Non-valid data '" . $data . "', expected an int"); | ||||
203 | } | ||||
204 | $self->_additional_rules($schema, $data, $path); | ||||
205 | } | ||||
206 | |||||
207 | sub validate_float { | ||||
208 | my($self, $schema, $data, $path) = @_; | ||||
209 | if ($data !~ m{^[+-]?\d+\.\d+$}) { # XXX other values? | ||||
210 | $self->_error("Non-valid data '" . $data . "', expected a float"); | ||||
211 | } | ||||
212 | $self->_additional_rules($schema, $data, $path); | ||||
213 | } | ||||
214 | |||||
215 | sub validate_number { | ||||
216 | my($self, $schema, $data, $path) = @_; | ||||
217 | if ($data !~ m{^[+-]?\d+(\.\d+)?$}) { # XXX combine int+float regexp! | ||||
218 | $self->_error("Non-valid data '" . $data . "', expected a number"); | ||||
219 | } | ||||
220 | $self->_additional_rules($schema, $data, $path); | ||||
221 | } | ||||
222 | |||||
223 | sub validate_bool { | ||||
224 | my($self, $schema, $data, $path) = @_; | ||||
225 | if ($data !~ m{^(yes|true|1|no|false|0)$}) { # XXX correct? | ||||
226 | $self->_error("Non-valid data '" . $data . "', expected a boolean"); | ||||
227 | } | ||||
228 | $self->_additional_rules($schema, $data, $path); | ||||
229 | } | ||||
230 | |||||
231 | # XXX is this correct? | ||||
232 | sub validate_scalar { | ||||
233 | shift->validate_text(@_); | ||||
234 | } | ||||
235 | |||||
236 | sub validate_date { | ||||
237 | my($self, $schema, $data, $path) = @_; | ||||
238 | if ($data !~ m{^\d{4}-\d{2}-\d{2}$}) { | ||||
239 | $self->_error("Non-valid data '" . $data . "', expected a date (YYYY-MM-DD)"); | ||||
240 | } | ||||
241 | $self->_additional_rules($schema, $data, $path); | ||||
242 | } | ||||
243 | |||||
244 | sub validate_time { | ||||
245 | my($self, $schema, $data, $path) = @_; | ||||
246 | if ($data !~ m{^\d{2}:\d{2}:\d{2}$}) { | ||||
247 | $self->_error("Non-valid data '" . $data . "', expected a time (HH:MM:SS)"); | ||||
248 | } | ||||
249 | $self->_additional_rules($schema, $data, $path); | ||||
250 | } | ||||
251 | |||||
252 | sub validate_timestamp { | ||||
253 | my($self) = @_; | ||||
254 | $self->_error("timestamp validation NYI"); # XXX | ||||
255 | } | ||||
256 | |||||
257 | # spent 256µs (63+194) within Kwalify::Validator::validate_any which was called 22 times, avg 12µs/call:
# 22 times (63µs+194µs) by Kwalify::Validator::_validate at line 75, avg 12µs/call | ||||
258 | 22 | 10µs | my($self, $schema, $data, $path) = @_; | ||
259 | 22 | 50µs | 22 | 194µs | $self->_additional_rules($schema, $data, $path); # spent 194µs making 22 calls to Kwalify::Validator::_additional_rules, avg 9µs/call |
260 | } | ||||
261 | |||||
262 | # spent 4.69ms (142µs+4.55) within Kwalify::Validator::validate_seq which was called:
# once (142µs+4.55ms) by Kwalify::Validator::_validate at line 75 | ||||
263 | 1 | 1µs | my($self, $schema, $data, $path) = @_; | ||
264 | 1 | 800ns | if (!exists $schema->{sequence}) { | ||
265 | $self->_die("'sequence' missing with 'seq' type"); | ||||
266 | } | ||||
267 | 1 | 600ns | my $sequence = $schema->{sequence}; | ||
268 | 1 | 3µs | 1 | 500ns | if (!UNIVERSAL::isa($sequence, 'ARRAY')) { # spent 500ns making 1 call to UNIVERSAL::isa |
269 | $self->_die("Expected array in 'sequence'"); | ||||
270 | } | ||||
271 | 1 | 1µs | if (@$sequence != 1) { | ||
272 | $self->_die("Expect exactly one element in sequence"); | ||||
273 | } | ||||
274 | 1 | 3µs | 1 | 500ns | if (!UNIVERSAL::isa($data, 'ARRAY')) { # spent 500ns making 1 call to UNIVERSAL::isa |
275 | $self->_error("Non-valid data " . $data . ", expected sequence"); | ||||
276 | return; | ||||
277 | } | ||||
278 | |||||
279 | 1 | 5µs | 2 | 36µs | return if ($self->{done}{overload::StrVal($data)}{overload::StrVal($schema)}); # spent 36µs making 2 calls to overload::AddrRef, avg 18µs/call |
280 | 1 | 3µs | 2 | 17µs | $self->{done}{overload::StrVal($data)}{overload::StrVal($schema)} = 1; # spent 17µs making 2 calls to overload::AddrRef, avg 9µs/call |
281 | |||||
282 | 1 | 800ns | my $subschema = $sequence->[0]; | ||
283 | 1 | 4µs | 1 | 3µs | my $unique = _get_boolean($subschema->{unique}); # spent 3µs making 1 call to Kwalify::Validator::_get_boolean |
284 | 1 | 200ns | my %unique_val; | ||
285 | 1 | 400ns | my %unique_mapping_val; | ||
286 | 1 | 300ns | my $index = 0; | ||
287 | 1 | 6µs | for my $elem (@$data) { | ||
288 | 22 | 23µs | 22 | 73µs | my $subpath = _append_path($path, $index); # spent 73µs making 22 calls to Kwalify::Validator::_append_path, avg 3µs/call |
289 | 22 | 47µs | 22 | 0s | $self->_validate($subschema, $elem, $subpath, { unique_mapping_val => \%unique_mapping_val}); # spent 4.42ms making 22 calls to Kwalify::Validator::_validate, avg 201µs/call, recursion: max depth 1, sum of overlapping time 4.42ms |
290 | 22 | 3µs | if ($unique) { | ||
291 | if (exists $unique_val{$elem}) { | ||||
292 | $self->_error("'$elem' is already used at '$unique_val{$elem}'"); | ||||
293 | } else { | ||||
294 | $unique_val{$elem} = $subpath; | ||||
295 | } | ||||
296 | } | ||||
297 | 22 | 9µs | $index++; | ||
298 | } | ||||
299 | } | ||||
300 | |||||
301 | # spent 4.24ms (1.28+2.96) within Kwalify::Validator::validate_map which was called 22 times, avg 193µs/call:
# 22 times (1.28ms+2.96ms) by Kwalify::Validator::_validate at line 75, avg 193µs/call | ||||
302 | 22 | 11µs | my($self, $schema, $data, $path, $args) = @_; | ||
303 | 22 | 3µs | my $unique_mapping_val; | ||
304 | 22 | 10µs | if ($args && $args->{unique_mapping_val}) { | ||
305 | $unique_mapping_val = $args->{unique_mapping_val}; | ||||
306 | } | ||||
307 | 22 | 6µs | if (!exists $schema->{mapping}) { | ||
308 | $self->_die("'mapping' missing with 'map' type"); | ||||
309 | } | ||||
310 | 22 | 5µs | my $mapping = $schema->{mapping}; | ||
311 | 22 | 38µs | 22 | 10µs | if (!UNIVERSAL::isa($mapping, 'HASH')) { # spent 10µs making 22 calls to UNIVERSAL::isa, avg 441ns/call |
312 | $self->_die("Expected hash in 'mapping'"); | ||||
313 | } | ||||
314 | 22 | 3µs | if (!defined $data) { | ||
315 | $self->_error("Undefined data, expected mapping"); | ||||
316 | return; | ||||
317 | } | ||||
318 | 22 | 37µs | 22 | 9µs | if (!UNIVERSAL::isa($data, 'HASH')) { # spent 9µs making 22 calls to UNIVERSAL::isa, avg 414ns/call |
319 | $self->_error("Non-valid data " . $data . ", expected mapping"); | ||||
320 | return; | ||||
321 | } | ||||
322 | |||||
323 | 22 | 58µs | 44 | 403µs | return if ($self->{done}{overload::StrVal($data)}{overload::StrVal($schema)}); # spent 403µs making 44 calls to overload::AddrRef, avg 9µs/call |
324 | 22 | 67µs | 44 | 376µs | $self->{done}{overload::StrVal($data)}{overload::StrVal($schema)} = 1; # spent 376µs making 44 calls to overload::AddrRef, avg 9µs/call |
325 | |||||
326 | 22 | 3µs | my %seen_key; | ||
327 | 22 | 3µs | my $default_key_schema; | ||
328 | |||||
329 | ## Originally this was an each-loop, but this could lead into | ||||
330 | ## endless recursions, because mapping may be reused in Kwalify, | ||||
331 | ## thus the each iterator was shared between recursion levels. | ||||
332 | # while(my($key,$subschema) = each %$mapping) { | ||||
333 | 22 | 25µs | for my $key (keys %$mapping) { | ||
334 | 66 | 19µs | my $subschema = $mapping->{$key}; | ||
335 | 66 | 14µs | if ($key eq '=') { # the "default" key | ||
336 | $default_key_schema = $subschema; | ||||
337 | next; | ||||
338 | } | ||||
339 | 66 | 74µs | 66 | 213µs | my $subpath = _append_path($path, $key); # spent 213µs making 66 calls to Kwalify::Validator::_append_path, avg 3µs/call |
340 | 66 | 22µs | $self->{path} = $subpath; | ||
341 | 66 | 118µs | 66 | 35µs | if (!UNIVERSAL::isa($subschema, 'HASH')) { # spent 35µs making 66 calls to UNIVERSAL::isa, avg 529ns/call |
342 | $self->_die("Expected subschema (a hash)"); | ||||
343 | } | ||||
344 | 66 | 77µs | 66 | 236µs | my $required = _get_boolean($subschema->{required}); # spent 236µs making 66 calls to Kwalify::Validator::_get_boolean, avg 4µs/call |
345 | 66 | 19µs | if (!exists $data->{$key}) { | ||
346 | if ($required) { | ||||
347 | $self->{path} = $path; | ||||
348 | $self->_error("Expected required key '$key'"); | ||||
349 | next; | ||||
350 | } else { | ||||
351 | next; | ||||
352 | } | ||||
353 | } | ||||
354 | 66 | 99µs | 66 | 82µs | my $unique = _get_boolean($subschema->{unique}); # spent 82µs making 66 calls to Kwalify::Validator::_get_boolean, avg 1µs/call |
355 | 66 | 8µs | if ($unique) { | ||
356 | if (defined $unique_mapping_val->{$data->{$key}}->{val} | ||||
357 | && $unique_mapping_val->{$data->{$key}}->{val} eq $data->{$key}) { | ||||
358 | $self->_error("'$data->{$key}' is already used at '$unique_mapping_val->{$data->{$key}}->{path}'"); | ||||
359 | } else { | ||||
360 | $unique_mapping_val->{$data->{$key}} = { val => $data->{$key}, | ||||
361 | path => $subpath, | ||||
362 | }; | ||||
363 | } | ||||
364 | } | ||||
365 | |||||
366 | 66 | 87µs | 66 | 0s | $self->_validate($subschema, $data->{$key}, $subpath); # spent 1.41ms making 66 calls to Kwalify::Validator::_validate, avg 21µs/call, recursion: max depth 2, sum of overlapping time 1.41ms |
367 | 66 | 61µs | $seen_key{$key}++; | ||
368 | } | ||||
369 | |||||
370 | # while(my($key,$val) = each %$data) { | ||||
371 | 22 | 65µs | for my $key (keys %$data) { | ||
372 | 66 | 21µs | my $val = $data->{$key}; | ||
373 | 66 | 62µs | 66 | 188µs | my $subpath = _append_path($path, $key); # spent 188µs making 66 calls to Kwalify::Validator::_append_path, avg 3µs/call |
374 | 66 | 18µs | $self->{path} = $subpath; | ||
375 | 66 | 35µs | if (!$seen_key{$key}) { | ||
376 | if ($default_key_schema) { | ||||
377 | $self->_validate($default_key_schema, $val, $subpath); | ||||
378 | } else { | ||||
379 | $self->_error("Unexpected key '$key'"); | ||||
380 | } | ||||
381 | } | ||||
382 | } | ||||
383 | } | ||||
384 | |||||
385 | sub _die { | ||||
386 | my($self, $msg) = @_; | ||||
387 | $msg = "[$self->{path}] $msg"; | ||||
388 | die $msg."\n"; | ||||
389 | } | ||||
390 | |||||
391 | sub _error { | ||||
392 | my($self, $msg) = @_; | ||||
393 | $msg = "[$self->{path}] $msg"; | ||||
394 | push @{$self->{errors}}, $msg; | ||||
395 | 0; | ||||
396 | } | ||||
397 | |||||
398 | # Functions: | ||||
399 | # spent 475µs (429+46) within Kwalify::Validator::_append_path which was called 154 times, avg 3µs/call:
# 66 times (194µs+19µs) by Kwalify::Validator::validate_map at line 339, avg 3µs/call
# 66 times (172µs+16µs) by Kwalify::Validator::validate_map at line 373, avg 3µs/call
# 22 times (63µs+10µs) by Kwalify::Validator::validate_seq at line 288, avg 3µs/call | ||||
400 | 154 | 58µs | my($root, $leaf) = @_; | ||
401 | 154 | 514µs | 154 | 46µs | $root . ($root !~ m{/$} ? "/" : "") . $leaf; # spent 46µs making 154 calls to Kwalify::Validator::CORE:match, avg 296ns/call |
402 | } | ||||
403 | |||||
404 | sub _base_path { | ||||
405 | my($path) = @_; | ||||
406 | my($base) = $path =~ m{([^/]+)$}; | ||||
407 | $base; | ||||
408 | } | ||||
409 | |||||
410 | # spent 321µs (241+80) within Kwalify::Validator::_get_boolean which was called 133 times, avg 2µs/call:
# 66 times (155µs+80µs) by Kwalify::Validator::validate_map at line 344, avg 4µs/call
# 66 times (82µs+0s) by Kwalify::Validator::validate_map at line 354, avg 1µs/call
# once (3µs+0s) by Kwalify::Validator::validate_seq at line 283 | ||||
411 | 133 | 50µs | my($val) = @_; | ||
412 | 133 | 366µs | 66 | 80µs | defined $val && $val =~ m{^(yes|true|1)$}; # XXX check for all boolean trues # spent 80µs making 66 calls to Kwalify::Validator::CORE:match, avg 1µs/call |
413 | } | ||||
414 | |||||
415 | 1 | 4µs | 1; | ||
416 | __END__ | ||||
# spent 288µs within Kwalify::Validator::CORE:match which was called 396 times, avg 727ns/call:
# 154 times (46µs+0s) by Kwalify::Validator::_append_path at line 401, avg 296ns/call
# 132 times (130µs+0s) by Kwalify::Validator::_additional_rules at line 82, avg 987ns/call
# 66 times (80µs+0s) by Kwalify::Validator::_get_boolean at line 412, avg 1µs/call
# 44 times (32µs+0s) by Kwalify::Validator::validate_str at line 193, avg 725ns/call |