Mercurial > pub > Impl
annotate Lib/IMPL/DOM/Node.pm @ 163:6ce1f052b90a
temp commit
| author | wizard |
|---|---|
| date | Tue, 15 Mar 2011 02:32:42 +0300 |
| parents | 1e7f03414b65 |
| children | 76515373dac0 |
| rev | line source |
|---|---|
| 49 | 1 package IMPL::DOM::Node; |
| 2 use strict; | |
| 3 use warnings; | |
| 4 | |
| 5 use base qw(IMPL::Object); | |
| 6 | |
| 7 use IMPL::Object::List; | |
| 8 use IMPL::Class::Property; | |
| 9 use IMPL::Class::Property::Direct; | |
| 10 use Scalar::Util qw(weaken); | |
| 11 | |
| 12 use IMPL::Exception; | |
| 13 | |
| 14 BEGIN { | |
| 15 public _direct property nodeName => prop_get; | |
| 16 public _direct property document => prop_get; | |
| 17 public _direct property isComplex => { get => \&_getIsComplex } ; | |
| 18 public _direct property nodeValue => prop_all; | |
| 102 | 19 public _direct property childNodes => { get => \&_getChildNodes }; # prop_list |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
20 public _direct property parentNode => prop_get | owner_set; |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
21 public _direct property schema => prop_get | owner_set; |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
22 public _direct property schemaSource => prop_get | owner_set; |
| 49 | 23 private _direct property _propertyMap => prop_all ; |
| 116 | 24 |
| 25 __PACKAGE__->class_data(property_bind => {}); | |
| 49 | 26 } |
| 27 | |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
28 our %Axes = ( |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
29 parent => \&selectParent, |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
30 siblings => \&selectSiblings, |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
31 child => \&childNodes, |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
32 document => \&selectDocument, |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
33 ancestor => \&selectAncestors, |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
34 descendant => \&selectDescendant |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
35 ); |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
36 |
| 49 | 37 sub CTOR { |
| 38 my ($this,%args) = @_; | |
| 39 | |
| 40 $this->{$nodeName} = delete $args{nodeName} or die new IMPL::InvalidArgumentException("A name is required"); | |
| 41 $this->{$nodeValue} = delete $args{nodeValue} if exists $args{nodeValue}; | |
| 42 if ( exists $args{document} ) { | |
| 43 $this->{$document} = delete $args{document}; | |
| 44 weaken($this->{$document}); | |
| 45 } | |
| 46 | |
| 124 | 47 while ( my ($key,$value) = each %args ) { |
| 48 $this->nodeProperty($key,$value); | |
| 49 } | |
| 49 | 50 } |
| 51 | |
| 52 sub insertNode { | |
| 53 my ($this,$node,$pos) = @_; | |
| 54 | |
| 55 die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node; | |
| 56 | |
| 57 $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); | |
| 58 | |
| 59 $this->childNodes->InsertAt($pos,$node); | |
| 60 | |
| 61 $node->_setParent( $this ); | |
| 62 | |
| 63 return $node; | |
| 64 } | |
| 65 | |
| 66 sub appendChild { | |
| 67 my ($this,$node) = @_; | |
| 68 | |
| 69 die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node; | |
| 70 | |
| 71 $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); | |
| 72 | |
| 73 my $children = $this->childNodes; | |
| 74 $children->Append($node); | |
| 75 | |
| 76 $node->_setParent( $this ); | |
| 77 | |
| 78 return $node; | |
| 79 } | |
| 80 | |
| 81 sub appendNode { | |
| 82 goto &appendChild; | |
| 83 } | |
| 84 | |
| 85 sub appendRange { | |
| 86 my ($this,@range) = @_; | |
| 87 | |
| 88 die new IMPL::InvalidOperationException("You can't insert the node to itselft") if grep $_ == $this, @range; | |
| 89 | |
| 90 foreach my $node (@range) { | |
| 91 $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); | |
| 92 $node->_setParent( $this ); | |
| 93 } | |
| 94 | |
| 95 $this->childNodes->Append(@range); | |
| 96 | |
| 97 return $this; | |
| 98 } | |
| 99 | |
| 100 sub _getChildNodes { | |
| 101 my ($this) = @_; | |
| 102 | |
| 103 $this->{$childNodes} = new IMPL::Object::List() unless $this->{$childNodes}; | |
| 102 | 104 return wantarray ? @{ $this->{$childNodes} } : $this->{$childNodes}; |
| 49 | 105 } |
| 106 | |
|
109
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
107 sub childNodesRef { |
|
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
108 my ($this) = @_; |
|
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
109 return scalar $this->_getChildNodes; |
|
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
110 } |
|
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
111 |
| 49 | 112 sub removeNode { |
| 113 my ($this,$node) = @_; | |
| 114 | |
| 115 if ($this == $node->{$parentNode}) { | |
| 116 $this->childNodes->RemoveItem($node); | |
| 117 $node->_setParent(undef); | |
| 118 return $node; | |
| 119 } else { | |
| 120 die new IMPL::InvalidOperationException("The specified node isn't belong to this node"); | |
| 121 } | |
| 122 } | |
| 123 | |
| 124 sub replaceNodeAt { | |
| 125 my ($this,$index,$node) = @_; | |
| 126 | |
| 127 my $nodeOld = $this->childNodes->[$index]; | |
| 128 | |
| 129 die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node; | |
| 130 | |
| 131 # unlink node from previous parent | |
| 132 $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); | |
| 133 | |
| 134 # replace (or set) old node | |
| 135 $this->childNodes->[$index] = $node; | |
| 136 | |
| 137 # set new parent | |
| 138 $node->_setParent( $this ); | |
| 139 | |
| 140 # unlink old node if we have one | |
| 141 $nodeOld->_setParent(undef) if $nodeOld; | |
| 142 | |
| 143 # return old node | |
| 144 return $nodeOld; | |
| 145 } | |
| 146 | |
| 147 sub removeAt { | |
| 148 my ($this,$pos) = @_; | |
| 149 | |
| 150 if ( my $node = $this->childNodes->RemoveAt($pos) ) { | |
| 151 $node->_setParent(undef); | |
| 152 return $node; | |
| 153 } else { | |
| 154 return undef; | |
| 155 } | |
| 156 } | |
| 157 | |
| 158 sub removeLast { | |
| 159 my ($this) = @_; | |
| 160 | |
| 161 if ( my $node = $this->{$childNodes} ? $this->{$childNodes}->RemoveLast() : undef) { | |
| 162 $node->_setParent(undef); | |
| 163 return $node; | |
| 164 } else { | |
| 165 return undef; | |
| 166 } | |
| 167 } | |
| 168 | |
| 169 sub removeSelected { | |
| 170 my ($this,$query) = @_; | |
| 171 | |
| 172 my @newSet; | |
| 173 my @result; | |
| 174 | |
| 175 if (ref $query eq 'CODE') { | |
| 176 &$query($_) ? push @result, $_ : push @newSet, $_ foreach @{$this->childNodes}; | |
| 177 } elsif (defined $query) { | |
| 178 $_->nodeName eq $query ? push @result, $_ : push @newSet, $_ foreach @{$this->childNodes}; | |
| 179 } else { | |
| 180 my $children = $this->childNodes; | |
| 181 $_->_setParent(undef) foreach @$children; | |
| 182 delete $this->{$childNodes}; | |
| 183 return wantarray ? @$children : $children; | |
| 184 } | |
| 185 | |
| 186 $_->_setParent(undef) foreach @result; | |
| 187 | |
| 188 $this->{$childNodes} = @newSet ? bless \@newSet ,'IMPL::Object::List' : undef; | |
| 189 | |
| 190 return wantarray ? @result : \@result; | |
| 191 } | |
| 192 | |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
193 sub resolveAxis { |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
194 my ($this,$axis) = @_; |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
195 return $Axes{$axis}->($this) |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
196 } |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
197 |
| 49 | 198 sub selectNodes { |
| 108 | 199 my $this = shift; |
| 122 | 200 my $path; |
| 108 | 201 |
| 122 | 202 if (@_ == 1) { |
| 203 $path = $this->translatePath($_[0]); | |
| 204 } else { | |
| 205 $path = [@_]; | |
| 206 } | |
| 108 | 207 |
| 208 my @set = ($this); | |
| 209 | |
| 122 | 210 while (@$path) { |
| 211 my $query = shift @$path; | |
| 108 | 212 @set = map $_->selectNodesAxis($query), @set; |
| 213 } | |
| 214 | |
| 215 return wantarray ? @set : \@set; | |
| 216 } | |
| 217 | |
| 113 | 218 sub selectSingleNode { |
| 219 my $this = shift; | |
| 220 my @result = $this->selectNodes(@_); | |
| 221 return $result[0]; | |
| 222 } | |
| 223 | |
|
109
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
224 sub selectNodesRef { |
|
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
225 my $this = shift; |
|
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
226 |
|
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
227 my @result = $this->selectNodes(@_); |
|
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
228 return \@result; |
|
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
229 } |
|
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
230 |
| 108 | 231 sub translatePath { |
| 232 my ($this,$path) = @_; | |
| 233 | |
| 234 # TODO: Move path compilation here from IMPL::DOM::Schema::Validator::Compare | |
| 235 return [$path]; | |
| 236 } | |
| 237 | |
| 238 sub selectNodesAxis { | |
| 239 my ($this,$query,$axis) = @_; | |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
240 |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
241 $axis ||= 'child'; |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
242 |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
243 die new IMPL::InvalidOperationException('Unknown axis',$axis) unless exists $Axes{$axis}; |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
244 |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
245 my $nodes = $this->resolveAxis($axis); |
| 49 | 246 |
| 247 my @result; | |
| 248 | |
| 249 if (ref $query eq 'CODE') { | |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
250 @result = grep &$query($_), @{$nodes}; |
| 49 | 251 } elsif (ref $query eq 'ARRAY' ) { |
| 252 my %keys = map (($_,1),@$query); | |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
253 @result = grep $keys{$_->nodeName}, @{$nodes}; |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
254 } elsif (ref $query eq 'HASH') { |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
255 while( my ($axis,$filter) = each %$query ) { |
| 108 | 256 push @result, $this->selectNodesAxis($filter,$axis); |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
257 } |
| 49 | 258 } elsif (defined $query) { |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
259 @result = grep $_->nodeName eq $query, @{$nodes}; |
| 49 | 260 } else { |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
261 return wantarray ? @{$nodes} : $nodes; |
| 49 | 262 } |
| 263 | |
| 264 return wantarray ? @result : \@result; | |
| 265 } | |
| 266 | |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
267 sub selectParent { |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
268 my ($this) = @_; |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
269 |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
270 if ($this->parentNode) { |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
271 return wantarray ? $this->parentNode : [$this->parentNode]; |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
272 } else { |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
273 return wantarray ? () : []; |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
274 } |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
275 } |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
276 |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
277 sub selectSiblings { |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
278 my ($this) = @_; |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
279 |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
280 if ($this->parentNode) { |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
281 return $this->parentNode->selectNodes( sub { $_ != $this } ); |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
282 } else { |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
283 return wantarray ? () : []; |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
284 } |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
285 } |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
286 |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
287 sub selectDocument { |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
288 my ($this) = @_; |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
289 |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
290 if ($this->document) { |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
291 return wantarray ? $this->document : [$this->document]; |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
292 } else { |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
293 return wantarray ? () : []; |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
294 } |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
295 } |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
296 |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
297 sub selectDescendant { |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
298 wantarray ? |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
299 map $_->selectAll(), $_[0]->childNodes : |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
300 [map $_->selectAll(), $_[0]->childNodes] |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
301 } |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
302 |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
303 sub selectAll { |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
304 map(selectAll($_),@{$_[0]->childNodes}) , $_[0] |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
305 } |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
306 |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
307 sub selectAncestors { |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
308 my $parent = $_[0]->parentNode; |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
309 |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
310 wantarray ? |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
311 ($parent ? ($parent->selectAncestors,$parent) : ()) : |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
312 [$parent ? ($parent->selectAncestors,$parent) : ()] |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
313 } |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
314 |
| 49 | 315 sub firstChild { |
| 316 @_ >=2 ? $_[0]->replaceNodeAt(0,$_[1]) : $_[0]->childNodes->[0]; | |
| 317 } | |
| 318 | |
| 319 sub _getIsComplex { | |
| 152 | 320 ($_[0]->{$childNodes} and $_[0]->{$childNodes}->Count) ? 1 : 0; |
| 49 | 321 } |
| 322 | |
| 323 sub _updateDocRefs { | |
| 324 my ($this) = @_; | |
| 325 | |
| 326 # this method is called by the parent node on his children, so we need no to check parent | |
| 327 $this->{$document} = $this->{$parentNode}->document; | |
| 328 | |
| 329 # prevent cyclic | |
| 330 weaken($this->{$document}) if $this->{$document}; | |
| 331 | |
| 332 $_->_updateDocRefs foreach @{$this->{$childNodes}}; | |
| 333 } | |
| 334 | |
| 335 sub _setParent { | |
| 336 my ($this,$node) = @_; | |
| 337 | |
| 338 | |
| 339 if (($node || 0) != ($this->{$parentNode} || 0)) { | |
| 340 my $newOwner; | |
| 341 if ($node) { | |
| 342 $this->{$parentNode} = $node; | |
| 343 $newOwner = $node->document || 0; | |
| 344 | |
| 345 # prevent from creating cyclicreferences | |
| 346 weaken($this->{$parentNode}); | |
| 347 | |
| 348 } else { | |
| 349 delete $this->{$parentNode}; | |
| 75 | 350 |
| 351 #keep document | |
| 352 $newOwner = $this->{$document}; | |
| 49 | 353 } |
| 354 | |
| 355 if (($this->{$document}||0) != $newOwner) { | |
| 356 $this->{$document} = $newOwner; | |
| 357 weaken($this->{$document}) if $newOwner; | |
| 358 $_->_updateDocRefs foreach @{$this->childNodes}; | |
| 359 } | |
| 360 } | |
| 361 } | |
| 362 | |
| 363 sub text { | |
| 364 my ($this) = @_; | |
| 365 | |
| 366 join ('', $this->nodeValue || '', map ($_->text || '', @{$this->childNodes})); | |
| 367 } | |
| 368 | |
| 369 sub nodeProperty { | |
| 370 my $this = shift; | |
| 371 my $name = shift; | |
| 372 | |
| 122 | 373 if (my $method = $this->can($name)) { |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
374 unshift @_,$this; |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
375 # use goto to preserve calling context |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
376 goto &$method; |
| 122 | 377 } |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
378 # dynamic property |
| 49 | 379 if (@_) { |
| 122 | 380 # set |
| 381 return $this->{$_propertyMap}{$name} = shift; | |
| 382 } else { | |
| 383 return $this->{$_propertyMap}{$name}; | |
| 49 | 384 } |
| 385 } | |
| 386 | |
| 122 | 387 sub listProperties { |
| 388 my ($this) = @_; | |
| 389 | |
| 390 my %props = map {$_->Name, 1} $this->get_meta(typeof IMPL::Class::PropertyInfo, sub { $_->Attributes->{domProperty}},1); | |
| 391 | |
| 392 return (keys %props,keys %{$this->{$_propertyMap}}); | |
| 393 } | |
| 394 | |
| 152 | 395 sub save { |
| 396 my ($this,$writer) = @_; | |
| 397 | |
| 398 if ( not ( $this->isComplex or defined $this->{$nodeValue} ) ) { | |
| 399 $writer->emptyTag( | |
| 400 $this->{$nodeName}, | |
| 401 map { | |
| 402 $_, | |
| 403 $this->nodeProperty($_) | |
| 404 } grep defined $this->nodeProperty($_), $this->listProperties | |
| 405 ); | |
| 406 } else { | |
| 407 $writer->startTag( | |
| 408 $this->{$nodeName}, | |
| 409 map { | |
| 410 $_, | |
| 411 $this->nodeProperty($_) | |
| 412 } grep defined $this->nodeProperty($_), $this->listProperties | |
| 413 ); | |
| 414 $writer->characters($this->{$nodeValue}) if $this->{$nodeValue}; | |
| 415 | |
| 416 $_->save($writer) foreach $this->childNodes; | |
| 417 | |
| 418 $writer->endTag($this->{$nodeName}); | |
| 419 } | |
| 420 } | |
| 421 | |
| 49 | 422 sub qname { |
| 423 $_[0]->{$nodeName}; | |
| 424 } | |
| 425 | |
| 426 sub path { | |
| 427 my ($this) = @_; | |
| 428 | |
| 429 if ($this->parentNode) { | |
| 430 return $this->parentNode->path.'.'.$this->qname; | |
| 431 } else { | |
| 432 return $this->qname; | |
| 433 } | |
| 434 } | |
| 435 | |
| 436 1; | |
| 75 | 437 |
| 438 __END__ | |
| 439 | |
| 440 =pod | |
| 441 | |
| 442 =head1 NAME | |
| 443 | |
| 444 C<IMPL::DOM::Node> Элемент DOM модели | |
| 445 | |
| 446 =head1 DESCRIPTION | |
| 447 | |
| 448 Базовый узел DOM модели. От него можно наследовать другие элементы DOM модели. | |
| 449 | |
| 450 =head1 MEMBERS | |
| 451 | |
| 452 =head2 PROPERTIES | |
| 453 | |
| 454 =over | |
| 455 | |
| 456 =item C<[get] nodeName> | |
| 457 | |
| 458 Имя узла. Задается при создании. | |
| 459 | |
| 460 =item C<[get] document> | |
| 461 | |
| 462 Документ к которому принадлежит узел. Задается при поздании узла. | |
| 463 | |
| 464 =item C<[get] isComplex> | |
| 465 | |
| 466 Определяет является ли узел сложным (тоесть есть ли дети). | |
| 467 | |
| 468 C<true> - есть, C<false> - нет. | |
| 469 | |
| 470 =item C<[get,set] nodeValue> | |
| 471 | |
| 472 Значение узла, обычно простой скаляр, но ничто не мешает туда | |
| 473 устанавливать любое значение. | |
| 474 | |
| 475 =item C<[get,list] childNodes> | |
| 476 | |
| 477 Список детей, является списокм C<IMPL::Object::List>. | |
| 478 | |
| 479 =item C<[get] parentNode> | |
| 480 | |
| 481 Ссылка на родительский элемент, если таковой имеется. | |
| 482 | |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
483 =item C<[get] schema> |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
484 |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
485 Ссылка на узел из C<IMPL::DOM::Schema>, представляющий схему данных текущего узла. Может быть C<undef>. |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
486 |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
487 =item C<[get] schema> |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
488 |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
489 Ссылка на узел из C<IMPL::DOM::Schema>, представляющий элемент схемы, объявляющий данный узел. Может быть C<undef>. |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
490 |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
491 Отличается от свойства C<schema> тем, что узел в случае ссылки на тип узла, данной свойство будет содержать |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
492 описание ссылки C<IMPL::DOM::Schema::Node>, а свойство C<schema> например будет ссылаться на |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
493 C<IMPL::DOM::Schema::ComplexType>. |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
494 |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
495 =back |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
496 |
| 75 | 497 =head2 METHODS |
| 498 | |
| 499 =cut |