Mercurial > pub > Impl
comparison lib/IMPL/DOM/Schema/Validator/Compare.pm @ 407:c6e90e02dd17 ref20150831
renamed Lib->lib
author | cin |
---|---|
date | Fri, 04 Sep 2015 19:40:23 +0300 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
406:f23fcb19d3c1 | 407:c6e90e02dd17 |
---|---|
1 package IMPL::DOM::Schema::Validator::Compare; | |
2 use strict; | |
3 | |
4 use IMPL::Const qw(:prop); | |
5 use IMPL::declare { | |
6 require => { | |
7 Label => 'IMPL::DOM::Schema::Label', | |
8 ValidationError => 'IMPL::DOM::Schema::ValidationError' | |
9 }, | |
10 base => [ | |
11 'IMPL::DOM::Schema::Validator' => sub { | |
12 my %args = @_; | |
13 $args{nodeName} ||= 'Compare'; | |
14 delete @args{qw(targetProperty op nodePath optional message)}; | |
15 %args; | |
16 } | |
17 ], | |
18 props => [ | |
19 targetProperty => PROP_RW, | |
20 op => PROP_RW, | |
21 nodePath => PROP_RW, | |
22 optional => PROP_RW, | |
23 _pathTranslated => PROP_RW, | |
24 _targetNode => PROP_RW, | |
25 _schemaNode => PROP_RW, | |
26 message => PROP_RW | |
27 ] | |
28 }; | |
29 use IMPL::Resources::Format qw(FormatMessage); | |
30 | |
31 our %Ops = ( | |
32 '=' => \&_equals, | |
33 'eq' => \&_equalsString, | |
34 '!=' => \&_notEquals, | |
35 'ne' => \&_notEqualsString, | |
36 '=~' => \&_matchRx, | |
37 '!~' => \&_notMatchRx, | |
38 '<' => \&_less, | |
39 '>' => \&_greater, | |
40 'lt' => \&_lessString, | |
41 'gt' => \&_greaterString | |
42 ); | |
43 | |
44 my $rxOps = map qr/$_/, join( '|', keys %Ops ); | |
45 | |
46 sub CTOR { | |
47 my ($this,%args) = @_; | |
48 | |
49 $this->targetProperty($args{targetProperty} || 'nodeValue'); | |
50 $this->op( $Ops{ $args{op} || '=' } ) or die new IMPL::InvalidArgumentException("Invalid parameter value",'op',$args{op},$this->path); | |
51 $this->nodePath($args{nodePath}) or die new IMPL::InvalidArgumentException("The argument is required", 'nodePath', $this->path); | |
52 $this->message($args{message} || 'The value of %node.path% %schemaNode.op% %value% (%schemaNode.nodePath%)' ); | |
53 $this->optional($args{optional}) if $args{optional}; | |
54 } | |
55 | |
56 sub TranslatePath { | |
57 my ($this,$path) = @_; | |
58 | |
59 $path ||= ''; | |
60 | |
61 my @selectQuery; | |
62 | |
63 my $i = 0; | |
64 | |
65 foreach my $chunk (split /\//,$path) { | |
66 $chunk = 'document:*' if $i == 0 and not length $chunk; | |
67 next if not length $chunk; | |
68 | |
69 my $query; | |
70 my ($axis,$filter) = ( $chunk =~ /^(?:(\w+):)?(.*)$/); | |
71 | |
72 if ($filter =~ /^\w+|\*$/ ) { | |
73 $query = $filter eq '*' ? undef : $filter; | |
74 } elsif ( $filter =~ /^(\w+|\*)\s*((?:\[\s*\w+\s*(?:=|!=|=~|!~|eq|ne|lt|gt)\s*["'](?:[^\\'"]|\\[\\"'])*["']\])+)$/) { | |
75 my ($nodeName,$filterArgs) = ($1,$2); | |
76 | |
77 | |
78 my @parsedFilters = map { | |
79 my ($prop,$op,$value) = ($_ =~ /\s*(\w+)\s*(=|!=|=~|!~|eq|ne|lt|gt)\s*(?:["']((?:[^\\'"]|\\[\\"'])*)["'])/); | |
80 | |
81 $value =~ s/\\[\\'"]/$1/g; | |
82 { | |
83 prop => $prop, | |
84 op => $Ops{$op}, | |
85 value => $value | |
86 } | |
87 } grep ( $_, split ( /[\]\[]+/,$filterArgs ) ); | |
88 | |
89 $query = sub { | |
90 my ($node) = shift; | |
91 | |
92 $node->nodeName eq $nodeName or return 0 if $nodeName ne '*'; | |
93 $_->{op}->( | |
94 _resovleProperty($node,$_->{prop}), | |
95 FormatMessage($_->{value},{ | |
96 Schema => $this->parentNode, | |
97 Node => $this->_targetNode, | |
98 schema => $this->parentNode, | |
99 schemaType => $this->parentNode, | |
100 node => $this->_targetNode, | |
101 source => $this->_schemaNode, | |
102 schemaNode => $this->_schemaNode | |
103 },\&_resovleProperty) | |
104 ) or return 0 foreach @parsedFilters; | |
105 return 1; | |
106 }; | |
107 } else { | |
108 die new IMPL::Exception("Invalid query syntax",$path,$chunk); | |
109 } | |
110 | |
111 push @selectQuery, $axis ? { $axis => $query } : $query; | |
112 | |
113 $i++; | |
114 } | |
115 | |
116 return \@selectQuery; | |
117 } | |
118 | |
119 sub Validate { | |
120 my ($this,$node,$ctx) = @_; | |
121 | |
122 my @result; | |
123 | |
124 my $schemaNode = $ctx->{schemaNode}; | |
125 my $schemaType = $ctx->{schemaType}; | |
126 | |
127 $this->_schemaNode($schemaNode); | |
128 | |
129 $this->_targetNode($node); | |
130 | |
131 my $query = $this->_pathTranslated() || $this->_pathTranslated($this->TranslatePath($this->nodePath)); | |
132 | |
133 my ($foreignNode) = $node->selectNodes(@$query); | |
134 | |
135 | |
136 | |
137 if ($foreignNode) { | |
138 my $value = $this->nodeValue; | |
139 | |
140 if ($value) { | |
141 $value = FormatMessage($value, { Schema => $this->parentNode, Node => $this->_targetNode, ForeignNode => $foreignNode },\&_resovleProperty); | |
142 } else { | |
143 $value = $foreignNode->nodeValue; | |
144 } | |
145 | |
146 push @result, ValidationError->new( | |
147 node => $node, | |
148 foreignNode => $foreignNode, | |
149 value => $value, | |
150 schemaNode => $schemaNode, | |
151 schemaType => $schemaType, | |
152 message => $this->_MakeLabel($this->message) | |
153 ) unless $this->op->(_resovleProperty($node,$this->targetProperty),$value); | |
154 } elsif (not $this->optional) { | |
155 push @result, ValidationError->new( | |
156 node => $node, | |
157 value => '', | |
158 schemaNode => $schemaNode, | |
159 schemaType => $schemaType, | |
160 message => $this->_MakeLabel( $this->message ) | |
161 ); | |
162 } | |
163 | |
164 $this->_targetNode(undef); | |
165 $this->_schemaNode(undef); | |
166 | |
167 return @result; | |
168 } | |
169 | |
170 sub _resovleProperty { | |
171 my ($node,$prop) = @_; | |
172 | |
173 return $node->can($prop) ? $node->$prop() : $node->nodeProperty($prop); | |
174 } | |
175 | |
176 sub _matchRx { | |
177 $_[0] =~ $_[1]; | |
178 } | |
179 | |
180 sub _notMatchRx { | |
181 $_[0] !~ $_[1]; | |
182 } | |
183 | |
184 sub _equals { | |
185 $_[0] == $_[1]; | |
186 } | |
187 | |
188 sub _notEquals { | |
189 $_[0] != $_[0]; | |
190 } | |
191 | |
192 sub _equalsString { | |
193 $_[0] eq $_[1]; | |
194 } | |
195 | |
196 sub _notEqualsString { | |
197 $_[0] ne $_[1]; | |
198 } | |
199 | |
200 sub _less { | |
201 $_[0] < $_[1]; | |
202 } | |
203 | |
204 sub _greater { | |
205 $_[0] > $_[1]; | |
206 } | |
207 | |
208 sub _lessString { | |
209 $_[0] lt $_[1]; | |
210 } | |
211 | |
212 sub _greaterString { | |
213 $_[0] gt $_[1]; | |
214 } | |
215 | |
216 sub _lessEq { | |
217 $_[0] <= $_[1]; | |
218 } | |
219 | |
220 sub _greaterEq { | |
221 $_[0] >= $_[1]; | |
222 } | |
223 | |
224 sub _MakeLabel { | |
225 my ($this,$label) = @_; | |
226 | |
227 if ($label =~ /^ID:(\w+)$/) { | |
228 return Label->new($this->document->stringMap, $1); | |
229 } else { | |
230 return $label; | |
231 } | |
232 } | |
233 | |
234 1; | |
235 | |
236 __END__ | |
237 | |
238 =pod | |
239 | |
240 =head1 NAME | |
241 | |
242 C<IMPL::DOM::Schema::Validator::Compare> - ограничение на содержимое текущего узла, | |
243 сравнивая его со значением другого узла. | |
244 | |
245 =head1 SYNOPSIS | |
246 | |
247 Пример типа описания поля с проверочным полем | |
248 | |
249 =begin code xml | |
250 | |
251 <schema> | |
252 <SimpleType type="retype_field"> | |
253 <Property name="linkedNode" message="Для узла %node.nodeName% необходимо задать свойство %schemaNode.name%"/> | |
254 <Compare op="eq" nodePath="sibling:*[nodeName eq '%node.linkedNode%']"/> | |
255 </SimpleType> | |
256 </schema> | |
257 | |
258 =begin code xml | |
259 | |
260 =head1 DESCRIPTION | |
261 | |
262 Позволяет сравнивать значение текущего узла со значением другого узла. | |
263 | |
264 =cut |