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 |
