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 } |
