source: trunk/gsdl/perllib/cpan/XML/XPath/Node/Element.pm@ 7909

# $Id: Element.pm 7909 2004-08-06 05:11:55Z mdewsnip $

package XML::XPath::Node::Element;

use strict;
use vars qw/@ISA/;

@ISA = ('XML::XPath::Node');

package XML::XPath::Node::ElementImpl;

use vars qw/@ISA/;
@ISA = ('XML::XPath::NodeImpl', 'XML::XPath::Node::Element');
use XML::XPath::Node ':node_keys';

sub new {
    my $class = shift;
    my ($tag, $prefix) = @_;
        
    my $pos = XML::XPath::Node->nextPos;

    my @vals;
    @vals[node_global_pos, node_prefix, node_children, node_name, node_attribs] =
            ($pos, $prefix, [], $tag, []);
        
    my $self = \@vals;
    bless $self, $class;
}

sub getNodeType { ELEMENT_NODE }

sub isElementNode { 1; }

sub appendChild {
    my $self = shift;
    my $newnode = shift;
    if (shift) { # called from internal to XML::XPath
#    warn "AppendChild $newnode to $self\n";
        push @{$self->[node_children]}, $newnode;
        $newnode->setParentNode($self);
        $newnode->set_pos($#{$self->[node_children]});
    }
    else {
        if (@{$self->[node_children]}) {
            $self->insertAfter($newnode, $self->[node_children][-1]);
        }
        else {
            my $pos_number = $self->get_global_pos() + 1;
            
            if (my $brother = $self->getNextSibling()) { # optimisation
                if ($pos_number == $brother->get_global_pos()) {
                    $self->renumber('following::node()', +5);
                }
            }
            else {
                eval {
                    if ($pos_number == 
                            $self->findnodes(
                                'following::node()'
                                )->get_node(1)->get_global_pos()) {
                        $self->renumber('following::node()', +5);
                    }
                };
            }
            
            push @{$self->[node_children]}, $newnode;
            $newnode->setParentNode($self);
            $newnode->set_pos($#{$self->[node_children]});
            $newnode->set_global_pos($pos_number);
        }
    }
}

sub removeChild {
    my $self = shift;
    my $delnode = shift;
    
    my $pos = $delnode->get_pos;
    
#    warn "removeChild: $pos\n";
    
#    warn "children: ", scalar @{$self->[node_children]}, "\n";
    
#    my $node = $self->[node_children][$pos];
#    warn "child at $pos is: $node\n";
    
    splice @{$self->[node_children]}, $pos, 1;
    
#    warn "children now: ", scalar @{$self->[node_children]}, "\n";
    
    for (my $i = $pos; $i < @{$self->[node_children]}; $i++) {
#        warn "Changing pos of child: $i\n";
        $self->[node_children][$i]->set_pos($i);
    }
    
    $delnode->del_parent_link;
    
}

sub appendIdElement {
    my $self = shift;
    my ($val, $element) = @_;
#    warn "Adding '$val' to ID hash\n";
    $self->[node_ids]{$val} = $element;
}

sub DESTROY {
    my $self = shift;
#    warn "DESTROY ELEMENT: ", $self->[node_name], "\n";
#    warn "DESTROY ROOT\n" unless $self->[node_name];
    
    foreach my $kid ($self->getChildNodes) {
        $kid && $kid->del_parent_link;
    }
    foreach my $attr ($self->getAttributeNodes) {
        $attr && $attr->del_parent_link;
    }
    foreach my $ns ($self->getNamespaceNodes) {
        $ns && $ns->del_parent_link;
    }
#     $self->[node_children] = undef;
#     $self->[node_attribs] = undef;
#     $self->[node_namespaces] = undef;
}

sub getName {
    my $self = shift;
    $self->[node_name];
}

sub getTagName {
    shift->getName(@_);
}

sub getLocalName {
    my $self = shift;
    my $local = $self->[node_name];
    $local =~ s/.*://;
    return $local;
}

sub getChildNodes {
    my $self = shift;
    return wantarray ? @{$self->[node_children]} : $self->[node_children];
}

sub getChildNode {
    my $self = shift;
    my ($pos) = @_;
    if ($pos < 1 || $pos > @{$self->[node_children]}) {
        return;
    }
    return $self->[node_children][$pos - 1];
}

sub getFirstChild {
    my $self = shift;
    return unless @{$self->[node_children]};
    return $self->[node_children][0];
}

sub getLastChild {
    my $self = shift;
    return unless @{$self->[node_children]};
    return $self->[node_children][-1];
}

sub getAttributeNode {
    my $self = shift;
    my ($name) = @_;
    my $attribs = $self->[node_attribs];
    foreach my $attr (@$attribs) {
        return $attr if $attr->getName eq $name;
    }
}

sub getAttribute {
    my $self = shift;
    my $attr = $self->getAttributeNode(@_);
    if ($attr) {
        return $attr->getValue;
    }
}

sub getAttributes {
    my $self = shift;
    if ($self->[node_attribs]) {
        return wantarray ? @{$self->[node_attribs]} : $self->[node_attribs];
    }
    return wantarray ? () : [];
}

sub appendAttribute {
    my $self = shift;
    my $attribute = shift;
    
    if (shift) { # internal call
        push @{$self->[node_attribs]}, $attribute;
        $attribute->setParentNode($self);
        $attribute->set_pos($#{$self->[node_attribs]});
    }
    else {
        my $node_num;
        if (@{$self->[node_attribs]}) {
            $node_num = $self->[node_attribs][-1]->get_global_pos() + 1;
        }
        else {
            $node_num = $self->get_global_pos() + 1;
        }
        
        eval {
            if (@{$self->[node_children]}) {
                if ($node_num == $self->[node_children][-1]->get_global_pos()) {
                    $self->renumber('descendant::node() | following::node()', +5);
                }
            }
            elsif ($node_num == 
                    $self->findnodes('following::node()')->get_node(1)->get_global_pos()) {
                $self->renumber('following::node()', +5);
            }
        };
        
        push @{$self->[node_attribs]}, $attribute;
        $attribute->setParentNode($self);
        $attribute->set_pos($#{$self->[node_attribs]});
        $attribute->set_global_pos($node_num);
        
    }
}

sub removeAttribute {
    my $self = shift;
    my $attrib = shift;
    
    if (!ref($attrib)) {
        $attrib = $self->getAttributeNode($attrib);
    }
    
    my $pos = $attrib->get_pos;
    
    splice @{$self->[node_attribs]}, $pos, 1;
    
    for (my $i = $pos; $i < @{$self->[node_attribs]}; $i++) {
        $self->[node_attribs][$i]->set_pos($i);
    }
    
    $attrib->del_parent_link;
}

sub setAttribute {
    my $self = shift;
    my ($name, $value) = @_;
    
    if (my $attrib = $self->getAttributeNode($name)) {
        $attrib->setNodeValue($value);
        return $attrib;
    }
    
    my ($nsprefix) = ($name =~ /^($XML::XPath::Parser::NCName):($XML::XPath::Parser::NCName)$/o);
    
    if ($nsprefix && !$self->getNamespace($nsprefix)) {
        die "No namespace matches prefix: $nsprefix";
    }
    
    my $newnode = XML::XPath::Node::Attribute->new($name, $value, $nsprefix);
    $self->appendAttribute($newnode);
}

sub setAttributeNode {
    my $self = shift;
    my ($node) = @_;
    
    if (my $attrib = $self->getAttributeNode($node->getName)) {
        $attrib->setNodeValue($node->getValue);
        return $attrib;
    }
    
    my ($nsprefix) = ($node->getName() =~ /^($XML::XPath::Parser::NCName):($XML::XPath::Parser::NCName)$/o);
    
    if ($nsprefix && !$self->getNamespace($nsprefix)) {
        die "No namespace matches prefix: $nsprefix";
    }
    
    $self->appendAttribute($node);
}

sub getNamespace {
    my $self = shift;
    my ($prefix) = @_;
    $prefix ||= $self->getPrefix || '#default';
    my $namespaces = $self->[node_namespaces] || [];
    foreach my $ns (@$namespaces) {
        return $ns if $ns->getPrefix eq $prefix;
    }
    my $parent = $self->getParentNode;
    
    return $parent->getNamespace($prefix) if $parent;
}

sub getNamespaces {
    my $self = shift;
    if ($self->[node_namespaces]) {
        return wantarray ? @{$self->[node_namespaces]} : $self->[node_namespaces];
    }
    return wantarray ? () : [];
}

sub getNamespaceNodes { goto &getNamespaces }

sub appendNamespace {
    my $self = shift;
    my ($ns) = @_;
    push @{$self->[node_namespaces]}, $ns;
    $ns->setParentNode($self);
    $ns->set_pos($#{$self->[node_namespaces]});
}

sub getPrefix {
    my $self = shift;
    $self->[node_prefix];
}

sub getExpandedName {
    my $self = shift;
    warn "Expanded name not implemented for ", ref($self), "\n";
    return;
}

sub _to_sax {
    my $self = shift;
    my ($doch, $dtdh, $enth) = @_;
    
    my $tag = $self->getName;
    my @attr;
    
    for my $attr ($self->getAttributes) {
        push @attr, $attr->getName, $attr->getValue;
    }
    
    my $ns = $self->getNamespace($self->[node_prefix]);
    if ($ns) {
        $doch->start_element( 
                { 
                Name => $tag,
                Attributes => { @attr },
                NamespaceURI => $ns->getExpanded,
                Prefix => $ns->getPrefix,
                LocalName => $self->getLocalName,
                }
            );
    }
    else {
        $doch->start_element(
                {
                Name => $tag,
                Attributes => { @attr },
                }
            );
    }
    
    for my $kid ($self->getChildNodes) {
        $kid->_to_sax($doch, $dtdh, $enth);
    }
    
    if ($ns) {
        $doch->end_element( 
                {
                Name => $tag,
                NamespaceURI => $ns->getExpanded,
                Prefix => $ns->getPrefix,
                LocalName => $self->getLocalName
                }
            );
    }
    else {
        $doch->end_element( { Name => $tag } );
    }
}

sub string_value {
    my $self = shift;
    my $string = '';
    foreach my $kid (@{$self->[node_children]}) {
        if ($kid->getNodeType == ELEMENT_NODE
                || $kid->getNodeType == TEXT_NODE) {
            $string .= $kid->string_value;
        }
    }
    return $string;
}

sub toString {
    my $self = shift;
    my $norecurse = shift;
    my $string = '';
    if (! $self->[node_name] ) {
            # root node
            return join('', map { $_->toString($norecurse) } @{$self->[node_children]});
    }
    $string .= "<" . $self->[node_name];
    
        $string .= join('', map { $_->toString } @{$self->[node_namespaces]});
    
        $string .= join('', map { $_->toString } @{$self->[node_attribs]});
    
    if (@{$self->[node_children]}) {
        $string .= ">";

        if (!$norecurse) {
                        $string .= join('', map { $_->toString($norecurse) } @{$self->[node_children]});
        }
        
        $string .= "</" . $self->[node_name] . ">";
    }
    else {
        $string .= " />";
    }
    
    return $string;
}

1;
__END__

=head1 NAME

Element - an <element>

=head1 API

=head2 new ( name, prefix )

Create a new Element node with name "name" and prefix "prefix". The name
be "prefix:local" if prefix is defined. I know that sounds wierd, but it
works ;-)

=head2 getName

Returns the name (including "prefix:" if defined) of this element.

=head2 getLocalName

Returns just the local part of the name (the bit after "prefix:").

=head2 getChildNodes

Returns the children of this element. In list context returns a list. In
scalar context returns an array ref.

=head2 getChildNode ( pos )

Returns the child at position pos.

=head2 appendChild ( childnode )

Appends the child node to the list of current child nodes.

=head2 getAttribute ( name )

Returns the attribute node with key name.

=head2 getAttributes / getAttributeNodes

Returns the attribute nodes. In list context returns a list. In scalar
context returns an array ref.

=head2 appendAttribute ( attrib_node)

Appends the attribute node to the list of attributes (XML::XPath stores
attributes in order).

=head2 getNamespace ( prefix )

Returns the namespace node by the given prefix

=head2 getNamespaces / getNamespaceNodes

Returns the namespace nodes. In list context returns a list. In scalar
context returns an array ref.

=head2 appendNamespace ( ns_node )

Appends the namespace node to the list of namespaces.

=head2 getPrefix

Returns the prefix of this element

=head2 getExpandedName

Returns the expanded name of this element (not yet implemented right).

=head2 string_value

For elements, the string_value is the concatenation of all string_values
of all text-descendants of the element node in document order.

=head2 toString ( [ norecurse ] )

Output (and all children) the node to a string. Doesn't process children
if the norecurse option is a true value.

=cut