line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Perinci::Sub::ValidateArgs; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY |
4
|
|
|
|
|
|
|
our $DATE = '2020-02-05'; # DATE |
5
|
|
|
|
|
|
|
our $DIST = 'Perinci-Sub-ValidateArgs'; # DIST |
6
|
|
|
|
|
|
|
our $VERSION = '0.012'; # VERSION |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
101998
|
use 5.010001; |
|
1
|
|
|
|
|
11
|
|
9
|
1
|
|
|
1
|
|
5
|
use strict 'subs', 'vars'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
37
|
|
10
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
25
|
|
11
|
|
|
|
|
|
|
|
12
|
1
|
|
|
1
|
|
495
|
use Data::Dmp; |
|
1
|
|
|
|
|
1793
|
|
|
1
|
|
|
|
|
61
|
|
13
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
7
|
use Exporter qw(import); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1849
|
|
15
|
|
|
|
|
|
|
our @EXPORT_OK = qw(gen_args_validator_from_meta validate_args_using_meta); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# old name, deprecated |
18
|
|
|
|
|
|
|
*gen_args_validator = \&gen_args_validator_from_meta; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# XXX cache key should also contain data_term |
21
|
|
|
|
|
|
|
#my %dsah_compile_cache; # key = schema (C<string> or R<refaddr>), value = compilation result |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
our %SPEC; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
our %arg_meta = ( |
26
|
|
|
|
|
|
|
meta => { |
27
|
|
|
|
|
|
|
schema => 'hash*', # XXX rinci::function_meta |
28
|
|
|
|
|
|
|
req => 1, |
29
|
|
|
|
|
|
|
}, |
30
|
|
|
|
|
|
|
); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
our %argopt_meta = ( |
33
|
|
|
|
|
|
|
meta => { |
34
|
|
|
|
|
|
|
schema => 'hash*', # XXX rinci::function_meta |
35
|
|
|
|
|
|
|
description => <<'_', |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
If not specified, will be searched from caller's `%SPEC` package variable. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
_ |
40
|
|
|
|
|
|
|
}, |
41
|
|
|
|
|
|
|
); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
our %argopt_die = ( |
44
|
|
|
|
|
|
|
die => { |
45
|
|
|
|
|
|
|
summary => 'Whether validator should die or just return '. |
46
|
|
|
|
|
|
|
'an error message/response', |
47
|
|
|
|
|
|
|
schema => 'bool', |
48
|
|
|
|
|
|
|
}, |
49
|
|
|
|
|
|
|
); |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
our %args_gen_args = ( |
52
|
|
|
|
|
|
|
%argopt_meta, |
53
|
|
|
|
|
|
|
%argopt_die, |
54
|
|
|
|
|
|
|
source => { |
55
|
|
|
|
|
|
|
summary => 'Whether we want to get the source code instead', |
56
|
|
|
|
|
|
|
schema => 'bool', |
57
|
|
|
|
|
|
|
description => <<'_', |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
The default is to generate Perl validator code, compile it with `eval()`, and |
60
|
|
|
|
|
|
|
return the resulting coderef. When this option is set to true, the generated |
61
|
|
|
|
|
|
|
source string will be returned instead. |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
_ |
64
|
|
|
|
|
|
|
}, |
65
|
|
|
|
|
|
|
); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
$SPEC{gen_args_validator_from_meta} = { |
68
|
|
|
|
|
|
|
v => 1.1, |
69
|
|
|
|
|
|
|
summary => 'Generate argument validator from Rinci function metadata', |
70
|
|
|
|
|
|
|
description => <<'_', |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
If you don't intend to reuse the generated validator, you can also use |
73
|
|
|
|
|
|
|
`validate_args_using_meta`. |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
_ |
76
|
|
|
|
|
|
|
args => { |
77
|
|
|
|
|
|
|
%args_gen_args, |
78
|
|
|
|
|
|
|
}, |
79
|
|
|
|
|
|
|
result_naked => 1, |
80
|
|
|
|
|
|
|
}; |
81
|
|
|
|
|
|
|
sub gen_args_validator_from_meta { |
82
|
20
|
|
|
20
|
1
|
26554
|
my %args = @_; |
83
|
|
|
|
|
|
|
|
84
|
20
|
|
|
|
|
40
|
my $meta = $args{meta}; |
85
|
20
|
100
|
|
|
|
52
|
unless ($meta) { |
86
|
7
|
50
|
|
|
|
29
|
my @caller = caller(1) or die "Call gen_args_validator_from_meta() inside ". |
87
|
|
|
|
|
|
|
"your function or provide 'meta'"; |
88
|
7
|
|
|
|
|
226
|
my ($pkg, $func) = $caller[3] =~ /(.+)::(.+)/; |
89
|
7
|
50
|
|
|
|
15
|
$meta = ${"$pkg\::SPEC"}{$func} |
|
7
|
|
|
|
|
40
|
|
90
|
|
|
|
|
|
|
or die "No metadata for $caller[3]"; |
91
|
|
|
|
|
|
|
} |
92
|
20
|
|
100
|
|
|
84
|
my $args_as = $meta->{args_as} // 'hash'; |
93
|
20
|
|
100
|
|
|
74
|
my $meta_args = $meta->{args} // {}; |
94
|
20
|
|
|
|
|
100
|
my @meta_args = sort keys %$meta_args; |
95
|
|
|
|
|
|
|
|
96
|
20
|
|
|
|
|
77
|
my @code; |
97
|
|
|
|
|
|
|
my @modules_for_all_args; |
98
|
20
|
|
|
|
|
0
|
my @mod_stmts; |
99
|
|
|
|
|
|
|
|
100
|
20
|
|
|
|
|
0
|
my $use_dpath; |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
my $gencode_err = sub { |
103
|
72
|
|
|
72
|
|
159
|
my ($status, $term_msg) = @_; |
104
|
72
|
100
|
|
|
|
194
|
if ($args{die}) { |
|
|
100
|
|
|
|
|
|
105
|
16
|
|
|
|
|
61
|
return "die $term_msg;"; |
106
|
|
|
|
|
|
|
} elsif ($meta->{result_naked}) { |
107
|
|
|
|
|
|
|
# perhaps if result_naked=1, die by default? |
108
|
4
|
|
|
|
|
14
|
return "return $term_msg;"; |
109
|
|
|
|
|
|
|
} else { |
110
|
52
|
|
|
|
|
222
|
return "return [$status, $term_msg];"; |
111
|
|
|
|
|
|
|
} |
112
|
20
|
|
|
|
|
94
|
}; |
113
|
|
|
|
|
|
|
my $addcode_validator = sub { |
114
|
38
|
|
|
38
|
|
65
|
state $plc = do { |
115
|
19
|
|
|
|
|
919
|
require Data::Sah; |
116
|
19
|
|
|
|
|
7849
|
Data::Sah->new->get_compiler("perl"); |
117
|
|
|
|
|
|
|
}; |
118
|
38
|
|
|
|
|
34490
|
my ($schema, $data_name, $data_term) = @_; |
119
|
38
|
|
|
|
|
65
|
my $cd; |
120
|
38
|
100
|
|
|
|
126
|
my $cache_key = ref($schema) ? "R$schema" : "S$schema"; |
121
|
|
|
|
|
|
|
#unless ($cd = $dsah_compile_cache{$cache_key}) { |
122
|
38
|
|
|
|
|
117
|
$cd = $plc->compile( |
123
|
|
|
|
|
|
|
schema => $schema, |
124
|
|
|
|
|
|
|
data_name => $data_name, |
125
|
|
|
|
|
|
|
data_term => $data_term, |
126
|
|
|
|
|
|
|
err_term => '$err', |
127
|
|
|
|
|
|
|
return_type => 'str', |
128
|
|
|
|
|
|
|
indent_level => 2, |
129
|
|
|
|
|
|
|
); |
130
|
38
|
50
|
|
|
|
241546
|
die "Incompatible Data::Sah version (cd v=$cd->{v}, expected 2)" unless $cd->{v} == 2; |
131
|
|
|
|
|
|
|
# $dsah_compile_cache{$cache_key} = $cd; |
132
|
|
|
|
|
|
|
#} |
133
|
38
|
|
|
|
|
93
|
push @code, " \$err = undef;\n"; |
134
|
38
|
100
|
|
|
|
136
|
push @code, " \$_sahv_dpath = [];\n" if $cd->{use_dpath}; |
135
|
38
|
|
|
|
|
67
|
push @code, " unless (\n"; |
136
|
38
|
|
|
|
|
129
|
push @code, $cd->{result}, ") { ".$gencode_err->(400, "\"Validation failed for argument '$data_name': \$err\"")." }\n"; |
137
|
38
|
|
|
|
|
75
|
for my $mod_rec (@{ $cd->{modules} }) { |
|
38
|
|
|
|
|
97
|
|
138
|
150
|
100
|
|
|
|
650
|
next unless $mod_rec->{phase} eq 'runtime'; |
139
|
94
|
100
|
|
|
|
165
|
next if grep { ($mod_rec->{use_statement} && $_->{use_statement} && $_->{use_statement} eq $mod_rec->{use_statement}) || |
140
|
149
|
100
|
100
|
|
|
756
|
$_->{name} eq $mod_rec->{name} } @modules_for_all_args; |
|
|
|
66
|
|
|
|
|
141
|
56
|
|
|
|
|
95
|
push @modules_for_all_args, $mod_rec; |
142
|
56
|
|
|
|
|
158
|
push @mod_stmts, $plc->stmt_require_module($mod_rec)."\n"; |
143
|
|
|
|
|
|
|
} |
144
|
38
|
100
|
|
|
|
563
|
if ($cd->{use_dpath}) { |
145
|
18
|
|
|
|
|
374
|
$use_dpath = 1; |
146
|
|
|
|
|
|
|
} |
147
|
20
|
|
|
|
|
90
|
}; |
148
|
|
|
|
|
|
|
|
149
|
20
|
100
|
100
|
|
|
102
|
if ($args_as eq 'hash' || $args_as eq 'hashref') { |
|
|
50
|
66
|
|
|
|
|
150
|
15
|
|
|
|
|
31
|
push @code, " # check unknown args\n"; |
151
|
15
|
|
|
|
|
35
|
push @code, " for (keys %\$args) { unless (/\\A(".join("|", map { quotemeta } @meta_args).")\\z/) { ".$gencode_err->(400, '"Unknown argument \'$_\'"')." } }\n"; |
|
28
|
|
|
|
|
101
|
|
152
|
15
|
|
|
|
|
43
|
push @code, "\n"; |
153
|
|
|
|
|
|
|
|
154
|
15
|
|
|
|
|
33
|
for my $arg_name (@meta_args) { |
155
|
28
|
|
|
|
|
59
|
my $arg_spec = $meta_args->{$arg_name}; |
156
|
28
|
|
|
|
|
53
|
my $term_arg = "\$args->{'$arg_name'}"; |
157
|
28
|
|
|
|
|
59
|
push @code, " # check argument $arg_name\n"; |
158
|
28
|
100
|
|
|
|
82
|
if (defined $arg_spec->{default}) { |
159
|
14
|
|
|
|
|
51
|
push @code, " $term_arg //= ".dmp($arg_spec->{default}).";\n"; |
160
|
|
|
|
|
|
|
} |
161
|
28
|
|
|
|
|
887
|
push @code, " if (exists $term_arg) {\n"; |
162
|
28
|
50
|
|
|
|
115
|
$addcode_validator->($arg_spec->{schema}, $arg_name, $term_arg) if $arg_spec->{schema}; |
163
|
28
|
100
|
|
|
|
100
|
if ($arg_spec->{req}) { |
164
|
14
|
|
|
|
|
55
|
push @code, " } else {\n"; |
165
|
14
|
|
|
|
|
48
|
push @code, " ".$gencode_err->(400, "\"Missing required argument '$arg_name'\"")."\n"; |
166
|
|
|
|
|
|
|
} |
167
|
28
|
|
|
|
|
70
|
push @code, " }\n"; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
15
|
100
|
|
|
|
45
|
push @code, "\n" if @meta_args; |
171
|
|
|
|
|
|
|
} elsif ($args_as eq 'array' || $args_as eq 'arrayref') { |
172
|
|
|
|
|
|
|
# map the arguments' position |
173
|
|
|
|
|
|
|
my @arg_names = sort { |
174
|
5
|
|
50
|
|
|
57
|
($meta_args->{$a}{pos}//9999) <=> ($meta_args->{$b}{pos}//9999) |
|
5
|
|
50
|
|
|
35
|
|
175
|
|
|
|
|
|
|
} keys %$meta_args; |
176
|
5
|
100
|
66
|
|
|
43
|
if (@arg_names && ($meta_args->{$arg_names[-1]}{slurpy} // $meta_args->{$arg_names[-1]}{greedy})) { |
|
|
|
66
|
|
|
|
|
177
|
4
|
|
|
|
|
11
|
my $pos = @arg_names - 1; |
178
|
4
|
|
|
|
|
10
|
push @code, " # handle slurpy last arg\n"; |
179
|
4
|
|
|
|
|
17
|
push @code, " if (\@\$args >= $pos) { \$args->[$pos] = [splice \@\$args, $pos] }\n\n"; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
5
|
|
|
|
|
9
|
my $start_of_optional; |
183
|
5
|
|
|
|
|
16
|
for my $i (0..$#arg_names) { |
184
|
10
|
|
|
|
|
16
|
my $arg_name = $arg_names[$i]; |
185
|
10
|
|
|
|
|
19
|
my $arg_spec = $meta_args->{$arg_name}; |
186
|
10
|
100
|
|
|
|
21
|
if ($arg_spec->{req}) { |
187
|
5
|
50
|
|
|
|
19
|
if (defined $start_of_optional) { |
188
|
0
|
|
|
|
|
0
|
die "Error in metadata: after a param is optional ". |
189
|
|
|
|
|
|
|
"(#$start_of_optional) the rest (#$i) must also be optional"; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
} else { |
192
|
5
|
|
33
|
|
|
32
|
$start_of_optional //= $i; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
5
|
|
|
|
|
13
|
push @code, " # check number of args\n"; |
197
|
5
|
50
|
|
|
|
13
|
if ($start_of_optional) { |
|
|
0
|
|
|
|
|
|
198
|
5
|
|
|
|
|
30
|
push @code, " if (\@\$args < $start_of_optional || \@\$args > ".(@arg_names).") { ".$gencode_err->(400, "\"Wrong number of arguments (expected $start_of_optional..".(@arg_names).", got \".(\@\$args).\")\"") . " }\n"; |
199
|
|
|
|
|
|
|
} elsif (defined $start_of_optional) { |
200
|
0
|
|
|
|
|
0
|
push @code, " if (\@\$args > ".(@arg_names).") { ".$gencode_err->(400, "\"Wrong number of arguments (expected 0..".(@arg_names).", got \".(\@\$args).\")\"") . " }\n"; |
201
|
|
|
|
|
|
|
} else { |
202
|
0
|
|
|
|
|
0
|
push @code, " if (\@\$args != ".(@arg_names).") { ".$gencode_err->(400, "\"Wrong number of arguments (expected ".(@arg_names).", got \".(\@\$args).\")\"") . " }\n"; |
203
|
|
|
|
|
|
|
} |
204
|
5
|
|
|
|
|
13
|
push @code, "\n"; |
205
|
|
|
|
|
|
|
|
206
|
5
|
|
|
|
|
13
|
for my $i (0..$#arg_names) { |
207
|
10
|
|
|
|
|
18
|
my $arg_name = $arg_names[$i]; |
208
|
10
|
|
|
|
|
19
|
my $arg_spec = $meta_args->{$arg_name}; |
209
|
10
|
|
|
|
|
23
|
my $term_arg = "\$args->[$i]"; |
210
|
10
|
50
|
66
|
|
|
77
|
if (!defined($arg_spec->{pos})) { |
|
|
50
|
66
|
|
|
|
|
|
|
50
|
|
|
|
|
|
211
|
0
|
|
|
|
|
0
|
die "Error in metadata: argument '$arg_name' does not ". |
212
|
|
|
|
|
|
|
"have pos property set"; |
213
|
|
|
|
|
|
|
} elsif ($arg_spec->{pos} != $i) { |
214
|
0
|
|
|
|
|
0
|
die "Error in metadata: argument '$arg_name' does not ". |
215
|
|
|
|
|
|
|
"the correct pos value ($arg_spec->{pos}, should be $i)"; |
216
|
|
|
|
|
|
|
} elsif (($arg_spec->{slurpy} // $arg_spec->{greedy}) && $i < $#arg_names) { |
217
|
0
|
|
|
|
|
0
|
die "Error in metadata: argument '$arg_name' has slurpy=1 ". |
218
|
|
|
|
|
|
|
"but is not the last argument"; |
219
|
|
|
|
|
|
|
} |
220
|
10
|
|
|
|
|
29
|
push @code, " # check argument $arg_name\n"; |
221
|
10
|
100
|
|
|
|
26
|
if (defined $arg_spec->{default}) { |
222
|
5
|
|
|
|
|
20
|
push @code, " $term_arg //= ".dmp($arg_spec->{default}).";\n"; |
223
|
|
|
|
|
|
|
} |
224
|
10
|
|
|
|
|
281
|
my $open_block; |
225
|
10
|
100
|
66
|
|
|
42
|
if (defined($start_of_optional) && $i >= $start_of_optional) { |
226
|
5
|
|
|
|
|
9
|
$open_block++; |
227
|
5
|
|
|
|
|
12
|
push @code, " if (\@\$args > $i) {\n"; |
228
|
|
|
|
|
|
|
} |
229
|
10
|
50
|
|
|
|
41
|
$addcode_validator->($arg_spec->{schema}, $arg_name, $term_arg) if $arg_spec->{schema}; |
230
|
10
|
100
|
|
|
|
37
|
push @code, " }\n" if $open_block; |
231
|
|
|
|
|
|
|
|
232
|
10
|
|
|
|
|
40
|
push @code, "\n"; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
} else { |
235
|
0
|
|
|
|
|
0
|
die "Unsupported args_as '$args_as'"; |
236
|
|
|
|
|
|
|
} |
237
|
20
|
|
|
|
|
46
|
push @code, " return undef;\n"; |
238
|
20
|
|
|
|
|
37
|
push @code, "}\n"; |
239
|
|
|
|
|
|
|
|
240
|
20
|
|
|
|
|
66
|
unshift @code, ( |
241
|
|
|
|
|
|
|
"sub {\n", |
242
|
|
|
|
|
|
|
" my \$args = shift;\n", |
243
|
|
|
|
|
|
|
" my \$err;\n", |
244
|
|
|
|
|
|
|
(" my \$_sahv_dpath;\n") x !!$use_dpath, |
245
|
|
|
|
|
|
|
"\n" |
246
|
|
|
|
|
|
|
); |
247
|
|
|
|
|
|
|
|
248
|
20
|
|
|
|
|
122
|
my $code = join("", @mod_stmts, @code); |
249
|
20
|
100
|
|
|
|
51
|
if ($args{source}) { |
250
|
1
|
|
|
|
|
18
|
return $code; |
251
|
|
|
|
|
|
|
} else { |
252
|
|
|
|
|
|
|
#use String::LineNumber 'linenum'; say linenum $code; |
253
|
1
|
|
|
1
|
|
8
|
my $sub = eval $code; |
|
1
|
|
|
1
|
|
2
|
|
|
1
|
|
|
1
|
|
731
|
|
|
1
|
|
|
1
|
|
8
|
|
|
1
|
|
|
1
|
|
2
|
|
|
1
|
|
|
1
|
|
604
|
|
|
1
|
|
|
1
|
|
7
|
|
|
1
|
|
|
1
|
|
3
|
|
|
1
|
|
|
1
|
|
636
|
|
|
1
|
|
|
1
|
|
7
|
|
|
1
|
|
|
1
|
|
3
|
|
|
1
|
|
|
1
|
|
615
|
|
|
1
|
|
|
1
|
|
9
|
|
|
1
|
|
|
1
|
|
2
|
|
|
1
|
|
|
1
|
|
599
|
|
|
1
|
|
|
1
|
|
7
|
|
|
1
|
|
|
1
|
|
3
|
|
|
1
|
|
|
1
|
|
618
|
|
|
1
|
|
|
1
|
|
7
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
588
|
|
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
598
|
|
|
1
|
|
|
|
|
17
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
684
|
|
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
623
|
|
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
539
|
|
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
524
|
|
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
226
|
|
|
1
|
|
|
|
|
11
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
556
|
|
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
516
|
|
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
619
|
|
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
615
|
|
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
674
|
|
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
613
|
|
|
19
|
|
|
|
|
1668
|
|
254
|
19
|
50
|
|
|
|
80
|
die if $@; |
255
|
19
|
|
|
|
|
405
|
return $sub; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
$SPEC{validate_args_using_meta} = { |
260
|
|
|
|
|
|
|
v => 1.1, |
261
|
|
|
|
|
|
|
summary => 'Validate arguments using Rinci function metadata', |
262
|
|
|
|
|
|
|
description => <<'_', |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
If you intend to reuse the generated validator, you can also use |
265
|
|
|
|
|
|
|
`gen_args_validator_from_meta`. |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
Note: currently cannot handle `args_as => 'array'`, only `args_as => 'arrayref`. |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
_ |
270
|
|
|
|
|
|
|
args => { |
271
|
|
|
|
|
|
|
%arg_meta, |
272
|
|
|
|
|
|
|
%argopt_die, |
273
|
|
|
|
|
|
|
args => { |
274
|
|
|
|
|
|
|
schema => ['any*', of=>['hash*', 'array*']], |
275
|
|
|
|
|
|
|
req => 1, |
276
|
|
|
|
|
|
|
}, |
277
|
|
|
|
|
|
|
}, |
278
|
|
|
|
|
|
|
}; |
279
|
|
|
|
|
|
|
sub validate_args_using_meta { |
280
|
12
|
|
|
12
|
1
|
7746
|
my %args = @_; |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
my $validator = gen_args_validator_from_meta( |
283
|
|
|
|
|
|
|
meta => $args{meta}, |
284
|
|
|
|
|
|
|
die => $args{die}, |
285
|
12
|
|
|
|
|
45
|
); |
286
|
12
|
|
100
|
|
|
396
|
$validator->($args{args}) // [200, "OK"]; |
287
|
|
|
|
|
|
|
}; |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
1; |
290
|
|
|
|
|
|
|
# ABSTRACT: Validate function arguments using schemas in Rinci function metadata |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
__END__ |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
=pod |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=encoding UTF-8 |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
=head1 NAME |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
Perinci::Sub::ValidateArgs - Validate function arguments using schemas in Rinci function metadata |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=head1 VERSION |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
This document describes version 0.012 of Perinci::Sub::ValidateArgs (from Perl distribution Perinci-Sub-ValidateArgs), released on 2020-02-05. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
=head1 SYNOPSIS |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
use Perinci::Sub::ValidateArgs qw(gen_args_validator_from_meta); |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
our %SPEC; |
311
|
|
|
|
|
|
|
$SPEC{foo} = { |
312
|
|
|
|
|
|
|
v => 1.1, |
313
|
|
|
|
|
|
|
args => { |
314
|
|
|
|
|
|
|
a1 => { |
315
|
|
|
|
|
|
|
schema => 'int*', |
316
|
|
|
|
|
|
|
req => 1, |
317
|
|
|
|
|
|
|
}, |
318
|
|
|
|
|
|
|
a2 => { |
319
|
|
|
|
|
|
|
schema => [array => of=>'int*'], |
320
|
|
|
|
|
|
|
default => 'peach', |
321
|
|
|
|
|
|
|
}, |
322
|
|
|
|
|
|
|
}, |
323
|
|
|
|
|
|
|
'x.func.validate_args' => 1, |
324
|
|
|
|
|
|
|
}; |
325
|
|
|
|
|
|
|
sub foo { |
326
|
|
|
|
|
|
|
state $validator = gen_args_validator_from_meta(); |
327
|
|
|
|
|
|
|
my %args = @_; |
328
|
|
|
|
|
|
|
if (my $err = $validator->(\%args)) { return $err } |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
... |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
or, if you want the validator to die on failure: |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
... |
336
|
|
|
|
|
|
|
sub foo { |
337
|
|
|
|
|
|
|
state $validator = gen_args_validator_from_meta(die => 1); |
338
|
|
|
|
|
|
|
my %args = @_; |
339
|
|
|
|
|
|
|
$validator->(\%args); |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
... |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=head1 DESCRIPTION |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
This module (PSV for short) can be used to validate function arguments using |
347
|
|
|
|
|
|
|
schema information in Rinci function metadata. |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
There are other ways if you want to validate function arguments using Sah |
350
|
|
|
|
|
|
|
schemas. See L<Data::Sah::Manual::ParamsValidating>. |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
=head1 FUNCTIONS |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=head2 gen_args_validator_from_meta |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
Usage: |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
gen_args_validator_from_meta(%args) -> any |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
Generate argument validator from Rinci function metadata. |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
If you don't intend to reuse the generated validator, you can also use |
364
|
|
|
|
|
|
|
C<validate_args_using_meta>. |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
This function is not exported by default, but exportable. |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
Arguments ('*' denotes required arguments): |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=over 4 |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
=item * B<die> => I<bool> |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
Whether validator should die or just return an error messageE<sol>response. |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
=item * B<meta> => I<hash> |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
If not specified, will be searched from caller's C<%SPEC> package variable. |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
=item * B<source> => I<bool> |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
Whether we want to get the source code instead. |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
The default is to generate Perl validator code, compile it with C<eval()>, and |
385
|
|
|
|
|
|
|
return the resulting coderef. When this option is set to true, the generated |
386
|
|
|
|
|
|
|
source string will be returned instead. |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
=back |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
Return value: (any) |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=head2 validate_args_using_meta |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
Usage: |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
validate_args_using_meta(%args) -> [status, msg, payload, meta] |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
Validate arguments using Rinci function metadata. |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
If you intend to reuse the generated validator, you can also use |
404
|
|
|
|
|
|
|
C<gen_args_validator_from_meta>. |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
Note: currently cannot handle C<< args_as =E<gt> 'array' >>, only C<< args_as =E<gt> 'arrayref >>. |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
This function is not exported by default, but exportable. |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
Arguments ('*' denotes required arguments): |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=over 4 |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=item * B<args>* => I<hash|array> |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=item * B<die> => I<bool> |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
Whether validator should die or just return an error messageE<sol>response. |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
=item * B<meta>* => I<hash> |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=back |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
Returns an enveloped result (an array). |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
First element (status) is an integer containing HTTP status code |
428
|
|
|
|
|
|
|
(200 means OK, 4xx caller error, 5xx function error). Second element |
429
|
|
|
|
|
|
|
(msg) is a string containing error message, or 'OK' if status is |
430
|
|
|
|
|
|
|
200. Third element (payload) is optional, the actual result. Fourth |
431
|
|
|
|
|
|
|
element (meta) is called result metadata and is optional, a hash |
432
|
|
|
|
|
|
|
that contains extra information. |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
Return value: (any) |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
=for Pod::Coverage ^(gen_args_validator)$ |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
=head1 HOMEPAGE |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Sub-ValidateArgs>. |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=head1 SOURCE |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
Source repository is at L<https://github.com/perlancar/perl-Perinci-Sub-ValidateArgs>. |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
=head1 BUGS |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-Sub-ValidateArgs> |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
When submitting a bug or request, please include a test-file or a |
451
|
|
|
|
|
|
|
patch to an existing test-file that illustrates the bug or desired |
452
|
|
|
|
|
|
|
feature. |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=head1 SEE ALSO |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
L<Rinci>, L<Data::Sah> |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
L<Dist::Zilla::Plugin::IfBuilt> |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
L<Dist::Zilla::Plugin::Rinci::Validate> |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
=head1 AUTHOR |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
perlancar <perlancar@cpan.org> |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
This software is copyright (c) 2020, 2016 by perlancar@cpan.org. |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
471
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
=cut |