[Summary view] [Print] [Text view]

   1  # $Id: Element.pm,v 1.14 2002/12/26 17:24:50 matt Exp $
   2  
   3  package XML::XPath::Node::Element;
   4  
   5  use strict;
   6  use vars qw/@ISA/;
   7  
   8  @ISA = ('XML::XPath::Node');
   9  
  10  package XML::XPath::Node::ElementImpl;
  11  
  12  use vars qw/@ISA/;
  13  @ISA = ('XML::XPath::NodeImpl', 'XML::XPath::Node::Element');
  14  use XML::XPath::Node ':node_keys';
  15  
  16  sub 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  
  30  sub getNodeType { ELEMENT_NODE }
  31  
  32  sub isElementNode { 1; }
  33  
  34  sub 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  
  74  sub 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  
 100  sub 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  
 107  sub 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  
 126  sub getName {
 127      my $self = shift;
 128      $self->[node_name];
 129  }
 130  
 131  sub getTagName {
 132      shift->getName(@_);
 133  }
 134  
 135  sub getLocalName {
 136      my $self = shift;
 137      my $local = $self->[node_name];
 138      $local =~ s/.*://;
 139      return $local;
 140  }
 141  
 142  sub getChildNodes {
 143      my $self = shift;
 144      return wantarray ? @{$self->[node_children]} : $self->[node_children];
 145  }
 146  
 147  sub 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  
 156  sub getFirstChild {
 157      my $self = shift;
 158      return unless @{$self->[node_children]};
 159      return $self->[node_children][0];
 160  }
 161  
 162  sub getLastChild {
 163      my $self = shift;
 164      return unless @{$self->[node_children]};
 165      return $self->[node_children][-1];
 166  }
 167  
 168  sub 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  
 177  sub getAttribute {
 178      my $self = shift;
 179      my $attr = $self->getAttributeNode(@_);
 180      if ($attr) {
 181          return $attr->getValue;
 182      }
 183  }
 184  
 185  sub 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  
 193  sub 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  
 231  sub 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  
 250  sub 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  
 269  sub 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  
 287  sub 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  
 300  sub 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  
 308  sub getNamespaceNodes { goto &getNamespaces }
 309  
 310  sub 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  
 318  sub getPrefix {
 319      my $self = shift;
 320      $self->[node_prefix];
 321  }
 322  
 323  sub getExpandedName {
 324      my $self = shift;
 325      warn "Expanded name not implemented for ", ref($self), "\n";
 326      return;
 327  }
 328  
 329  sub _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  
 380  sub 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  
 392  sub 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  
 422  1;
 423  __END__
 424  
 425  =head1 NAME
 426  
 427  Element - an <element>
 428  
 429  =head1 API
 430  
 431  =head2 new ( name, prefix )
 432  
 433  Create a new Element node with name "name" and prefix "prefix". The name
 434  be "prefix:local" if prefix is defined. I know that sounds wierd, but it
 435  works ;-)
 436  
 437  =head2 getName
 438  
 439  Returns the name (including "prefix:" if defined) of this element.
 440  
 441  =head2 getLocalName
 442  
 443  Returns just the local part of the name (the bit after "prefix:").
 444  
 445  =head2 getChildNodes
 446  
 447  Returns the children of this element. In list context returns a list. In
 448  scalar context returns an array ref.
 449  
 450  =head2 getChildNode ( pos )
 451  
 452  Returns the child at position pos.
 453  
 454  =head2 appendChild ( childnode )
 455  
 456  Appends the child node to the list of current child nodes.
 457  
 458  =head2 getAttribute ( name )
 459  
 460  Returns the attribute node with key name.
 461  
 462  =head2 getAttributes / getAttributeNodes
 463  
 464  Returns the attribute nodes. In list context returns a list. In scalar
 465  context returns an array ref.
 466  
 467  =head2 appendAttribute ( attrib_node)
 468  
 469  Appends the attribute node to the list of attributes (XML::XPath stores
 470  attributes in order).
 471  
 472  =head2 getNamespace ( prefix )
 473  
 474  Returns the namespace node by the given prefix
 475  
 476  =head2 getNamespaces / getNamespaceNodes
 477  
 478  Returns the namespace nodes. In list context returns a list. In scalar
 479  context returns an array ref.
 480  
 481  =head2 appendNamespace ( ns_node )
 482  
 483  Appends the namespace node to the list of namespaces.
 484  
 485  =head2 getPrefix
 486  
 487  Returns the prefix of this element
 488  
 489  =head2 getExpandedName
 490  
 491  Returns the expanded name of this element (not yet implemented right).
 492  
 493  =head2 string_value
 494  
 495  For elements, the string_value is the concatenation of all string_values
 496  of all text-descendants of the element node in document order.
 497  
 498  =head2 toString ( [ norecurse ] )
 499  
 500  Output (and all children) the node to a string. Doesn't process children
 501  if the norecurse option is a true value.
 502  
 503  =cut