home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / XML / XPath / Node / Element.pm < prev    next >
Encoding:
Perl POD Document  |  2003-01-26  |  12.2 KB  |  504 lines
  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
  504.