From a2d12bc84fb2af87dd1c0c6e5bc854554902cd67 Mon Sep 17 00:00:00 2001 From: Lorry Tar Creator Date: Sun, 26 Jan 2003 19:35:03 +0000 Subject: Imported from /home/lorry/working-area/delta_perl-xml-xpath/XML-XPath-1.13.tar.gz. --- XPath/Node/Attribute.pm | 135 +++++++++++++ XPath/Node/Comment.pm | 91 +++++++++ XPath/Node/Element.pm | 503 ++++++++++++++++++++++++++++++++++++++++++++++++ XPath/Node/Namespace.pm | 99 ++++++++++ XPath/Node/PI.pm | 81 ++++++++ XPath/Node/Text.pm | 96 +++++++++ 6 files changed, 1005 insertions(+) create mode 100644 XPath/Node/Attribute.pm create mode 100644 XPath/Node/Comment.pm create mode 100644 XPath/Node/Element.pm create mode 100644 XPath/Node/Namespace.pm create mode 100644 XPath/Node/PI.pm create mode 100644 XPath/Node/Text.pm (limited to 'XPath/Node') diff --git a/XPath/Node/Attribute.pm b/XPath/Node/Attribute.pm new file mode 100644 index 0000000..3e7a6b6 --- /dev/null +++ b/XPath/Node/Attribute.pm @@ -0,0 +1,135 @@ +# $Id: Attribute.pm,v 1.9 2001/11/05 19:57:47 matt Exp $ + +package XML::XPath::Node::Attribute; + +use strict; +use vars qw/@ISA/; + +@ISA = ('XML::XPath::Node'); + +package XML::XPath::Node::AttributeImpl; + +use vars qw/@ISA/; +@ISA = ('XML::XPath::NodeImpl', 'XML::XPath::Node::Attribute'); +use XML::XPath::Node ':node_keys'; + +sub new { + my $class = shift; + my ($key, $val, $prefix) = @_; + + my $pos = XML::XPath::Node->nextPos; + + my @vals; + @vals[node_global_pos, node_prefix, node_key, node_value] = + ($pos, $prefix, $key, $val); + my $self = \@vals; + + bless $self, $class; + +} + +sub getNodeType { ATTRIBUTE_NODE } + +sub isAttributeNode { 1; } + +sub getName { + my $self = shift; + $self->[node_key]; +} + +sub getLocalName { + my $self = shift; + my $local = $self->[node_key]; + $local =~ s/.*://; + return $local; +} + +sub getNodeValue { + my $self = shift; + $self->[node_value]; +} + +sub getData { + shift->getNodeValue(@_); +} + +sub setNodeValue { + my $self = shift; + $self->[node_value] = shift; +} + +sub getPrefix { + my $self = shift; + $self->[node_prefix]; +} + +sub string_value { + my $self = shift; + return $self->[node_value]; +} + +sub toString { + my $self = shift; + my $string = ' '; +# if ($self->[node_prefix]) { +# $string .= $self->[node_prefix] . ':'; +# } + $string .= join('', + $self->[node_key], + '="', + XML::XPath::Node::XMLescape($self->[node_value], '"&><'), + '"'); + return $string; +} + +sub getNamespace { + my $self = shift; + my ($prefix) = @_; + $prefix ||= $self->getPrefix; + if (my $parent = $self->getParentNode) { + return $parent->getNamespace($prefix); + } +} + +1; +__END__ + +=head1 NAME + +Attribute - a single attribute + +=head1 API + +=head2 new ( key, value, prefix ) + +Create a new attribute node. + +=head2 getName + +Returns the key for the attribute + +=head2 getLocalName + +As getName above, but without namespace information + +=head2 getNodeValue / getData + +Returns the value + +=head2 setNodeValue + +Sets the value of the attribute node. + +=head2 getPrefix + +Returns the prefix + +=head2 getNamespace + +Return the namespace. + +=head2 toString + +Generates key="value", encoded correctly. + +=cut diff --git a/XPath/Node/Comment.pm b/XPath/Node/Comment.pm new file mode 100644 index 0000000..e110710 --- /dev/null +++ b/XPath/Node/Comment.pm @@ -0,0 +1,91 @@ +# $Id: Comment.pm,v 1.5 2000/09/05 13:05:46 matt Exp $ + +package XML::XPath::Node::Comment; + +use strict; +use vars qw/@ISA/; + +@ISA = ('XML::XPath::Node'); + +package XML::XPath::Node::CommentImpl; + +use vars qw/@ISA/; +@ISA = ('XML::XPath::NodeImpl', 'XML::XPath::Node::Comment'); +use XML::XPath::Node ':node_keys'; + +sub new { + my $class = shift; + my ($comment) = @_; + + my $pos = XML::XPath::Node->nextPos; + + my @vals; + @vals[node_global_pos, node_comment] = + ($pos, $comment); + my $self = \@vals; + + bless $self, $class; +} + +sub getNodeType { COMMENT_NODE } + +sub isCommentNode { 1; } + +sub getNodeValue { + return shift->[node_comment]; +} + +sub getData { + shift->getNodeValue; +} + +sub setNodeValue { + shift->[node_comment] = shift; +} + +sub _to_sax { + my $self = shift; + my ($doch, $dtdh, $enth) = @_; + + $doch->comment( { Data => $self->getValue } ); +} + +sub comment_escape { + my $data = shift; + $data =~ s/--/--/g; + return $data; +} + +sub string_value { + my $self = shift; + return $self->[node_comment]; +} + +sub toString { + my $self = shift; + return ''; +} + +1; +__END__ + +=head1 NAME + +Comment - an XML comment: + +=head1 API + +=head2 new ( data ) + +Create a new comment node. + +=head2 getValue / getData + +Returns the value in the comment + +=head2 toString + +Returns the comment with -- encoded as a numeric entity (if it +exists in the comment text). + +=cut diff --git a/XPath/Node/Element.pm b/XPath/Node/Element.pm new file mode 100644 index 0000000..5dbafac --- /dev/null +++ b/XPath/Node/Element.pm @@ -0,0 +1,503 @@ +# $Id: Element.pm,v 1.14 2002/12/26 17:24:50 matt Exp $ + +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 .= "[node_name] . ">"; + } + else { + $string .= " />"; + } + + return $string; +} + +1; +__END__ + +=head1 NAME + +Element - an + +=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 diff --git a/XPath/Node/Namespace.pm b/XPath/Node/Namespace.pm new file mode 100644 index 0000000..736d9a3 --- /dev/null +++ b/XPath/Node/Namespace.pm @@ -0,0 +1,99 @@ +# $Id: Namespace.pm,v 1.4 2000/08/24 16:23:02 matt Exp $ + +package XML::XPath::Node::Namespace; + +use strict; +use vars qw/@ISA/; + +@ISA = ('XML::XPath::Node'); + +package XML::XPath::Node::NamespaceImpl; + +use vars qw/@ISA/; +@ISA = ('XML::XPath::NodeImpl', 'XML::XPath::Node::Namespace'); +use XML::XPath::Node ':node_keys'; + +sub new { + my $class = shift; + my ($prefix, $expanded) = @_; + + my $pos = XML::XPath::Node->nextPos; + + my @vals; + @vals[node_global_pos, node_prefix, node_expanded] = + ($pos, $prefix, $expanded); + my $self = \@vals; + + bless $self, $class; +} + +sub getNodeType { NAMESPACE_NODE } + +sub isNamespaceNode { 1; } + +sub getPrefix { + my $self = shift; + $self->[node_prefix]; +} + +sub getExpanded { + my $self = shift; + $self->[node_expanded]; +} + +sub getValue { + my $self = shift; + $self->[node_expanded]; +} + +sub getData { + my $self = shift; + $self->[node_expanded]; +} + +sub string_value { + my $self = shift; + $self->[node_expanded]; +} + +sub toString { + my $self = shift; + my $string = ''; + return '' unless defined $self->[node_expanded]; + if ($self->[node_prefix] eq '#default') { + $string .= ' xmlns="'; + } + else { + $string .= ' xmlns:' . $self->[node_prefix] . '="'; + } + $string .= XML::XPath::Node::XMLescape($self->[node_expanded], '"&<'); + $string .= '"'; +} + +1; +__END__ + +=head1 NAME + +Namespace - an XML namespace node + +=head1 API + +=head2 new ( prefix, expanded ) + +Create a new namespace node, expanded is the expanded namespace URI. + +=head2 getPrefix + +Returns the prefix + +=head2 getExpanded + +Returns the expanded URI + +=head2 toString + +Returns a string that you can add to the list +of attributes of an element: xmlns:prefix="expanded" + +=cut diff --git a/XPath/Node/PI.pm b/XPath/Node/PI.pm new file mode 100644 index 0000000..bf2eb25 --- /dev/null +++ b/XPath/Node/PI.pm @@ -0,0 +1,81 @@ +# $Id: PI.pm,v 1.4 2000/08/24 16:23:02 matt Exp $ + +package XML::XPath::Node::PI; + +use strict; +use vars qw/@ISA/; + +@ISA = ('XML::XPath::Node'); + +package XML::XPath::Node::PIImpl; + +use vars qw/@ISA/; +@ISA = ('XML::XPath::NodeImpl', 'XML::XPath::Node::PI'); +use XML::XPath::Node ':node_keys'; + +sub new { + my $class = shift; + my ($target, $data) = @_; + + my $pos = XML::XPath::Node->nextPos; + + my @vals; + @vals[node_global_pos, node_target, node_data] = + ($pos, $target, $data); + my $self = \@vals; + bless $self, $class; +} + +sub getNodeType { PROCESSING_INSTRUCTION_NODE } + +sub isPINode { 1; } +sub isProcessingInstructionNode { 1; } + +sub getTarget { + my $self = shift; + $self->[node_target]; +} + +sub getData { + my $self = shift; + $self->[node_data]; +} + +sub _to_sax { + my $self = shift; + my ($doch, $dtdh, $enth) = @_; + # PI's not supported in PerlSAX 1 +} + +sub string_value { + my $self = shift; + return $self->[node_data]; +} + +sub toString { + my $self = shift; + return "[node_target] . " " . XML::XPath::Node::XMLescape($self->[node_data], ">") . "?>"; +} + +1; +__END__ + +=head1 NAME + +PI - an XML processing instruction node + +=head1 API + +=head2 new ( target, data ) + +Create a new PI node. + +=head2 getTarget + +Returns the target + +=head2 getData + +Returns the data + +=cut diff --git a/XPath/Node/Text.pm b/XPath/Node/Text.pm new file mode 100644 index 0000000..dad3c04 --- /dev/null +++ b/XPath/Node/Text.pm @@ -0,0 +1,96 @@ +# $Id: Text.pm,v 1.5 2000/09/05 13:05:47 matt Exp $ + +package XML::XPath::Node::Text; + +use strict; +use vars qw/@ISA/; + +@ISA = ('XML::XPath::Node'); + +package XML::XPath::Node::TextImpl; + +use vars qw/@ISA/; +@ISA = ('XML::XPath::NodeImpl', 'XML::XPath::Node::Text'); +use XML::XPath::Node ':node_keys'; + +sub new { + my $class = shift; + my ($text) = @_; + + my $pos = XML::XPath::Node->nextPos; + + my @vals; + @vals[node_global_pos, node_text] = ($pos, $text); + my $self = \@vals; + + bless $self, $class; +} + +sub getNodeType { TEXT_NODE } + +sub isTextNode { 1; } + +sub appendText { + my $self = shift; + my ($text) = @_; + $self->[node_text] .= $text; +} + +sub getNodeValue { + my $self = shift; + $self->[node_text]; +} + +sub getData { + my $self = shift; + $self->[node_text]; +} + +sub setNodeValue { + my $self = shift; + $self->[node_text] = shift; +} + +sub _to_sax { + my $self = shift; + my ($doch, $dtdh, $enth) = @_; + + $doch->characters( { Data => $self->getValue } ); +} + +sub string_value { + my $self = shift; + $self->[node_text]; +} + +sub toString { + my $self = shift; + XML::XPath::Node::XMLescape($self->[node_text], "<&"); +} + +1; +__END__ + +=head1 NAME + +Text - an XML text node + +=head1 API + +=head2 new ( text ) + +Create a new text node. + +=head2 getValue / getData + +Returns the text + +=head2 string_value + +Returns the text + +=head2 appendText ( text ) + +Adds the given text string to this node. + +=cut -- cgit v1.2.1