dummy_foundation/lib/XML/XQL/DOM.pm
changeset 4 60053dab7e2a
parent 3 8b87ea768cb8
child 5 c34a018f3291
--- a/dummy_foundation/lib/XML/XQL/DOM.pm	Wed Jun 03 18:33:51 2009 +0100
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,622 +0,0 @@
-############################################################################
-# Copyright (c) 1998 Enno Derksen
-# All rights reserved.
-# This program is free software; you can redistribute it and/or modify it
-# under the same terms as Perl itself.
-############################################################################
-#
-# Functions added to the XML::DOM implementation for XQL support
-#
-# NOTE: This code is a bad example of how to use XML::DOM.
-# I'm accessing internal (private) data members for a little gain in performance.
-# When the internal DOM implementation changes, this code will no longer work.
-# But since I maintain XML::DOM, it's easy for me to keep them in sync.
-# Regular users are adviced to use the XML::DOM API as described in the 
-# documentation.
-#
-
-use strict;
-package XML::XQL::DOM;
-
-BEGIN
-{
-    require XML::DOM;
-
-    # import constant field definitions, e.g. _Doc
-    import XML::DOM::Node qw{ :Fields };
-}
-
-package XML::DOM::Node;
-
-sub xql
-{
-    my $self = shift;
-
-    # Odd number of args, assume first is XQL expression without 'Expr' key
-    unshift @_, 'Expr' if (@_ % 2 == 1);
-    my $query = new XML::XQL::Query (@_);
-    my @result = $query->solve ($self);
-    $query->dispose;
-
-    @result;
-}
-
-sub xql_sortKey
-{
-    my $key = $_[0]->[_SortKey];
-    return $key if defined $key;
-
-    $key = XML::XQL::createSortKey ($_[0]->[_Parent]->xql_sortKey, 
-				    $_[0]->xql_childIndex, 1);
-#print "xql_sortKey $_[0] ind=" . $_[0]->xql_childIndex . " key=$key str=" . XML::XQL::keyStr($key) . "\n";
-    $_[0]->[_SortKey] = $key;
-}
-
-# Find previous sibling that is not a text node with ignorable whitespace
-sub xql_prevNonWS
-{
-    my $self = shift;
-    my $parent = $self->[_Parent];
-    return unless $parent;
-
-    for (my $i = $parent->getChildIndex ($self) - 1; $i >= 0; $i--)
-    {
-	my $node = $parent->getChildAtIndex ($i);
-	return $node unless $node->xql_isIgnorableWS;	# skip whitespace
-    }
-    undef;
-}
-
-# True if it's a Text node with just whitespace and xml::space != "preserve"
-sub xql_isIgnorableWS
-{
-    0;
-}
-
-# Whether the node should preserve whitespace
-# It should if it has attribute xml:space="preserve"
-sub xql_preserveSpace
-{
-    $_[0]->[_Parent]->xql_preserveSpace;
-}
-
-sub xql_element
-{
-#?? I wonder which implemention is used for e.g. DOM::Text, since XML::XQL::Node also has an implementation
-    [];
-}
-
-sub xql_document
-{
-    $_[0]->[_Doc];
-}
-
-sub xql_node
-{
-    my $kids = $_[0]->[_C];
-    if (defined $kids)
-    {
-	# Must copy the list or else we return a blessed reference
-	# (which causes trouble later on)
-	my @list = @$kids;
-	return \@list;
-    }
-
-    [];
-}
-
-#?? implement something to support NamedNodeMaps in DocumentType
-sub xql_childIndex
-{
-    $_[0]->[_Parent]->getChildIndex ($_[0]);
-}
-
-#?? implement something to support NamedNodeMaps in DocumentType
-sub xql_childCount
-{
-    my $ch = $_[0]->[_C];
-    defined $ch ? scalar(@$ch) : 0;
-}
-
-sub xql_parent
-{
-    $_[0]->[_Parent];
-}
-
-sub xql_DOM_nodeType
-{
-    $_[0]->getNodeType;
-}
-
-sub xql_nodeType
-{
-    $_[0]->getNodeType;
-}
-
-# As it appears in the XML document
-sub xql_xmlString
-{
-    $_[0]->toString;
-}
-
-package XML::DOM::Element;
-
-sub xql_attribute
-{
-    my ($node, $attrName) = @_;
-
-    if (defined $attrName)
-    {
-	my $attr = $node->getAttributeNode ($attrName);
-	defined ($attr) ? [ $attr ] : [];
-    }
-    else
-    {
-	defined $node->[_A] ? $node->[_A]->getValues : [];
-    }
-}
-
-# Used by XML::XQL::Union::genSortKey to generate sort keys
-# Returns the maximum of the number of children and the number of Attr nodes.
-sub xql_childCount
-{
-    my $n = scalar @{$_[0]->[_C]};
-    my $m = defined $_[0]->[_A] ? $_[0]->[_A]->getLength : 0;
-    return $n > $m ? $n : $m;
-}
-
-sub xql_element
-{
-    my ($node, $elem) = @_;
-
-    my @list;
-    if (defined $elem)
-    {
-	for my $kid (@{$node->[_C]})
-	{
-	    push @list, $kid if $kid->isElementNode && $kid->[_TagName] eq $elem;
-	}
-    }
-    else
-    {
-	for my $kid (@{$node->[_C]})
-	{
-	    push @list, $kid if $kid->isElementNode;
-	}
-    }
-    \@list;
-}
-
-sub xql_nodeName
-{
-    $_[0]->[_TagName];
-}
-
-sub xql_baseName
-{
-    my $name = $_[0]->[_TagName];
-    $name =~ s/^\w*://;
-    $name;
-}
-
-sub xql_prefix
-{
-    my $name = $_[0]->[_TagName];
-    $name =~ /([^:]+):/;
-    $1;
-}
-
-sub xql_rawText
-{
-    my ($self, $recurse) = @_;
-    $recurse = 1 unless defined $recurse;
-
-    my $text = "";
-
-    for my $kid (@{$self->xql_node})
-    {
-	my $type = $kid->xql_nodeType;
-
-	# type=1: element
-	# type=3: text (Text, CDATASection, EntityReference)
-	if (($type == 1 && $recurse) || $type == 3)
-	{
-	    $text .= $kid->xql_rawText ($recurse);
-	}
-    }
-    $text;
-}
-
-sub xql_text
-{
-    my ($self, $recurse) = @_;
-    $recurse = 1 unless defined $recurse;
-
-    my $j = -1;
-    my @text;
-    my $last_was_text = 0;
-
-    # Collect text blocks. Consecutive blocks of Text, CDataSection and 
-    # EntityReference nodes should be merged without stripping and without
-    # putting spaces in between.
-    for my $kid (@{$self->xql_node})
-    {
-	my $type = $kid->xql_nodeType;
-
-	if ($type == 1)	    # 1: element
-	{
-	    if ($recurse)
-	    {
-		$text[++$j] = $kid->xql_text ($recurse);
-	    }
-	    $last_was_text = 0;
-	}
-	elsif ($type == 3)  # 3: text (Text, CDATASection, EntityReference)
-	{
-	    ++$j unless $last_was_text;		# next text block
-	    $text[$j] .= $kid->getData;
-	    $last_was_text = 1;
-	}
-	else	# e.g. Comment
-	{
-	    $last_was_text = 0;
-	}
-    }
-
-    # trim whitespace and remove empty blocks
-    my $i = 0;
-    my $n = @text;
-    while ($i < $n)
-    {
-	# similar to XML::XQL::trimSpace
-	$text[$i] =~ s/^\s+//;
-	$text[$i] =~ s/\s+$//;
-
-	if ($text[$i] eq "")
-	{
-	    splice (@text, $i, 1);	# remove empty block
-	    $n--;
-	}
-	else
-	{
-	    $i++;
-	}
-    }
-    join (" ", @text);
-}
-
-#
-# Returns a list of text blocks for this Element.
-# A text block is a concatenation of consecutive text-containing nodes (i.e.
-# Text, CDATASection or EntityReference nodes.)
-# For each text block a reference to an array is returned with the following
-# 3 items:
-#  [0] index of first node of the text block
-#  [1] index of last node of the text block
-#  [2] concatenation of the raw text (of the nodes in this text block)
-#
-# The text blocks are returned in reverse order for the convenience of
-# the routines that want to modify the text blocks.
-#
-sub xql_rawTextBlocks
-{
-    my ($self) = @_;
-
-    my @result;
-    my $curr;
-    my $prevWasText = 0;
-    my $kids = $self->[_C];
-    my $n = @$kids;
-    for (my $i = 0; $i < $n; $i++)
-    {
-	my $node = $kids->[$i];
-	# 3: text (Text, CDATASection, EntityReference)
-	if ($node->xql_nodeType == 3)
-	{
-	    if ($prevWasText)
-	    {
-		$curr->[1] = $i;
-		$curr->[2] .= $node->getData;
-	    }
-	    else
-	    {
-		$curr = [$i, $i, $node->getData];
-		unshift @result, $curr;
-		$prevWasText = 1;
-	    }
-	}
-	else
-	{
-	    $prevWasText = 0;
-	}
-    }
-    @result;
-}
-
-sub xql_replaceBlockWithText
-{
-    my ($self, $start, $end, $text) = @_;
-    for (my $i = $end; $i > $start; $i--)
-    {
-	# dispose of the old nodes
-	$self->removeChild ($self->[_C]->[$i])->dispose;
-    }
-    my $node = $self->[_C]->[$start];
-    my $newNode = $self->[_Doc]->createTextNode ($text);
-    $self->replaceChild ($newNode, $node)->dispose;
-}
-
-sub xql_setValue
-{
-    my ($self, $str) = @_;
-    # Remove all children
-    for my $kid (@{$self->[_C]})
-    {
-	$self->removeChild ($kid);
-    }
-    # Add a (single) text node
-    $self->appendChild ($self->[_Doc]->createTextNode ($str));
-}
-
-sub xql_value
-{
-    XML::XQL::elementValue ($_[0]);
-}
-
-sub xql_preserveSpace
-{
-    # attribute value should be "preserve" (1), "default" (0) or "" (ask parent)
-    my $space = $_[0]->getAttribute ("xml:space");
-    $space eq "" ? $_[0]->[_Parent]->xql_preserveSpace : ($space eq "preserve");
-}
-
-package XML::DOM::Attr;
-
-sub xql_sortKey
-{
-    my $key = $_[0]->[_SortKey];
-    return $key if defined $key;
-
-    $_[0]->[_SortKey] = XML::XQL::createSortKey ($_[0]->xql_parent->xql_sortKey, 
-						$_[0]->xql_childIndex, 0);
-}
-
-sub xql_nodeName
-{
-    $_[0]->getNodeName;
-}
-
-sub xql_text
-{
-    XML::XQL::trimSpace ($_[0]->getValue);
-}
-
-sub xql_rawText
-{
-    $_[0]->getValue;
-}
-
-sub xql_value
-{
-    XML::XQL::attrValue ($_[0]);
-}
-
-sub xql_setValue
-{
-    $_[0]->setValue ($_[1]);
-}
-
-sub xql_baseName
-{
-    my $name = $_[0]->getNodeName;
-    $name =~ s/^\w*://;
-    $name;
-}
-
-sub xql_prefix
-{
-    my $name = $_[0]->getNodeName;
-    $name =~ s/:\w*$//;
-    $name;
-}
-
-sub xql_parent
-{
-    $_[0]->[_UsedIn]->{''}->{Parent};
-}
-
-sub xql_childIndex
-{
-    my $map = $_[0]->[_UsedIn];
-    $map ? $map->getChildIndex ($_[0]) : 0;
-}
-
-package XML::DOM::Text;
-
-sub xql_rawText
-{
-    $_[0]->[_Data];
-}
-
-sub xql_text
-{
-    XML::XQL::trimSpace ($_[0]->[_Data]);
-}
-
-sub xql_setValue
-{
-    $_[0]->setData ($_[1]);
-}
-
-sub xql_isIgnorableWS
-{
-    $_[0]->[_Data] =~ /^\s*$/ &&
-    !$_[0]->xql_preserveSpace;
-}
-
-package XML::DOM::CDATASection;
-
-sub xql_rawText
-{
-    $_[0]->[_Data];
-}
-
-sub xql_text
-{
-    XML::XQL::trimSpace ($_[0]->[_Data]);
-}
-
-sub xql_setValue
-{
-    $_[0]->setData ($_[1]);
-}
-
-sub xql_nodeType
-{
-    3;	# it contains text, so XQL spec states it's a text node
-}
-
-package XML::DOM::EntityReference;
-
-BEGIN
-{
-    # import constant field definitions, e.g. _Data
-    import XML::DOM::CharacterData qw{ :Fields };
-}
-
-sub xql_text
-{
-    $_[0]->getData;
-}
-
-sub xql_rawText
-{
-    XML::XQL::trimSpace ($_[0]->[_Data]);
-}
-
-sub xql_setValue
-{
-    $_[0]->setData ($_[1]);
-}
-
-sub xql_nodeType
-{
-    3;	# it contains text, so XQL spec states it's a text node
-}
-
-package XML::DOM::Document;
-
-BEGIN
-{
-    # import constant field definitions, e.g. _TagName
-    import XML::DOM::Element qw{ :Fields };
-}
-
-sub xql_sortKey
-{
-    "";
-}
-
-sub xql_element
-{
-    my ($node, $elem) = @_;
-
-    my @list;
-    if (defined $elem)
-    {
-	for my $kid (@{$node->[_C]})
-	{
-	    push @list, $kid if $kid->isElementNode && $kid->[_TagName] eq $elem;
-	}
-    }
-    else
-    {
-	for my $kid (@{$node->[_C]})
-	{
-	    push @list, $kid if $kid->isElementNode;
-	}
-    }
-    \@list;
-}
-
-sub xql_parent
-{
-    undef;
-}
-
-# By default the elements in a document don't preserve whitespace
-sub xql_preserveSpace
-{
-    0;
-}
-
-package XML::DOM::DocumentFragment;
-
-BEGIN
-{
-    # import constant field definitions, e.g. _TagName
-    import XML::DOM::Element qw{ :Fields };
-}
-
-sub xql_element
-{
-    my ($node, $elemName) = @_;
-
-    my @list;
-    if (defined $elemName)
-    {
-	for my $kid (@{$node->[_C]})
-	{
-	    push @list, $kid if $kid->isElementNode && $kid->[_TagName] eq $elemName;
-	}
-    }
-    else
-    {
-	for my $kid (@{$node->[_C]})
-	{
-	    push @list, $kid if $kid->isElementNode;
-	}
-    }
-    \@list;
-}
-
-sub xql_parent
-{
-    undef;
-}
-
-1; # module loaded successfuly
-
-__END__
-
-=head1 NAME
-
-XML::XQL::DOM - Adds XQL support to XML::DOM nodes
-
-=head1 SYNOPSIS
-
- use XML::XQL;
- use XML::XQL::DOM;
-
- $parser = new XML::DOM::Parser;
- $doc = $parser->parsefile ("file.xml");
-
- # Return all elements with tagName='title' under the root element 'book'
- $query = new XML::XQL::Query (Expr => "book/title");
- @result = $query->solve ($doc);
-
- # Or (to save some typing)
- @result = XML::XQL::solve ("book/title", $doc);
-
- # Or (see XML::DOM::Node)
- @result = $doc->xql ("book/title");
-
-=head1 DESCRIPTION
-
-XML::XQL::DOM adds methods to L<XML::DOM> nodes to support XQL queries
-on XML::DOM document structures.
-
-See L<XML::XQL> and L<XML::XQL::Query> for more details.
-L<XML::DOM::Node> describes the B<xql()> method.
-
-