Mercurial > pub > Impl
annotate Lib/IMPL/DOM/Node.pm @ 46:75148ccd732d
Upgrading resources
| author | Sergey |
|---|---|
| date | Tue, 02 Feb 2010 17:09:49 +0300 |
| parents | d660fb38b7cc |
| children | 16ada169ca75 |
| rev | line source |
|---|---|
| 0 | 1 package IMPL::DOM::Node; |
| 2 use strict; | |
| 3 use warnings; | |
| 4 | |
| 11 | 5 use base qw(IMPL::Object); |
| 0 | 6 |
| 4 | 7 use IMPL::Object::List; |
| 0 | 8 use IMPL::Class::Property; |
| 9 use IMPL::Class::Property::Direct; | |
| 10 use Scalar::Util qw(weaken); | |
| 11 | |
| 1 | 12 use IMPL::Exception; |
| 13 | |
| 0 | 14 BEGIN { |
| 37 | 15 public _direct property nodeName => prop_get; |
| 16 public _direct property document => prop_get; | |
| 4 | 17 public _direct property isComplex => { get => \&_getIsComplex } ; |
| 18 public _direct property nodeValue => prop_all; | |
| 19 public _direct property childNodes => { get => \&_getChildNodes }; | |
| 20 public _direct property parentNode => prop_get ; | |
| 18 | 21 private _direct property _propertyMap => prop_all ; |
| 0 | 22 } |
| 23 | |
| 24 sub CTOR { | |
| 11 | 25 my ($this,%args) = @_; |
| 0 | 26 |
| 37 | 27 $this->{$nodeName} = delete $args{nodeName} or die new IMPL::InvalidArgumentException("A name is required"); |
| 28 $this->{$nodeValue} = delete $args{nodeValue} if exists $args{nodeValue}; | |
| 29 if ( exists $args{document} ) { | |
| 30 $this->{$document} = delete $args{document}; | |
| 31 weaken($this->{$document}); | |
| 32 } | |
| 34 | 33 |
| 34 $this->{$_propertyMap} = \%args; | |
| 0 | 35 } |
| 36 | |
| 37 sub insertNode { | |
| 38 my ($this,$node,$pos) = @_; | |
| 4 | 39 |
| 40 die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node; | |
| 41 | |
| 42 $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); | |
| 43 | |
| 44 $this->childNodes->InsertAt($pos,$node); | |
| 45 | |
| 46 $node->_setParent( $this ); | |
| 47 | |
| 48 return $node; | |
| 49 } | |
| 50 | |
| 30 | 51 sub appendChild { |
|
16
75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
Sergey
parents:
14
diff
changeset
|
52 my ($this,$node) = @_; |
| 14 | 53 |
| 54 die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node; | |
| 55 | |
| 56 $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); | |
| 57 | |
| 18 | 58 my $children = $this->childNodes; |
| 59 $children->Append($node); | |
| 14 | 60 |
| 61 $node->_setParent( $this ); | |
| 62 | |
| 63 return $node; | |
| 64 } | |
| 65 | |
| 30 | 66 sub appendNode { |
| 67 goto &appendChild; | |
| 68 } | |
| 69 | |
|
16
75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
Sergey
parents:
14
diff
changeset
|
70 sub appendRange { |
|
75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
Sergey
parents:
14
diff
changeset
|
71 my ($this,@range) = @_; |
|
75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
Sergey
parents:
14
diff
changeset
|
72 |
|
75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
Sergey
parents:
14
diff
changeset
|
73 die new IMPL::InvalidOperationException("You can't insert the node to itselft") if grep $_ == $this, @range; |
|
75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
Sergey
parents:
14
diff
changeset
|
74 |
|
75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
Sergey
parents:
14
diff
changeset
|
75 foreach my $node (@range) { |
|
75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
Sergey
parents:
14
diff
changeset
|
76 $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); |
|
75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
Sergey
parents:
14
diff
changeset
|
77 $node->_setParent( $this ); |
|
75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
Sergey
parents:
14
diff
changeset
|
78 } |
|
75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
Sergey
parents:
14
diff
changeset
|
79 |
|
75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
Sergey
parents:
14
diff
changeset
|
80 $this->childNodes->Append(@range); |
|
75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
Sergey
parents:
14
diff
changeset
|
81 |
|
75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
Sergey
parents:
14
diff
changeset
|
82 return $this; |
|
75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
Sergey
parents:
14
diff
changeset
|
83 } |
|
75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
Sergey
parents:
14
diff
changeset
|
84 |
| 4 | 85 sub _getChildNodes { |
| 86 my ($this) = @_; | |
| 87 | |
| 88 $this->{$childNodes} = new IMPL::Object::List() unless $this->{$childNodes}; | |
| 18 | 89 return $this->{$childNodes}; |
| 0 | 90 } |
| 91 | |
| 92 sub removeNode { | |
| 93 my ($this,$node) = @_; | |
| 4 | 94 |
| 95 if ($this == $node->{$parentNode}) { | |
| 96 $this->childNodes->RemoveItem($node); | |
| 18 | 97 $node->_setParent(undef); |
| 98 return $node; | |
| 4 | 99 } else { |
| 100 die new IMPL::InvalidOperationException("The specified node isn't belong to this node"); | |
| 101 } | |
| 0 | 102 } |
| 103 | |
| 7 | 104 sub replaceNodeAt { |
| 105 my ($this,$index,$node) = @_; | |
| 106 | |
| 107 my $nodeOld = $this->childNodes->[$index]; | |
| 108 | |
| 109 die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node; | |
| 110 | |
| 111 # unlink node from previous parent | |
| 112 $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); | |
| 113 | |
| 114 # replace (or set) old node | |
| 115 $this->childNodes->[$index] = $node; | |
| 116 | |
| 18 | 117 # set new parent |
| 7 | 118 $node->_setParent( $this ); |
| 119 | |
| 120 # unlink old node if we have one | |
| 18 | 121 $nodeOld->_setParent(undef) if $nodeOld; |
| 7 | 122 |
| 123 # return old node | |
| 124 return $nodeOld; | |
| 125 } | |
| 126 | |
| 0 | 127 sub removeAt { |
| 128 my ($this,$pos) = @_; | |
| 4 | 129 |
| 130 if ( my $node = $this->childNodes->RemoveAt($pos) ) { | |
| 18 | 131 $node->_setParent(undef); |
| 132 return $node; | |
| 133 } else { | |
| 134 return undef; | |
| 135 } | |
| 136 } | |
| 137 | |
| 138 sub removeLast { | |
| 139 my ($this) = @_; | |
| 140 | |
| 141 if ( my $node = $this->{$childNodes} ? $this->{$childNodes}->RemoveLast() : undef) { | |
| 142 $node->_setParent(undef); | |
| 4 | 143 return $node; |
| 144 } else { | |
| 145 return undef; | |
| 146 } | |
| 0 | 147 } |
| 148 | |
| 18 | 149 sub removeSelected { |
| 150 my ($this,$query) = @_; | |
| 151 | |
| 152 my @newSet; | |
| 153 my @result; | |
| 154 | |
| 155 if (ref $query eq 'CODE') { | |
| 156 &$query($_) ? push @result, $_ : push @newSet, $_ foreach @{$this->childNodes}; | |
| 157 } elsif (defined $query) { | |
| 158 $_->nodeName eq $query ? push @result, $_ : push @newSet, $_ foreach @{$this->childNodes}; | |
| 159 } else { | |
| 160 my $children = $this->childNodes; | |
| 161 $_->_setParent(undef) foreach @$children; | |
| 162 delete $this->{$childNodes}; | |
| 163 return wantarray ? @$children : $children; | |
| 164 } | |
| 165 | |
| 166 $_->_setParent(undef) foreach @result; | |
| 167 | |
| 168 $this->{$childNodes} = @newSet ? bless \@newSet ,'IMPL::Object::List' : undef; | |
| 169 | |
| 170 return wantarray ? @result : \@result; | |
| 171 } | |
| 172 | |
| 0 | 173 sub selectNodes { |
| 14 | 174 my ($this,$query) = @_; |
| 18 | 175 |
| 14 | 176 my @result; |
| 4 | 177 |
| 14 | 178 if (ref $query eq 'CODE') { |
| 179 @result = grep &$query($_), @{$this->childNodes}; | |
| 24 | 180 } elsif (ref $query eq 'ARRAY' ) { |
| 181 my %keys = map (($_,1),@$query); | |
| 182 @result = grep $keys{$_->nodeName}, @{$this->childNodes}; | |
| 18 | 183 } elsif (defined $query) { |
| 184 @result = grep $_->nodeName eq $query, @{$this->childNodes}; | |
| 14 | 185 } else { |
| 18 | 186 if (wantarray) { |
| 187 return @{$this->childNodes}; | |
| 188 } else { | |
| 189 @result = $this->childNodes; | |
| 190 return \@result; | |
| 191 } | |
| 14 | 192 } |
| 4 | 193 |
| 194 return wantarray ? @result : \@result; | |
| 0 | 195 } |
| 196 | |
| 7 | 197 sub firstChild { |
| 198 @_ >=2 ? $_[0]->replaceNodeAt(0,$_[1]) : $_[0]->childNodes->[0]; | |
| 199 } | |
| 200 | |
| 4 | 201 sub _getIsComplex { |
| 202 $_[0]->childNodes->Count ? 1 : 0; | |
| 203 } | |
| 204 | |
| 37 | 205 sub _updateDocRefs { |
| 18 | 206 my ($this) = @_; |
| 207 | |
| 37 | 208 # this method is called by the parent node on his children, so we need no to check parent |
| 209 $this->{$document} = $this->{$parentNode}->document; | |
| 36 | 210 |
| 38 | 211 # prevent cyclic |
| 37 | 212 weaken($this->{$document}) if $this->{$document}; |
| 213 | |
| 214 $_->_updateDocRefs foreach @{$this->{$childNodes}}; | |
| 18 | 215 } |
| 216 | |
| 4 | 217 sub _setParent { |
| 11 | 218 my ($this,$node) = @_; |
| 4 | 219 |
| 18 | 220 |
| 221 if (($node || 0) != ($this->{$parentNode} || 0)) { | |
| 37 | 222 my $newOwner; |
| 18 | 223 if ($node) { |
| 224 $this->{$parentNode} = $node; | |
| 37 | 225 $newOwner = $node->document || 0; |
| 226 | |
| 18 | 227 # prevent from creating cyclicreferences |
| 228 weaken($this->{$parentNode}); | |
| 37 | 229 |
| 18 | 230 } else { |
| 231 delete $this->{$parentNode}; | |
| 37 | 232 $newOwner = 0; |
| 18 | 233 } |
| 37 | 234 |
| 235 if (($this->{$document}||0) != $newOwner) { | |
| 236 $this->{$document} = $newOwner; | |
| 237 weaken($this->{$document}) if $newOwner; | |
| 238 $_->_updateDocRefs foreach @{$this->childNodes}; | |
| 239 } | |
| 18 | 240 } |
| 0 | 241 } |
| 242 | |
| 243 sub text { | |
| 244 my ($this) = @_; | |
| 4 | 245 |
| 37 | 246 join ('', $this->nodeValue || '', map ($_->text || '', @{$this->childNodes})); |
| 0 | 247 } |
| 248 | |
| 21 | 249 sub nodeProperty { |
| 0 | 250 my $this = shift; |
| 251 my $name = shift; | |
| 252 | |
| 253 if (@_) { | |
| 254 # set | |
| 6 | 255 return $this->{$_propertyMap}{$name} = shift; |
| 0 | 256 } else { |
| 6 | 257 return $this->{$_propertyMap}{$name}; |
| 0 | 258 } |
| 259 } | |
| 260 | |
| 24 | 261 sub qname { |
| 262 $_[0]->{$nodeName}; | |
| 263 } | |
| 264 | |
| 265 sub path { | |
| 266 my ($this) = @_; | |
| 267 | |
| 268 if ($this->parentNode) { | |
| 269 return $this->parentNode->path.'.'.$this->qname; | |
| 270 } else { | |
| 271 return $this->qname; | |
| 272 } | |
| 273 } | |
| 274 | |
| 0 | 275 1; |