comparison Lib/IMPL/DOM/Schema/Validator/Compare.pm @ 104:196bf443b5e1

DOM::Schema RC0 inflators support, validation and some other things, Minor and major fixes almost for everything. A 'Source' property of the ValidationErrors generated from a NodeSet or a NodeList is subject to change in the future.
author wizard
date Tue, 11 May 2010 02:42:59 +0400
parents
children c6fb6964de4c
comparison
equal deleted inserted replaced
103:c289ed9662ca 104:196bf443b5e1
1 package IMPL::DOM::Schema::Validator::Compare;
2 use strict;
3
4 use base qw(IMPL::DOM::Schema::Validator);
5
6 use IMPL::Resources::Format qw(FormatMessage);
7 use IMPL::Class::Property;
8
9 BEGIN {
10 public property targetProperty => prop_all;
11 public property op => prop_all;
12 public property nodePath => prop_get | owner_set;
13 public property optional => prop_all;
14 private property _pathTranslated => prop_all;
15 private property _targetNode => prop_all;
16 public property message => prop_all;
17 }
18
19 our %CTOR = (
20 'IMPL::DOM::Schema::Validator' => sub {
21 my %args = @_;
22 $args{nodeName} ||= 'Compare';
23 %args;
24 }
25 );
26
27 our %Ops = (
28 '=' => \&_equals,
29 'eq' => \&_equalsString,
30 '!=' => \&_notEquals,
31 'ne' => \&_notEqualsString,
32 '=~' => \&_matchRx,
33 '!~' => \&_notMatchRx,
34 '<' => \&_less,
35 '>' => \&_greater,
36 'lt' => \&_lessString,
37 'gt' => \&_greaterString
38 );
39
40 my $rxOps = map qr/$_/, join( '|', keys %Ops );
41
42 sub CTOR {
43 my ($this,%args) = @_;
44
45 $this->targetProperty($args{targetProperty} || 'nodeValue');
46 $this->op( $Ops{ $args{op} || '=' } ) or die new IMPL::InvalidArgumentException("Invalid parameter value",'op',$args{op},$this->path);
47 $this->nodePath($args{nodePath}) or die new IMPL::InvalidArgumentException("The argument is required", 'nodePath', $this->path);
48 $this->message($args{message} || 'The value of %Node.path% %Source.op% %Value% (%Source.nodePath%)' );
49 $this->optional($args{optional}) if $args{optional};
50 }
51
52 sub TranslatePath {
53 my ($this,$path) = @_;
54
55 $path ||= '';
56
57 my @selectQuery;
58
59 my $i = 0;
60
61 foreach my $chunk (split /\//,$path) {
62 $chunk = 'document:*' if $i == 0 and not length $chunk;
63 next if not length $chunk;
64
65 my $query;
66 my ($axis,$filter) = ( $chunk =~ /^(?:(\w+):)?(.*)$/);
67
68 if ($filter =~ /^\w+|\*$/ ) {
69 $query = $filter eq '*' ? undef : $filter;
70 } elsif ( $filter =~ /^(\w+|\*)\s*((?:\[\s*\w+\s*(?:=|!=|=~|!~|eq|ne|lt|gt|)\s*["'](?:[\\'"]|\\[\\"'])*["']\])+)$/) {
71 my ($nodeName,$filterArgs) = ($1,$2);
72
73 my @parsedFilters = map {
74 my ($prop,$op,$value) = ($_ =~ /\s*(\w+)\s*(=|!=|=~|!~)\s*(["'](?:[\\'"]|\\[\\"'])*["'])/);
75 $value =~ s/\\[\\'"]/$1/g;
76 {
77 prop => $prop,
78 op => $Ops{$op},
79 value => $value
80 }
81 } grep ( $_, split ( /[\]\[]+/,$filterArgs ) );
82
83 $query = sub {
84 my ($node) = shift;
85
86 $node->nodeName eq $nodeName or return 0 if $nodeName ne '*';
87 $_->{op}->(
88 _resovleProperty($node,$_->{prop}),
89 FormatMessage($_->{value},{
90 Schema => $this->parentNode,
91 Node => $this->_targetNode
92 },\&_resovleProperty)
93 ) or return 0 foreach @parsedFilters;
94
95 };
96 } else {
97 die new IMPL::Exception("Invalid query syntax",$path,$chunk);
98 }
99
100 push @selectQuery, $axis ? { $axis => $query } : $query;
101
102 $i++;
103 }
104
105 return \@selectQuery;
106 }
107
108 sub Validate {
109 my ($this,$node,$ctx) = @_;
110
111 my @result;
112
113 $this->_targetNode($node);
114
115 my $query = $this->_pathTranslated() || $this->_pathTranslated($this->TranslatePath($this->nodePath));
116
117 my ($foreignNode) = $node->selectPath($query);
118
119 my $Source = $ctx && $ctx->{Source} || $this->parentNode;
120
121 if ($foreignNode) {
122 my $value = $this->nodeValue;
123
124 if ($value) {
125 $value = FormatMessage($value, { Schema => $this->parentNode, Node => $this->_targetNode, ForeignNode => $foreignNode },\&_resovleProperty);
126 } else {
127 $value = $foreignNode->nodeValue;
128 }
129
130 push @result, new IMPL::DOM::Schema::ValidationError(
131 Node => $node,
132 ForeignNode => $foreignNode,
133 Value => $value,
134 Source => $Source,
135 Schema => $this->parentNode,
136 Message => $this->message
137 ) unless $this->op->(_resovleProperty($node,$this->targetProperty),$value);
138 } elsif (not $this->optional) {
139 push @result, new IMPL::DOM::Schema::ValidationError(
140 Node => $node,
141 Value => '',
142 Source => $Source,
143 Schema => $this->parentNode,
144 Message => $this->message
145 );
146 }
147
148 $this->_targetNode(undef);
149
150 return @result;
151 }
152
153 sub _resovleProperty {
154 my ($node,$prop) = @_;
155
156 return $node->can($prop) ? $node->$prop() : $node->nodeProperty($prop);
157 }
158
159 sub _matchRx {
160 $_[0] =~ $_[1];
161 }
162
163 sub _notMatchRx {
164 $_[0] !~ $_[1];
165 }
166
167 sub _equals {
168 $_[0] == $_[1];
169 }
170
171 sub _notEquals {
172 $_[0] != $_[0];
173 }
174
175 sub _equalsString {
176 $_[0] eq $_[1];
177 }
178
179 sub _notEqualsString {
180 $_[0] ne $_[1];
181 }
182
183 sub _less {
184 $_[0] < $_[1];
185 }
186
187 sub _greater {
188 $_[0] > $_[1];
189 }
190
191 sub _lessString {
192 $_[0] lt $_[1];
193 }
194
195 sub _greaterString {
196 $_[0] gt $_[1];
197 }
198
199 sub _lessEq {
200 $_[0] <= $_[1];
201 }
202
203 sub _greaterEq {
204 $_[0] >= $_[1];
205 }
206
207 1;
208
209 __END__
210
211 =pod
212
213 =head1 NAME
214
215 C<IMPL::DOM::Schema::Validator::Compare> - ограничение на содержимое текущего узла,
216 сравнивая его со значением другого узла.
217
218 =head1 SYNOPSIS
219
220 Пример типа описания поля с проверочным полем
221
222 =begin code xml
223
224 <schema>
225 <SimpleType type="retype_field">
226 <Property name="linkedNode" message="Для узла %Node.nodeName% необходимо задать свойство %Source.name%"/>
227 <Compare op="eq" nodePath="sibling:*[nodeName eq '%Node.linkedNode%']"/>
228 </SimpleType>
229 </schema>
230
231 =begin code xml
232
233 =head1 DESCRIPTION
234
235 Позволяет сравнивать значение текущего узла со значением другого узла.
236
237 =cut