Mercurial > pub > Impl
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 |
