line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Email::MIME::Kit::Validator::Rx; |
2
|
|
|
|
|
|
|
{ |
3
|
|
|
|
|
|
|
$Email::MIME::Kit::Validator::Rx::VERSION = '0.200001'; |
4
|
|
|
|
|
|
|
} |
5
|
1
|
|
|
1
|
|
86100
|
use Moose; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
10
|
|
6
|
|
|
|
|
|
|
with 'Email::MIME::Kit::Role::Validator'; |
7
|
|
|
|
|
|
|
# ABSTRACT: validate assembly stash with Rx (from JSON in kit) |
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
6987
|
use Data::Rx 0.007; |
|
1
|
|
|
|
|
8588
|
|
|
1
|
|
|
|
|
36
|
|
10
|
1
|
|
|
1
|
|
699
|
use Data::Rx::TypeBundle::Perl 0.005; |
|
1
|
|
|
|
|
8436
|
|
|
1
|
|
|
|
|
27
|
|
11
|
1
|
|
|
1
|
|
6
|
use JSON; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
11
|
|
12
|
1
|
|
|
1
|
|
147
|
use Moose::Util::TypeConstraints; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
16
|
|
13
|
1
|
|
|
1
|
|
1780
|
use Try::Tiny; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
737
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
has prefix => ( |
17
|
|
|
|
|
|
|
is => 'ro', |
18
|
|
|
|
|
|
|
isa => 'HashRef', |
19
|
|
|
|
|
|
|
default => sub { {} }, |
20
|
|
|
|
|
|
|
); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
has type_plugins => ( |
23
|
|
|
|
|
|
|
is => 'ro', |
24
|
|
|
|
|
|
|
isa => 'ArrayRef[Str]', |
25
|
|
|
|
|
|
|
default => sub { [] }, |
26
|
|
|
|
|
|
|
); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
has rx => ( |
29
|
|
|
|
|
|
|
is => 'ro', |
30
|
|
|
|
|
|
|
isa => class_type('Data::Rx'), |
31
|
|
|
|
|
|
|
lazy => 1, |
32
|
|
|
|
|
|
|
init_arg => undef, |
33
|
|
|
|
|
|
|
builder => 'build_default_rx_object', |
34
|
|
|
|
|
|
|
); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub build_default_rx_object { |
37
|
3
|
|
|
3
|
0
|
8
|
my ($self) = @_; |
38
|
3
|
|
|
|
|
148
|
my $rx = Data::Rx->new({ |
39
|
|
|
|
|
|
|
prefix => $self->prefix, |
40
|
|
|
|
|
|
|
}); |
41
|
|
|
|
|
|
|
|
42
|
3
|
|
|
|
|
20902
|
for my $plugin ($self->all_default_type_plugins, @{ $self->type_plugins }) { |
|
3
|
|
|
|
|
196
|
|
43
|
3
|
50
|
|
|
|
197
|
eval "require $plugin; 1" or die; |
44
|
3
|
|
|
|
|
16
|
$rx->register_type_plugin($plugin); |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
3
|
|
|
|
|
470
|
my $prefix = $self->prefix; |
48
|
3
|
|
|
|
|
11
|
for my $key (keys %$prefix) { |
49
|
0
|
|
|
|
|
0
|
$rx->add_prefix($key, $prefix->{ $key }); |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
3
|
|
|
|
|
141
|
return $rx; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub all_default_type_plugins { |
56
|
|
|
|
|
|
|
# shamlessly stolen from Moose::Object::BUILDALL -- rjbs, 2009-03-06 |
57
|
3
|
|
|
3
|
0
|
9
|
my ($self) = @_; |
58
|
3
|
|
|
|
|
7
|
my @plugins; |
59
|
3
|
|
|
|
|
20
|
for my $method ( |
60
|
|
|
|
|
|
|
reverse |
61
|
|
|
|
|
|
|
$self->meta->find_all_methods_by_name('accumulate_default_type_plugins') |
62
|
|
|
|
|
|
|
) { |
63
|
3
|
|
|
|
|
1038
|
push @plugins, $method->{code}->execute($self); |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
3
|
|
|
|
|
12
|
return @plugins; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub accumulate_default_type_plugins { |
70
|
3
|
|
|
3
|
0
|
25
|
return ('Data::Rx::TypeBundle::Perl'); |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
has schema => ( |
74
|
|
|
|
|
|
|
reader => 'schema', |
75
|
|
|
|
|
|
|
writer => '_set_schema', |
76
|
|
|
|
|
|
|
isa => 'Object', # It'd be nice to have a better TC -- rjbs, 2009-03-06 |
77
|
|
|
|
|
|
|
init_arg => undef, |
78
|
|
|
|
|
|
|
); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
has schema_struct => ( |
81
|
|
|
|
|
|
|
reader => '_schema_struct', |
82
|
|
|
|
|
|
|
init_arg => 'schema', |
83
|
|
|
|
|
|
|
); |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
has schema_path => ( |
86
|
|
|
|
|
|
|
reader => '_schema_path', |
87
|
|
|
|
|
|
|
writer => '_set_schema_path', |
88
|
|
|
|
|
|
|
isa => 'Str', |
89
|
|
|
|
|
|
|
init_arg => 'path', |
90
|
|
|
|
|
|
|
); |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
has combine => ( |
93
|
|
|
|
|
|
|
is => 'ro', |
94
|
|
|
|
|
|
|
initializer => sub { |
95
|
|
|
|
|
|
|
my ($self, $value, $set) = @_; |
96
|
|
|
|
|
|
|
confess "invalid combine logic: $value" |
97
|
|
|
|
|
|
|
unless defined $value and $value eq 'all'; |
98
|
|
|
|
|
|
|
$set->($value); |
99
|
|
|
|
|
|
|
}, |
100
|
|
|
|
|
|
|
); |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub BUILD { |
103
|
3
|
|
|
3
|
0
|
5
|
my ($self) = @_; |
104
|
|
|
|
|
|
|
|
105
|
3
|
|
|
|
|
11
|
$self->_do_goofy_schema_initialization; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub _do_goofy_schema_initialization { |
109
|
3
|
|
|
3
|
|
4
|
my ($self) = @_; |
110
|
|
|
|
|
|
|
|
111
|
3
|
|
|
|
|
12
|
my @paths = grep { defined } ref $self->_schema_path |
|
0
|
|
|
|
|
0
|
|
112
|
3
|
50
|
|
|
|
174
|
? @{ $self->_schema_path } |
113
|
|
|
|
|
|
|
: $self->_schema_path; |
114
|
|
|
|
|
|
|
|
115
|
4
|
|
|
|
|
13
|
my @structs = grep { defined } (ref $self->_schema_struct eq 'ARRAY') |
|
1
|
|
|
|
|
53
|
|
116
|
3
|
100
|
|
|
|
168
|
? @{ $self->_schema_struct } |
117
|
|
|
|
|
|
|
: $self->_schema_struct; |
118
|
|
|
|
|
|
|
|
119
|
3
|
50
|
66
|
|
|
62
|
confess("multiple schemata provided but no combine logic given") |
120
|
|
|
|
|
|
|
if @paths + @structs > 1 and ! $self->combine; |
121
|
|
|
|
|
|
|
|
122
|
3
|
100
|
100
|
|
|
19
|
@paths = ('rx.json') unless @paths or @structs; |
123
|
|
|
|
|
|
|
|
124
|
3
|
|
|
|
|
8
|
for my $path (@paths) { |
125
|
|
|
|
|
|
|
# Sure, someday we can add another decoder layer here to allow schemata in |
126
|
|
|
|
|
|
|
# YAML. Whatever. -- rjbs, 2009-03-06 |
127
|
2
|
|
|
|
|
114
|
my $rx_json_ref = $self->kit->get_kit_entry($path); |
128
|
2
|
|
|
|
|
661
|
my $rx_data = JSON->new->decode($$rx_json_ref); |
129
|
2
|
|
|
|
|
15
|
push @structs, $rx_data; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
3
|
100
|
|
|
|
161
|
my $schema = @structs > 1 |
133
|
|
|
|
|
|
|
? $self->rx->make_schema({ type => '//all', of => \@structs }) |
134
|
|
|
|
|
|
|
: $self->rx->make_schema($structs[0]); |
135
|
|
|
|
|
|
|
|
136
|
3
|
|
|
|
|
1125
|
$self->_set_schema($schema); |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub validate { |
140
|
9
|
|
|
9
|
0
|
89047
|
my ($self, $stash) = @_; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
try { |
143
|
9
|
|
|
9
|
|
680
|
$self->schema->assert_valid($stash); |
144
|
|
|
|
|
|
|
} catch { |
145
|
3
|
|
|
3
|
|
910
|
Carp::confess("assembly parameters don't pass validation: $_"); |
146
|
9
|
|
|
|
|
73
|
}; |
147
|
|
|
|
|
|
|
|
148
|
6
|
|
|
|
|
857
|
return 1; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
1
|
|
|
1
|
|
5
|
no Moose; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
7
|
|
152
|
1
|
|
|
1
|
|
196
|
no Moose::Util::TypeConstraints; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
5
|
|
153
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
154
|
|
|
|
|
|
|
1; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
__END__ |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=pod |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=head1 NAME |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
Email::MIME::Kit::Validator::Rx - validate assembly stash with Rx (from JSON in kit) |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=head1 VERSION |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
version 0.200001 |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head1 SYNOPSIS |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
Email::MIME::Kit::Validator::Rx is a Validator plugin for Email::MIME::Kit that |
171
|
|
|
|
|
|
|
allows an Rx schema to be used to validate kit assembly data. |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
A simple mkit's manifest might include the following: |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
{ |
176
|
|
|
|
|
|
|
"renderer" : "TT", |
177
|
|
|
|
|
|
|
"validator": "Rx", |
178
|
|
|
|
|
|
|
"header" : [ ... mail headers ... ], |
179
|
|
|
|
|
|
|
"type" : "text/plain", |
180
|
|
|
|
|
|
|
"path" : "path/to/template.txt" |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
In this simple configuration, the use of "Rx" as the validator will load the |
184
|
|
|
|
|
|
|
plugin in its simplest configuration. It will look for a file called |
185
|
|
|
|
|
|
|
F<rx.json> in the kit and will load its contents (as JSON) and use them as a |
186
|
|
|
|
|
|
|
schema to validate the data passed to the it's C<assemble> method. |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
More complex configurations are simple. |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
This configuration supplies an alternate filename for the JSON file: |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
"validator": [ "Rx", { "path": "rx-schema.json" } ], |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
This configuration supplies the schema definition inline: |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
"validator": [ |
197
|
|
|
|
|
|
|
"Rx", |
198
|
|
|
|
|
|
|
{ |
199
|
|
|
|
|
|
|
"schema": { |
200
|
|
|
|
|
|
|
"type" : "//rec", |
201
|
|
|
|
|
|
|
"required": { |
202
|
|
|
|
|
|
|
"subject": "//str", |
203
|
|
|
|
|
|
|
"rcpt" : { "type": "/perl/obj", "isa": "Email::Address" } |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
] |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
Notice, above, the C</perl/> prefix. By default, |
210
|
|
|
|
|
|
|
L<Data::Rx::TypeBundle::Perl|Data::Rx::TypeBundle::Perl> is loaded along with |
211
|
|
|
|
|
|
|
the core types. |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
If a C<combine> argument is given, multiple schema definitions may be provided. |
214
|
|
|
|
|
|
|
They will be combined with the logic named by the combine argument. In this |
215
|
|
|
|
|
|
|
release, only "all" is valid, and will require all schemata to match. Here is |
216
|
|
|
|
|
|
|
an example: |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
"validator": [ |
219
|
|
|
|
|
|
|
"Rx", |
220
|
|
|
|
|
|
|
{ |
221
|
|
|
|
|
|
|
"combine": "all", |
222
|
|
|
|
|
|
|
"path" : "rx.json", |
223
|
|
|
|
|
|
|
"schema" : [ |
224
|
|
|
|
|
|
|
{ "type": "//rec", "rest": "//any", "required": { "foo": "//int" } }, |
225
|
|
|
|
|
|
|
{ "type": "//rec", "rest": "//any", "required": { "bar": "//int" } }, |
226
|
|
|
|
|
|
|
] |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
] |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
This definition will create an C<//all> schema with three entries: the schema |
231
|
|
|
|
|
|
|
found in F<rx.json> and the two schemata given in the array value of C<schema>. |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=head1 AUTHOR |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
Ricardo SIGNES <rjbs@cpan.org> |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
This software is copyright (c) 2013 by Ricardo SIGNES. |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
242
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=cut |