1# $Id: Element.pm,v 1.14 2002/12/26 17:24:50 matt Exp $
2
3package XML::XPath::Node::Element;
4
5use strict;
6use vars qw/@ISA/;
7
8@ISA = ('XML::XPath::Node');
9
10package XML::XPath::Node::ElementImpl;
11
12use vars qw/@ISA/;
13@ISA = ('XML::XPath::NodeImpl', 'XML::XPath::Node::Element');
14use XML::XPath::Node ':node_keys';
15
16sub new {
17    my $class = shift;
18    my ($tag, $prefix) = @_;
19
20    my $pos = XML::XPath::Node->nextPos;
21
22    my @vals;
23    @vals[node_global_pos, node_prefix, node_children, node_name, node_attribs] =
24            ($pos, $prefix, [], $tag, []);
25
26    my $self = \@vals;
27    bless $self, $class;
28}
29
30sub getNodeType { ELEMENT_NODE }
31
32sub isElementNode { 1; }
33
34sub appendChild {
35    my $self = shift;
36    my $newnode = shift;
37    if (shift) { # called from internal to XML::XPath
38#    warn "AppendChild $newnode to $self\n";
39        push @{$self->[node_children]}, $newnode;
40        $newnode->setParentNode($self);
41        $newnode->set_pos($#{$self->[node_children]});
42    }
43    else {
44        if (@{$self->[node_children]}) {
45            $self->insertAfter($newnode, $self->[node_children][-1]);
46        }
47        else {
48            my $pos_number = $self->get_global_pos() + 1;
49
50            if (my $brother = $self->getNextSibling()) { # optimisation
51                if ($pos_number == $brother->get_global_pos()) {
52                    $self->renumber('following::node()', +5);
53                }
54            }
55            else {
56                eval {
57                    if ($pos_number ==
58                            $self->findnodes(
59                                'following::node()'
60                                )->get_node(1)->get_global_pos()) {
61                        $self->renumber('following::node()', +5);
62                    }
63                };
64            }
65
66            push @{$self->[node_children]}, $newnode;
67            $newnode->setParentNode($self);
68            $newnode->set_pos($#{$self->[node_children]});
69            $newnode->set_global_pos($pos_number);
70        }
71    }
72}
73
74sub removeChild {
75    my $self = shift;
76    my $delnode = shift;
77
78    my $pos = $delnode->get_pos;
79
80#    warn "removeChild: $pos\n";
81
82#    warn "children: ", scalar @{$self->[node_children]}, "\n";
83
84#    my $node = $self->[node_children][$pos];
85#    warn "child at $pos is: $node\n";
86
87    splice @{$self->[node_children]}, $pos, 1;
88
89#    warn "children now: ", scalar @{$self->[node_children]}, "\n";
90
91    for (my $i = $pos; $i < @{$self->[node_children]}; $i++) {
92#        warn "Changing pos of child: $i\n";
93        $self->[node_children][$i]->set_pos($i);
94    }
95
96    $delnode->del_parent_link;
97
98}
99
100sub appendIdElement {
101    my $self = shift;
102    my ($val, $element) = @_;
103#    warn "Adding '$val' to ID hash\n";
104    $self->[node_ids]{$val} = $element;
105}
106
107sub DESTROY {
108    my $self = shift;
109#    warn "DESTROY ELEMENT: ", $self->[node_name], "\n";
110#    warn "DESTROY ROOT\n" unless $self->[node_name];
111
112    foreach my $kid ($self->getChildNodes) {
113        $kid && $kid->del_parent_link;
114    }
115    foreach my $attr ($self->getAttributeNodes) {
116        $attr && $attr->del_parent_link;
117    }
118    foreach my $ns ($self->getNamespaceNodes) {
119        $ns && $ns->del_parent_link;
120    }
121#     $self->[node_children] = undef;
122#     $self->[node_attribs] = undef;
123#     $self->[node_namespaces] = undef;
124}
125
126sub getName {
127    my $self = shift;
128    $self->[node_name];
129}
130
131sub getTagName {
132    shift->getName(@_);
133}
134
135sub getLocalName {
136    my $self = shift;
137    my $local = $self->[node_name];
138    $local =~ s/.*://;
139    return $local;
140}
141
142sub getChildNodes {
143    my $self = shift;
144    return wantarray ? @{$self->[node_children]} : $self->[node_children];
145}
146
147sub getChildNode {
148    my $self = shift;
149    my ($pos) = @_;
150    if ($pos < 1 || $pos > @{$self->[node_children]}) {
151        return;
152    }
153    return $self->[node_children][$pos - 1];
154}
155
156sub getFirstChild {
157    my $self = shift;
158    return unless @{$self->[node_children]};
159    return $self->[node_children][0];
160}
161
162sub getLastChild {
163    my $self = shift;
164    return unless @{$self->[node_children]};
165    return $self->[node_children][-1];
166}
167
168sub getAttributeNode {
169    my $self = shift;
170    my ($name) = @_;
171    my $attribs = $self->[node_attribs];
172    foreach my $attr (@$attribs) {
173        return $attr if $attr->getName eq $name;
174    }
175}
176
177sub getAttribute {
178    my $self = shift;
179    my $attr = $self->getAttributeNode(@_);
180    if ($attr) {
181        return $attr->getValue;
182    }
183}
184
185sub getAttributes {
186    my $self = shift;
187    if ($self->[node_attribs]) {
188        return wantarray ? @{$self->[node_attribs]} : $self->[node_attribs];
189    }
190    return wantarray ? () : [];
191}
192
193sub appendAttribute {
194    my $self = shift;
195    my $attribute = shift;
196
197    if (shift) { # internal call
198        push @{$self->[node_attribs]}, $attribute;
199        $attribute->setParentNode($self);
200        $attribute->set_pos($#{$self->[node_attribs]});
201    }
202    else {
203        my $node_num;
204        if (@{$self->[node_attribs]}) {
205            $node_num = $self->[node_attribs][-1]->get_global_pos() + 1;
206        }
207        else {
208            $node_num = $self->get_global_pos() + 1;
209        }
210
211        eval {
212            if (@{$self->[node_children]}) {
213                if ($node_num == $self->[node_children][-1]->get_global_pos()) {
214                    $self->renumber('descendant::node() | following::node()', +5);
215                }
216            }
217            elsif ($node_num ==
218                    $self->findnodes('following::node()')->get_node(1)->get_global_pos()) {
219                $self->renumber('following::node()', +5);
220            }
221        };
222
223        push @{$self->[node_attribs]}, $attribute;
224        $attribute->setParentNode($self);
225        $attribute->set_pos($#{$self->[node_attribs]});
226        $attribute->set_global_pos($node_num);
227
228    }
229}
230
231sub removeAttribute {
232    my $self = shift;
233    my $attrib = shift;
234
235    if (!ref($attrib)) {
236        $attrib = $self->getAttributeNode($attrib);
237    }
238
239    my $pos = $attrib->get_pos;
240
241    splice @{$self->[node_attribs]}, $pos, 1;
242
243    for (my $i = $pos; $i < @{$self->[node_attribs]}; $i++) {
244        $self->[node_attribs][$i]->set_pos($i);
245    }
246
247    $attrib->del_parent_link;
248}
249
250sub setAttribute {
251    my $self = shift;
252    my ($name, $value) = @_;
253
254    if (my $attrib = $self->getAttributeNode($name)) {
255        $attrib->setNodeValue($value);
256        return $attrib;
257    }
258
259    my ($nsprefix) = ($name =~ /^($XML::XPath::Parser::NCName):($XML::XPath::Parser::NCName)$/o);
260
261    if ($nsprefix && !$self->getNamespace($nsprefix)) {
262        die "No namespace matches prefix: $nsprefix";
263    }
264
265    my $newnode = XML::XPath::Node::Attribute->new($name, $value, $nsprefix);
266    $self->appendAttribute($newnode);
267}
268
269sub setAttributeNode {
270    my $self = shift;
271    my ($node) = @_;
272
273    if (my $attrib = $self->getAttributeNode($node->getName)) {
274        $attrib->setNodeValue($node->getValue);
275        return $attrib;
276    }
277
278    my ($nsprefix) = ($node->getName() =~ /^($XML::XPath::Parser::NCName):($XML::XPath::Parser::NCName)$/o);
279
280    if ($nsprefix && !$self->getNamespace($nsprefix)) {
281        die "No namespace matches prefix: $nsprefix";
282    }
283
284    $self->appendAttribute($node);
285}
286
287sub getNamespace {
288    my $self = shift;
289    my ($prefix) = @_;
290    $prefix ||= $self->getPrefix || '#default';
291    my $namespaces = $self->[node_namespaces] || [];
292    foreach my $ns (@$namespaces) {
293        return $ns if $ns->getPrefix eq $prefix;
294    }
295    my $parent = $self->getParentNode;
296
297    return $parent->getNamespace($prefix) if $parent;
298}
299
300sub getNamespaces {
301    my $self = shift;
302    if ($self->[node_namespaces]) {
303        return wantarray ? @{$self->[node_namespaces]} : $self->[node_namespaces];
304    }
305    return wantarray ? () : [];
306}
307
308sub getNamespaceNodes { goto &getNamespaces }
309
310sub appendNamespace {
311    my $self = shift;
312    my ($ns) = @_;
313    push @{$self->[node_namespaces]}, $ns;
314    $ns->setParentNode($self);
315    $ns->set_pos($#{$self->[node_namespaces]});
316}
317
318sub getPrefix {
319    my $self = shift;
320    $self->[node_prefix];
321}
322
323sub getExpandedName {
324    my $self = shift;
325    warn "Expanded name not implemented for ", ref($self), "\n";
326    return;
327}
328
329sub _to_sax {
330    my $self = shift;
331    my ($doch, $dtdh, $enth) = @_;
332
333    my $tag = $self->getName;
334    my @attr;
335
336    for my $attr ($self->getAttributes) {
337        push @attr, $attr->getName, $attr->getValue;
338    }
339
340    my $ns = $self->getNamespace($self->[node_prefix]);
341    if ($ns) {
342        $doch->start_element(
343                {
344                Name => $tag,
345                Attributes => { @attr },
346                NamespaceURI => $ns->getExpanded,
347                Prefix => $ns->getPrefix,
348                LocalName => $self->getLocalName,
349                }
350            );
351    }
352    else {
353        $doch->start_element(
354                {
355                Name => $tag,
356                Attributes => { @attr },
357                }
358            );
359    }
360
361    for my $kid ($self->getChildNodes) {
362        $kid->_to_sax($doch, $dtdh, $enth);
363    }
364
365    if ($ns) {
366        $doch->end_element(
367                {
368                Name => $tag,
369                NamespaceURI => $ns->getExpanded,
370                Prefix => $ns->getPrefix,
371                LocalName => $self->getLocalName
372                }
373            );
374    }
375    else {
376        $doch->end_element( { Name => $tag } );
377    }
378}
379
380sub string_value {
381    my $self = shift;
382    my $string = '';
383    foreach my $kid (@{$self->[node_children]}) {
384        if ($kid->getNodeType == ELEMENT_NODE
385                || $kid->getNodeType == TEXT_NODE) {
386            $string .= $kid->string_value;
387        }
388    }
389    return $string;
390}
391
392sub toString {
393    my $self = shift;
394    my $norecurse = shift;
395    my $string = '';
396    if (! $self->[node_name] ) {
397            # root node
398            return join('', map { $_->toString($norecurse) } @{$self->[node_children]});
399    }
400    $string .= "<" . $self->[node_name];
401
402        $string .= join('', map { $_->toString } @{$self->[node_namespaces]});
403
404        $string .= join('', map { $_->toString } @{$self->[node_attribs]});
405
406    if (@{$self->[node_children]}) {
407        $string .= ">";
408
409        if (!$norecurse) {
410                        $string .= join('', map { $_->toString($norecurse) } @{$self->[node_children]});
411        }
412
413        $string .= "</" . $self->[node_name] . ">";
414    }
415    else {
416        $string .= " />";
417    }
418
419    return $string;
420}
421
4221;
423__END__
424
425=head1 NAME
426
427Element - an <element>
428
429=head1 API
430
431=head2 new ( name, prefix )
432
433Create a new Element node with name "name" and prefix "prefix". The name
434be "prefix:local" if prefix is defined. I know that sounds wierd, but it
435works ;-)
436
437=head2 getName
438
439Returns the name (including "prefix:" if defined) of this element.
440
441=head2 getLocalName
442
443Returns just the local part of the name (the bit after "prefix:").
444
445=head2 getChildNodes
446
447Returns the children of this element. In list context returns a list. In
448scalar context returns an array ref.
449
450=head2 getChildNode ( pos )
451
452Returns the child at position pos.
453
454=head2 appendChild ( childnode )
455
456Appends the child node to the list of current child nodes.
457
458=head2 getAttribute ( name )
459
460Returns the attribute node with key name.
461
462=head2 getAttributes / getAttributeNodes
463
464Returns the attribute nodes. In list context returns a list. In scalar
465context returns an array ref.
466
467=head2 appendAttribute ( attrib_node)
468
469Appends the attribute node to the list of attributes (XML::XPath stores
470attributes in order).
471
472=head2 getNamespace ( prefix )
473
474Returns the namespace node by the given prefix
475
476=head2 getNamespaces / getNamespaceNodes
477
478Returns the namespace nodes. In list context returns a list. In scalar
479context returns an array ref.
480
481=head2 appendNamespace ( ns_node )
482
483Appends the namespace node to the list of namespaces.
484
485=head2 getPrefix
486
487Returns the prefix of this element
488
489=head2 getExpandedName
490
491Returns the expanded name of this element (not yet implemented right).
492
493=head2 string_value
494
495For elements, the string_value is the concatenation of all string_values
496of all text-descendants of the element node in document order.
497
498=head2 toString ( [ norecurse ] )
499
500Output (and all children) the node to a string. Doesn't process children
501if the norecurse option is a true value.
502
503=cut
504