Mercurial > pub > Impl

comparison Lib/IMPL/DOM/Node.pm @ 194:4d0e1962161c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Replaced tabs with spaces IMPL::Web::View - fixed document model, new features (control classes, document constructor parameters)
author cin
date Tue, 10 Apr 2012 20:08:29 +0400
parents 029c9610528c
children a8db61d0ed33
comparison
equal deleted inserted replaced
193:8e8401c0aea4 194:4d0e1962161c
24 24
25 __PACKAGE__->class_data(property_bind => {}); 25 __PACKAGE__->class_data(property_bind => {});
26 } 26 }
27 27
28 our %Axes = ( 28 our %Axes = (
29 parent => \&selectParent, 29 parent => \&selectParent,
30 siblings => \&selectSiblings, 30 siblings => \&selectSiblings,
31 child => \&childNodes, 31 child => \&childNodes,
32 document => \&selectDocument, 32 document => \&selectDocument,
33 ancestor => \&selectAncestors, 33 ancestor => \&selectAncestors,
34 descendant => \&selectDescendant 34 descendant => \&selectDescendant
35 ); 35 );
36 36
37 sub CTOR { 37 sub CTOR {
38 my ($this,%args) = @_; 38 my ($this,%args) = @_;
39 39
43 $this->{$document} = delete $args{document}; 43 $this->{$document} = delete $args{document};
44 weaken($this->{$document}); 44 weaken($this->{$document});
45 } 45 }
46 46
47 while ( my ($key,$value) = each %args ) { 47 while ( my ($key,$value) = each %args ) {
48 $this->nodeProperty($key,$value); 48 $this->nodeProperty($key,$value);
49 } 49 }
50 } 50 }
51 51
52 sub insertNode { 52 sub insertNode {
53 my ($this,$node,$pos) = @_; 53 my ($this,$node,$pos) = @_;
103 $this->{$childNodes} = new IMPL::Object::List() unless $this->{$childNodes}; 103 $this->{$childNodes} = new IMPL::Object::List() unless $this->{$childNodes};
104 return wantarray ? @{ $this->{$childNodes} } : $this->{$childNodes}; 104 return wantarray ? @{ $this->{$childNodes} } : $this->{$childNodes};
105 } 105 }
106 106
107 sub childNodesRef { 107 sub childNodesRef {
108 my ($this) = @_; 108 my ($this) = @_;
109 return scalar $this->_getChildNodes; 109 return scalar $this->_getChildNodes;
110 } 110 }
111 111
112 sub removeNode { 112 sub removeNode {
113 my ($this,$node) = @_; 113 my ($this,$node) = @_;
114 114
189 189
190 return wantarray ? @result : \@result; 190 return wantarray ? @result : \@result;
191 } 191 }
192 192
193 sub resolveAxis { 193 sub resolveAxis {
194 my ($this,$axis) = @_; 194 my ($this,$axis) = @_;
195 return $Axes{$axis}->($this) 195 return $Axes{$axis}->($this)
196 } 196 }
197 197
198 sub selectNodes { 198 sub selectNodes {
199 my $this = shift; 199 my $this = shift;
200 my $path; 200 my $path;
201 201
202 if (@_ == 1) { 202 if (@_ == 1) {
203 $path = $this->translatePath($_[0]); 203 $path = $this->translatePath($_[0]);
204 } else { 204 } else {
205 $path = [@_]; 205 $path = [@_];
206 } 206 }
207 207
208 my @set = ($this); 208 my @set = ($this);
209 209
210 while (@$path) { 210 while (@$path) {
211 my $query = shift @$path; 211 my $query = shift @$path;
212 @set = map $_->selectNodesAxis($query), @set; 212 @set = map $_->selectNodesAxis($query), @set;
213 } 213 }
214 214
215 return wantarray ? @set : \@set; 215 return wantarray ? @set : \@set;
216 } 216 }
217 217
218 sub selectSingleNode { 218 sub selectSingleNode {
219 my $this = shift; 219 my $this = shift;
220 my @result = $this->selectNodes(@_); 220 my @result = $this->selectNodes(@_);
221 return $result[0]; 221 return $result[0];
222 } 222 }
223 223
224 sub selectNodesRef { 224 sub selectNodesRef {
225 my $this = shift; 225 my $this = shift;
226 226
227 my @result = $this->selectNodes(@_); 227 my @result = $this->selectNodes(@_);
228 return \@result; 228 return \@result;
229 } 229 }
230 230
231 sub translatePath { 231 sub translatePath {
232 my ($this,$path) = @_; 232 my ($this,$path) = @_;
233 233
234 # TODO: Move path compilation here from IMPL::DOM::Schema::Validator::Compare 234 # TODO: Move path compilation here from IMPL::DOM::Schema::Validator::Compare
235 return [$path]; 235 return [$path];
236 } 236 }
237 237
238 sub selectNodesAxis { 238 sub selectNodesAxis {
239 my ($this,$query,$axis) = @_; 239 my ($this,$query,$axis) = @_;
240 240
241 $axis ||= 'child'; 241 $axis ||= 'child';
242 242
243 die new IMPL::InvalidOperationException('Unknown axis',$axis) unless exists $Axes{$axis}; 243 die new IMPL::InvalidOperationException('Unknown axis',$axis) unless exists $Axes{$axis};
244 244
250 @result = grep &$query($_), @{$nodes}; 250 @result = grep &$query($_), @{$nodes};
251 } elsif (ref $query eq 'ARRAY' ) { 251 } elsif (ref $query eq 'ARRAY' ) {
252 my %keys = map (($_,1),@$query); 252 my %keys = map (($_,1),@$query);
253 @result = grep $keys{$_->nodeName}, @{$nodes}; 253 @result = grep $keys{$_->nodeName}, @{$nodes};
254 } elsif (ref $query eq 'HASH') { 254 } elsif (ref $query eq 'HASH') {
255 while( my ($axis,$filter) = each %$query ) { 255 while( my ($axis,$filter) = each %$query ) {
256 push @result, $this->selectNodesAxis($filter,$axis); 256 push @result, $this->selectNodesAxis($filter,$axis);
257 } 257 }
258 } elsif (defined $query) { 258 } elsif (defined $query) {
259 @result = grep $_->nodeName eq $query, @{$nodes}; 259 @result = grep $_->nodeName eq $query, @{$nodes};
260 } else { 260 } else {
261 return wantarray ? @{$nodes} : $nodes; 261 return wantarray ? @{$nodes} : $nodes;
262 } 262 }
263 263
264 return wantarray ? @result : \@result; 264 return wantarray ? @result : \@result;
265 } 265 }
266 266
267 sub selectParent { 267 sub selectParent {
268 my ($this) = @_; 268 my ($this) = @_;
269 269
270 if ($this->parentNode) { 270 if ($this->parentNode) {
271 return wantarray ? $this->parentNode : [$this->parentNode]; 271 return wantarray ? $this->parentNode : [$this->parentNode];
272 } else { 272 } else {
273 return wantarray ? () : []; 273 return wantarray ? () : [];
274 } 274 }
275 } 275 }
276 276
277 sub selectSiblings { 277 sub selectSiblings {
278 my ($this) = @_; 278 my ($this) = @_;
279 279
280 if ($this->parentNode) { 280 if ($this->parentNode) {
281 return $this->parentNode->selectNodes( sub { $_ != $this } ); 281 return $this->parentNode->selectNodes( sub { $_ != $this } );
282 } else { 282 } else {
283 return wantarray ? () : []; 283 return wantarray ? () : [];
284 } 284 }
285 } 285 }
286 286
287 sub selectDocument { 287 sub selectDocument {
288 my ($this) = @_; 288 my ($this) = @_;
289 289
290 if ($this->document) { 290 if ($this->document) {
291 return wantarray ? $this->document : [$this->document]; 291 return wantarray ? $this->document : [$this->document];
292 } else { 292 } else {
293 return wantarray ? () : []; 293 return wantarray ? () : [];
294 } 294 }
295 } 295 }
296 296
297 sub selectDescendant { 297 sub selectDescendant {
298 wantarray ? 298 wantarray ?
299 map $_->selectAll(), $_[0]->childNodes : 299 map $_->selectAll(), $_[0]->childNodes :
300 [map $_->selectAll(), $_[0]->childNodes] 300 [map $_->selectAll(), $_[0]->childNodes]
301 } 301 }
302 302
303 sub selectAll { 303 sub selectAll {
304 map(selectAll($_),@{$_[0]->childNodes}) , $_[0] 304 map(selectAll($_),@{$_[0]->childNodes}) , $_[0]
305 } 305 }
306 306
307 sub selectAncestors { 307 sub selectAncestors {
308 my $parent = $_[0]->parentNode; 308 my $parent = $_[0]->parentNode;
309 309
310 wantarray ? 310 wantarray ?
311 ($parent ? ($parent->selectAncestors,$parent) : ()) : 311 ($parent ? ($parent->selectAncestors,$parent) : ()) :
312 [$parent ? ($parent->selectAncestors,$parent) : ()] 312 [$parent ? ($parent->selectAncestors,$parent) : ()]
313 } 313 }
314 314
315 sub firstChild { 315 sub firstChild {
316 @_ >=2 ? $_[0]->replaceNodeAt(0,$_[1]) : $_[0]->childNodes->[0]; 316 @_ >=2 ? $_[0]->replaceNodeAt(0,$_[1]) : $_[0]->childNodes->[0];
317 } 317 }
371 my $name = shift; 371 my $name = shift;
372 372
373 return unless defined $name; 373 return unless defined $name;
374 374
375 if (my $method = $this->can($name)) { 375 if (my $method = $this->can($name)) {
376 unshift @_,$this; 376 unshift @_,$this;
377 # use goto to preserve calling context 377 # use goto to preserve calling context
378 goto &$method; 378 goto &$method;
379 } 379 }
380 # dynamic property 380 # dynamic property
381 if (@_) { 381 if (@_) {
382 # set 382 # set
383 return $this->{$_propertyMap}{$name} = shift; 383 return $this->{$_propertyMap}{$name} = shift;
384 } else { 384 } else {
385 return $this->{$_propertyMap}{$name}; 385 return $this->{$_propertyMap}{$name};
386 } 386 }
387 } 387 }
388 388
389 sub listProperties { 389 sub listProperties {
390 my ($this) = @_; 390 my ($this) = @_;
391 391
392 my %props = map {$_->Name, 1} $this->get_meta(typeof IMPL::Class::PropertyInfo, sub { $_->Attributes->{domProperty}},1); 392 my %props = map {$_->Name, 1} $this->get_meta(typeof IMPL::Class::PropertyInfo, sub { $_->Attributes->{domProperty}},1);
393 393
394 return (keys %props,keys %{$this->{$_propertyMap}}); 394 return (keys %props,keys %{$this->{$_propertyMap}});
395 } 395 }
396 396
397 sub save { 397 sub save {
398 my ($this,$writer) = @_; 398 my ($this,$writer) = @_;
399 399
400 if ( not ( $this->isComplex or defined $this->{$nodeValue} ) ) { 400 if ( not ( $this->isComplex or defined $this->{$nodeValue} ) ) {
401 $writer->emptyTag( 401 $writer->emptyTag(
402 $this->{$nodeName}, 402 $this->{$nodeName},
403 map { 403 map {
404 $_, 404 $_,
405 $this->nodeProperty($_) 405 $this->nodeProperty($_)
406 } grep defined $this->nodeProperty($_), $this->listProperties 406 } grep defined $this->nodeProperty($_), $this->listProperties
407 ); 407 );
408 } else { 408 } else {
409 $writer->startTag( 409 $writer->startTag(
410 $this->{$nodeName}, 410 $this->{$nodeName},
411 map { 411 map {
412 $_, 412 $_,
413 $this->nodeProperty($_) 413 $this->nodeProperty($_)
414 } grep defined $this->nodeProperty($_), $this->listProperties 414 } grep defined $this->nodeProperty($_), $this->listProperties
415 ); 415 );
416 $writer->characters($this->{$nodeValue}) if $this->{$nodeValue}; 416 $writer->characters($this->{$nodeValue}) if $this->{$nodeValue};
417 417
418 $_->save($writer) foreach $this->childNodes; 418 $_->save($writer) foreach $this->childNodes;
419 419
420 $writer->endTag($this->{$nodeName}); 420 $writer->endTag($this->{$nodeName});
421 } 421 }
422 } 422 }
423 423
424 sub qname { 424 sub qname {
425 $_[0]->{$nodeName}; 425 $_[0]->{$nodeName};
426 } 426 }