Mercurial > pub > Impl
comparison Lib/IMPL/DOM/Node.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 | cf3b6ef2be22 |
children | c6fb6964de4c |
comparison
equal
deleted
inserted
replaced
103:c289ed9662ca | 104:196bf443b5e1 |
---|---|
19 public _direct property childNodes => { get => \&_getChildNodes }; # prop_list | 19 public _direct property childNodes => { get => \&_getChildNodes }; # prop_list |
20 public _direct property parentNode => prop_get ; | 20 public _direct property parentNode => prop_get ; |
21 private _direct property _propertyMap => prop_all ; | 21 private _direct property _propertyMap => prop_all ; |
22 } | 22 } |
23 | 23 |
24 our %Axes = ( | |
25 parent => \&selectParent, | |
26 siblings => \&selectSiblings, | |
27 child => \&childNodes, | |
28 document => \&selectDocument | |
29 ); | |
30 | |
24 sub CTOR { | 31 sub CTOR { |
25 my ($this,%args) = @_; | 32 my ($this,%args) = @_; |
26 | 33 |
27 $this->{$nodeName} = delete $args{nodeName} or die new IMPL::InvalidArgumentException("A name is required"); | 34 $this->{$nodeName} = delete $args{nodeName} or die new IMPL::InvalidArgumentException("A name is required"); |
28 $this->{$nodeValue} = delete $args{nodeValue} if exists $args{nodeValue}; | 35 $this->{$nodeValue} = delete $args{nodeValue} if exists $args{nodeValue}; |
168 $this->{$childNodes} = @newSet ? bless \@newSet ,'IMPL::Object::List' : undef; | 175 $this->{$childNodes} = @newSet ? bless \@newSet ,'IMPL::Object::List' : undef; |
169 | 176 |
170 return wantarray ? @result : \@result; | 177 return wantarray ? @result : \@result; |
171 } | 178 } |
172 | 179 |
180 sub resolveAxis { | |
181 my ($this,$axis) = @_; | |
182 return $Axes{$axis}->($this) | |
183 } | |
184 | |
173 sub selectNodes { | 185 sub selectNodes { |
174 my ($this,$query) = @_; | 186 my ($this,$query,$axis) = @_; |
187 | |
188 $axis ||= 'child'; | |
189 | |
190 die new IMPL::InvalidOperationException('Unknown axis',$axis) unless exists $Axes{$axis}; | |
191 | |
192 my $nodes = $this->resolveAxis($axis); | |
175 | 193 |
176 my @result; | 194 my @result; |
177 | 195 |
178 if (ref $query eq 'CODE') { | 196 if (ref $query eq 'CODE') { |
179 @result = grep &$query($_), @{$this->childNodes}; | 197 @result = grep &$query($_), @{$nodes}; |
180 } elsif (ref $query eq 'ARRAY' ) { | 198 } elsif (ref $query eq 'ARRAY' ) { |
181 my %keys = map (($_,1),@$query); | 199 my %keys = map (($_,1),@$query); |
182 @result = grep $keys{$_->nodeName}, @{$this->childNodes}; | 200 @result = grep $keys{$_->nodeName}, @{$nodes}; |
201 } elsif (ref $query eq 'HASH') { | |
202 while( my ($axis,$filter) = each %$query ) { | |
203 push @result, $this->selectNodes($filter,$axis); | |
204 } | |
183 } elsif (defined $query) { | 205 } elsif (defined $query) { |
184 @result = grep $_->nodeName eq $query, @{$this->childNodes}; | 206 @result = grep $_->nodeName eq $query, @{$nodes}; |
185 } else { | 207 } else { |
186 if (wantarray) { | 208 return wantarray ? @{$nodes} : $nodes; |
187 return @{$this->childNodes}; | |
188 } else { | |
189 @result = $this->childNodes; | |
190 return \@result; | |
191 } | |
192 } | 209 } |
193 | 210 |
194 return wantarray ? @result : \@result; | 211 return wantarray ? @result : \@result; |
212 } | |
213 | |
214 sub selectPath { | |
215 my ($this,$path) = @_; | |
216 | |
217 my @set = ($this); | |
218 | |
219 while (my $query = shift @$path) { | |
220 @set = map $_->selectNodes($query), @set; | |
221 } | |
222 | |
223 return wantarray ? @set : \@set; | |
224 } | |
225 | |
226 sub selectParent { | |
227 my ($this) = @_; | |
228 | |
229 if ($this->parentNode) { | |
230 return wantarray ? $this->parentNode : [$this->parentNode]; | |
231 } else { | |
232 return wantarray ? () : []; | |
233 } | |
234 } | |
235 | |
236 sub selectSiblings { | |
237 my ($this) = @_; | |
238 | |
239 if ($this->parentNode) { | |
240 return $this->parentNode->selectNodes( sub { $_ != $this } ); | |
241 } else { | |
242 return wantarray ? () : []; | |
243 } | |
244 } | |
245 | |
246 sub selectDocument { | |
247 my ($this) = @_; | |
248 | |
249 if ($this->document) { | |
250 return wantarray ? $this->document : [$this->document]; | |
251 } else { | |
252 return wantarray ? () : []; | |
253 } | |
195 } | 254 } |
196 | 255 |
197 sub firstChild { | 256 sub firstChild { |
198 @_ >=2 ? $_[0]->replaceNodeAt(0,$_[1]) : $_[0]->childNodes->[0]; | 257 @_ >=2 ? $_[0]->replaceNodeAt(0,$_[1]) : $_[0]->childNodes->[0]; |
199 } | 258 } |