FCL/sftools/dev/build: comparison deprecated/buildtools/buildsystemtools/lib/XML/XQL.pm

equal deleted inserted replaced

-:7c11c3d8d025
+:60be34e1b006
+############################################################################
+# Copyright (c) 1998,1999 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.
+############################################################################
+#
+# To do (in no particular order):
+#
+# - Element tag names that are the same as a XQL keyword (e.g. "or", "not", ..)
+#   are currently not supported. The parser and lexer needs to be smarter and
+#   know what context they are in.
+# - output using xql:result etc.
+# - xml:space=preserve still needs to be adhered to in text() etc.
+#   - I already added xql_preserveSpace. Still need to use it in (raw)text() etc.
+# - XQL functions (like value()) should probably work on input lists > 1 node
+#   (The code was changed, but it needs to be tested. ancestor() wasn't fixed)
+# - verify implementation of xql_namespace
+# - verify implementation of end, index
+# - check passing of context to the solve() methods
+# - functions/methods may be wrong. They receive the entire LHS set,
+#   so count() is right, but the rest may be wrong!
+# - may need to use different comment delimiters, '#' may be used in future XQL
+#   definition (according to Joe Lapp, one of the XQL spec authors)
+# - caching of Node xql_values (?)
+# - finish the Date class
+#   - discuss which classes: Date, Time, and/or DateTime ?
+# - conversion of Query result to Perl primitives, i.e. how do we return the
+#   result of a query.
+# - add support for ordering/formatting the query results, see XML-QL
+# - discuss typecasting mechanism
+# - error reporting mechanism
+#   - yyerror handler doesn't seem to work
+#   - passing intermediate exceptions ($@) to the user
+#   - more debugging support
+# - subst, map etc.
+#   - use rawText for Nodes?
+#     - recurse or not?
+# - text/rawText default - recurse or not?
+#   - what should default value() implementation use?
+# - check if all Syntactic Constraints in XQL spec are implemented
+# - support all node types, i.e. Notation, Attlist etc.
+#   - sorting in 'document order' doesn't work yet for 'other' DOM nodes
+# - generateFunction - support functions that return lists?
+# - match() function - what should it return?
+# - keeping track of reference nodes not always done right
+#   - also think about Perl builtin functions
+# - conversion to Perl number throws warnings with -w (in comparisons etc.)
+# - sorting
+#   - add sorting by attribute name (within same element)
+#     (or other criteria)
+#   - optional sorting in $union$ ?
+#     - could add a flag that says "don't worry about document order for $union$"
+#   - user defined sort?
+# - OPTIMIZE!
+#   - Subscript operator
+#   - Filter operator
+#   - etc.
+package XML::XQL;
+use strict;
+use Carp;
+use XML::RegExp;
+use vars qw( @EXPORT $VERSION
+	     $ContextStart $ContextEnd $BoldOn $BoldOff
+	     %Func %Method %FuncArgCount
+	     %AllowedOutsideSubquery %ConstFunc %ExpandedType
+	     $Restricted $Included $ReXQLName
+	     %CompareOper $Token_q $Token_qq $LAST_SORT_KEY
+	   );
+@EXPORT = qw( $VERSION $Restricted $Included );
+BEGIN
+{
+$VERSION = '0.63';
+die "XML::XQL is already used/required" if defined $Included;
+$Included = 1;
+# From XQL spec (The '-' was added to allow XPath style function names.)
+$ReXQLName =	  "(?:[-a-zA-Z_]+\\w*)";
+$Token_q = undef;
+$Token_qq = undef;
+$Restricted = 0 unless defined $Restricted;
+if (not $Restricted)
+{
+	# Allow names with Perl package prefixes
+	$ReXQLName = "(?:$ReXQLName(?:::$ReXQLName)*)";
+	# Support q// and qq// strings
+	$Token_q = "q";
+	$Token_qq = "qq";
+}
+};
+# To save the user some typing for the simplest cases
+sub solve
+{
+my ($expr, @args) = @_;
+my $query = new XML::XQL::Query (Expr => $expr);
+my @result = $query->solve (@args);
+$query->dispose;
+@result;
+}
+#---------- Parser related stuff ----------------------------------------------
+# Find (nested) closing delimiter in q{} or qq{} strings
+sub parse_q
+{
+my ($qname, $q, $str, $d1, $d2) = @_;
+my ($match) = "";
+my ($found);
+while ($str =~ /^([^$d1$d2]*)($d1|($d2))(.*)/s)
+{
+	defined ($3) and return ($4, $match . $1);		# $d2 found
+	# match delimiters recursively
+	$match .= $1 . $2;
+	($str, $found) = parse_q ($qname, $q, $4, $d1, $d2);
+	$match .= $found . $d2;
+}
+XML::XQL::parseError ("no $qname// closing delimiter found near '$q$d1'");
+}
+# To support nested delimiters in q{} and qq() strings
+my %MatchingCloseDelim =
+(
+'{' => '}',
+'(' => ')',
+'<' => '>',
+'[' => ']'
+);
+sub Lexer
+{
+my($parser)=shift;
+exists($parser->YYData->{LINE})
+	or $parser->YYData->{LINE} = 1;
+$parser->YYData->{INPUT}
+	or return('', undef);
+print "Lexer input=[" . $parser->YYData->{INPUT} . "]\n"
+	if $parser->{yydebug};
+if ($Restricted)
+{
+	# strip leading whitespace
+	$parser->YYData->{INPUT} =~ s/^\s*//;
+}
+else
+{
+	# strip leading whitespace and comments
+	$parser->YYData->{INPUT} =~ s/^(\s|#.*)*//;
+}
+for ($parser->YYData->{INPUT})
+{
+	s#^"([^"]*)"##o	and return ('TEXT', $1);
+	s#^'([^']*)'##o	and return ('TEXT', $1);
+	if (not $Restricted)
+	{
+	    # Support q// and qq// string delimiters
+	    for my $qname ('q', 'qq')
+	    {
+		my ($q) = $parser->{Query}->{$qname};
+		if (defined ($q) and s/^$q(\[\(\{\<#!=-\+|'":;\.,\?\/!@\%^\*)//)
+		{
+		    my ($d1, $d2) = ($1, $MatchingCloseDelim{$1});
+		    my ($str);
+		    if (defined $d2)
+		    {
+			($parser->YYData->{INPUT}, $str) = parse_q (
+					$qname, $q, $_, $d1, $d2);
+		    }
+		    else	# close delim is same open delim
+		    {
+			$d2 = $d1;
+			s/([^$d2])*$d2// or XML::XQL::parseError (
+			    "no $qname// closing delimiter found near '$q$d1'");
+			$str = $1;
+		    }
+		    return ('TEXT', eval "$q$d1$str$d2");
+		}
+	    }
+	}
+	s/^(-?\d+\.(\d+)?)//		and return ('NUMBER', $1);
+	s/^(-?\d+)//			and return ('INTEGER', $1);
+	s/^(\$|\b)(i?(eq|ne|lt|le|gt|ge))\1(?=\W)//i
+					and return ('COMPARE', "\L$2");
+	s/^((\$|\b)(any|all|or|and|not|to|intersect)\2)(?=\W)//i
+					and return ("\L$3", $1);
+	s/^((\$|\b)union\2(?=\W)|\|)//i	and return ('UnionOp', $1);
+	s/^(;;?)//			and return ('SeqOp', $1);
+	if (not $Restricted)
+	{
+	    s/^(=~|!~)//		and return ('MATCH', $1);
+	    s/^\$((no_)?match)\$//i
+					and return ('MATCH', "\L$1");
+	    s/^\$($ReXQLName)\$//o	and return ('COMPARE', $1);
+	}
+	s/^(=|!=|<|<=|>|>=)//		and return ('COMPARE', $1);
+	s!^(//|/|\(|\)|\.\.?|@|\!|\[|\]|\*|:|,)!!
+					and return ($1, $1);
+	s/^($ReXQLName)\s*\(//o
+					and return ('XQLName_Paren', $1);
+	s/^($XML::RegExp::Name)//o	and return ('NCName', $1);
+}
+}
+#------ end Parser related stuff ----------------------------------------------
+# Converts result from a Disjunction to a 0 or 1.
+# If it's a XML::XQL::Boolean, its value is returned.
+# If it's an empty list it returns 0.
+# If it's a node or a Text or Number, it returns 1.
+# If it's a list with 1 or more elements, it returns 1 if at least one
+# element evaluates to 1 (with toBoolean)
+sub toBoolean	# static method
+{
+my $arg = shift;
+my $type = ref ($arg);
+if ($type eq "ARRAY")
+{
+	for my $n (@$arg)
+	{
+	    return 1 if toBoolean ($n);
+	}
+	return 0;
+}
+return $arg->xql_toBoolean;
+}
+sub listContains
+{
+my ($list, $x) = @_;
+#?? $n should be a PrimitiveType or an XML Node
+for my $y (@$list)
+{
+#??	return 1 if $x == $y;
+	if (ref($x) eq ref($y))		# same object class
+	{
+	    my ($src1, $src2) = ($x->xql_sourceNode, $y->xql_sourceNode);
+	    next if ((defined $src1 or defined $src2) and $src1 != $src2);
+	    return ($x == $y) if (UNIVERSAL::isa ($x, 'XML::XQL::Node'));
+	    return 1 if $x->xql_eq ($y);
+	}
+}
+0;
+}
+sub toList
+{
+my $r = shift;
+(ref ($r) eq "ARRAY") ? $r : [ $r ];
+}
+# Prepare right hand side for a comparison, i.e.
+# turn it into a single value.
+# If it is a list with 2 or more values, it croaks.
+sub prepareRvalue
+{
+my $r = shift;
+if (ref ($r) eq "ARRAY")
+{
+	# more than 1 value gives a runtime error (as per Joe Lapp)
+croak "bad rvalue $r" if @$r > 1;
+	$r = $r->[0];
+}
+if (ref ($r) and $r->isa ('XML::XQL::Node'))
+{
+	$r = $r->xql_value;
+}
+$r;
+}
+sub trimSpace
+{
+$_[0] =~ s/^\s+//;
+$_[0] =~ s/\s+$//;
+$_[0];
+}
+# Assumption: max. 32768 (2**15 = 2**($BITS-1)) children (or attributes) per node
+# Use setMaxChildren() to support larger offspring.
+my $BITS = 16;
+$LAST_SORT_KEY = (2 ** $BITS) - 1;
+# Call with values: $max = 128 * (256**N), where N=0, 1, 2, ...
+sub setMaxChildren
+{
+my $max = shift;
+my $m = 128;
+$BITS = 8;
+while ($max > $m)
+{
+	$m = $m * 256;
+	$BITS += 8;
+}
+$LAST_SORT_KEY = (2 ** $BITS) - 1;
+}
+sub createSortKey
+{
+# $_[0] = parent sort key, $_[1] = child index,
+# $_[2] = 0 for attribute nodes, 1 for other node types
+my $vec = "";
+vec ($vec, 0, $BITS) = $_[1];
+vec ($vec, 7, 1) = $_[2] if $_[2];	# set leftmost bit (for non-attributes)
+$_[0] . $vec;
+}
+#--------------- Sorting source nodes ----------------------------------------
+# Sort the list by 'document order' (as per the XQL spec.)
+# Values with an associated source node are sorted by the position of their
+# source node in the XML document.
+# Values without a source node are placed at the end of the resulting list.
+# The source node of an Attribute node, is its (parent) Element node
+# (per definition.) The source node of the other types of XML nodes, is itself.
+# The order for values with the same source node is undefined.
+sub sortDocOrder
+{
+#?? or should I just use: sort { $a->xql_sortKey cmp $b->xql_sortKey }
+my $list = shift;
+#print "before---\n";
+#for (@$list)
+#{
+#    print "key=" . keyStr($_->xql_sortKey) . " node=" . $_->getTagName . " id=" . $_->getAttribute('id') . "\n";
+#}
+@$list =	map { $_->[1] }			# 3) extract nodes
+		sort { $a->[0] cmp $b->[0] }	# 2) sort by sortKey
+		map { [$_->xql_sortKey, $_] }	# 1) make [sortKey,node] records
+		@$list;
+#print "after---\n";
+#for (@$list)
+#{
+#    print "key=" . keyStr($_->xql_sortKey) . " node=" . $_->getTagName . " id=" . $_->getAttribute('id') . "\n";
+#}
+$list;
+}
+# Converts sort key from createSortKey in human readable form
+# For debugging only.
+sub keyStr
+{
+my $key = shift;
+my $n = $BITS / 8;
+my $bitn = 2 ** ($BITS - 1);
+my $str;
+for (my $i = 0; $i < length $key; $i += $n)
+{
+	my $dig = substr ($key, $i, $n);
+	my $v = vec ($dig, 0, $BITS);
+	my $elem = 0;
+	if ($v >= $bitn)
+	{
+	    $v -= $bitn;
+	    $elem = 1;
+	}
+	$str .= "/" if defined $str;
+	$str .= "@" unless $elem;
+	$str .= $v;
+}
+$str;
+}
+sub isEmptyList
+{
+my $list = shift;
+(ref ($list) eq "ARRAY") && (@$list == 0);
+}
+# Used by Element and Attribute nodes
+sub buildNameSpaceExpr
+{
+my ($nameSpace, $name) = @_;
+$name = ".*" if $name eq "*";
+if (defined $nameSpace)
+{
+	$nameSpace = ".*" if $nameSpace eq "*";
+	"^$nameSpace:$name\$";
+}
+else
+{
+	"^$name\$";
+}
+}
+sub prepareForCompare
+{
+my ($left, $right) = @_;
+my $leftType = $left->xql_primType;
+if ($leftType == 0)		# Node
+{
+	$left = $left->xql_value;
+	$leftType = $left->xql_primType;
+}
+my $rightType = $right->xql_primType;
+if ($rightType == 0)		# Node
+{
+	$right = $right->xql_value;
+	$rightType = $right->xql_primType;
+}
+# Note: reverse the order if $leftType < $rightType
+($leftType < $rightType, $left, $right);
+}
+sub xql_eq
+{
+my ($left, $right, $ignoreCase) = @_;
+my $reverse;
+($reverse, $left, $right) = prepareForCompare ($left, $right);
+$reverse ? $right->xql_eq ($left, $ignoreCase)
+	     : $left->xql_eq ($right, $ignoreCase);
+}
+sub xql_ne
+{
+my ($left, $right, $ignoreCase) = @_;
+my $reverse;
+($reverse, $left, $right) = prepareForCompare ($left, $right);
+$reverse ? $right->xql_ne ($left, $ignoreCase)
+	     : $left->xql_ne ($right, $ignoreCase);
+}
+sub xql_lt
+{
+my ($left, $right, $ignoreCase) = @_;
+my $reverse;
+($reverse, $left, $right) = prepareForCompare ($left, $right);
+$reverse ? $right->xql_ge ($left, $ignoreCase)
+	     : $left->xql_lt ($right, $ignoreCase);
+}
+sub xql_le
+{
+my ($left, $right, $ignoreCase) = @_;
+my $reverse;
+($reverse, $left, $right) = prepareForCompare ($left, $right);
+$reverse ? $right->xql_gt ($left, $ignoreCase)
+	     : $left->xql_le ($right, $ignoreCase);
+}
+sub xql_gt
+{
+my ($left, $right, $ignoreCase) = @_;
+my $reverse;
+($reverse, $left, $right) = prepareForCompare ($left, $right);
+$reverse ? $right->xql_le ($left, $ignoreCase)
+	     : $left->xql_gt ($right, $ignoreCase);
+}
+sub xql_ge
+{
+my ($left, $right, $ignoreCase) = @_;
+my $reverse;
+($reverse, $left, $right) = prepareForCompare ($left, $right);
+$reverse ? $right->xql_lt ($left, $ignoreCase)
+	     : $left->xql_ge ($right, $ignoreCase);
+}
+sub xql_ieq { xql_eq (@_, 1); }
+sub xql_ine { xql_ne (@_, 1); }
+sub xql_ilt { xql_lt (@_, 1); }
+sub xql_igt { xql_gt (@_, 1); }
+sub xql_ige { xql_ge (@_, 1); }
+sub xql_ile { xql_le (@_, 1); }
+sub tput
+{
+# Let me know if I need to add other systems for which 'tput' is not
+# available.
+if ($^O =~ /Win|MacOS/)
+{
+	return undef;
+}
+else
+{
+	my $c = shift;
+	# tput is only available on Unix systems.
+	# Calling `tput ...` on Windows generates warning messages
+	# that can not be suppressed.
+	return `tput $c`;
+}
+}
+# Underline the query subexpression that fails (if tput exists)
+$ContextStart = tput ('smul') || ">>";	# smul: underline on
+$ContextEnd = tput ('rmul') || "<<";	# rmul: underline off
+# Used for making the significant keyword of a subexpression bold, e.g. "$and$"
+$BoldOn = tput ('bold') || "";
+$BoldOff = tput ('rmul') . tput ('smul') || "";
+# rmul reverts the string back to normal text, smul makes it underlined again,
+# so the rest of the subexpresion will be underlined.
+sub setErrorContextDelimiters
+{
+($ContextStart, $ContextEnd, $BoldOn, $BoldOff) = @_;
+}
+sub delim
+{
+my ($str, $node, $contextNode) = @_;
+if ($node == $contextNode)
+{
+	$str =~ s/\016([^\017]*)\017/$BoldOn$1$BoldOff/g;
+	"$ContextStart$str$ContextEnd";
+}
+else
+{
+	$str =~ s/\016([^\017]*)\017/$1/g;
+	$str;
+}
+}
+sub bold
+{
+my $x = shift;
+"\016$x\017";	# arbitrary ASCII codes
+}
+sub parseError
+{
+my ($msg) = @_;
+print STDERR $msg . "\n";
+croak $msg;
+}
+# Builtin XQL functions (may not appear after Bang "!")
+%Func =
+(
+ancestor	=> \&XML::XQL::Func::ancestor,
+attribute	=> \&XML::XQL::Func::attribute,
+comment	=> \&XML::XQL::Func::comment,
+element	=> \&XML::XQL::Func::element,
+id		=> \&XML::XQL::Func::id,
+node		=> \&XML::XQL::Func::node,
+pi		=> \&XML::XQL::Func::pi,
+textNode	=> \&XML::XQL::Func::textNode,
+true		=> \&XML::XQL::Func::true,
+false		=> \&XML::XQL::Func::false,
+# NOTE: date() is added with:   use XML::XQL::Date;
+);
+# Builtin XQL methods (may appear after Bang "!")
+%Method =
+(
+baseName	=> \&XML::XQL::Func::baseName,
+count		=> \&XML::XQL::Func::count,
+end		=> \&XML::XQL::Func::end,
+'index'	=> \&XML::XQL::Func::xql_index,
+namespace	=> \&XML::XQL::Func::namespace,
+nodeName	=> \&XML::XQL::Func::nodeName,
+nodeType	=> \&XML::XQL::Func::nodeType,
+nodeTypeString	=> \&XML::XQL::Func::nodeTypeString,
+prefix		=> \&XML::XQL::Func::prefix,
+text		=> \&XML::XQL::Func::text,
+rawText	=> \&XML::XQL::Func::rawText,
+value		=> \&XML::XQL::Func::value,
+);
+# Number of arguments for builtin XQL functions:
+# Value is either an integer or a range. Value is 0 if not specified.
+# Range syntax:
+#
+#  range ::= '[' start ',' end [ ',' start ',' end ]*  ']'
+#  start ::= INTEGER
+#  end   ::= INTEGER | '-1'    ('-1' means: "or more")
+#
+# Example: [2, 4, 7, 7, 10, -1] means (2,3,4,7,10,11,...)
+%FuncArgCount =
+(
+ancestor	=> 1,
+attribute	=> [0,1],
+count		=> [0,1],
+# date		=> 1,
+element	=> [0,1],
+id		=> 1,
+text		=> [0,1],
+rawText	=> [0,1],
+);
+%AllowedOutsideSubquery =
+(
+ancestor	=> 1,
+attribute	=> 1,
+comment	=> 1,
+element	=> 1,
+id		=> 1,
+node		=> 1,
+pi		=> 1,
+textNode	=> 1,
+#?? what about subst etc.
+);
+# Functions that always return the same thing if their arguments are constant
+%ConstFunc =
+(
+true		=> 1,
+false		=> 1,
+# date		=> 1,
+);
+%ExpandedType =
+(
+"boolean"	=> "XML::XQL::Boolean",
+"text"		=> "XML::XQL::Text",
+"number"	=> "XML::XQL::Number",
+"date"		=> "XML::XQL::Date",
+"node"		=> "XML::XQL::Node",
+);
+sub expandType
+{
+my ($type) = @_;
+# Expand "number" to "XML::XQL::Number" etc.
+my $expanded = $ExpandedType{"\L$type"};
+defined $expanded ? $expanded : $type;
+}
+sub defineExpandedTypes
+{
+my (%args) = @_;
+while (my ($key, $val) = each %args)
+{
+	# Convert keys to lowercase
+	$ExpandedType{"\L$key"} = $val;
+}
+}
+sub generateFunction
+{
+my ($name, $funcName, $returnType, $argCount, $allowedOutsideSubquery,
+	$const, $queryArg) = @_;
+$argCount = 0 unless defined $argCount;
+$allowedOutsideSubquery = 1 unless defined $allowedOutsideSubquery;
+$const = 0 unless defined $const;
+$queryArg = 0 unless defined $queryArg;
+$returnType = expandType ($returnType);
+my $wrapperName = "xql_wrap_$name";
+$wrapperName =~ s/\W/_/g;		# replace colons etc.
+my $func;
+my $code = <<END_CODE;
+sub $wrapperName {
+my (\$context, \$list, \@arg) = \@_;
+for my \$i (0 .. \$#arg)
+{
+if (\$i == $queryArg)
+{
+\$arg[\$i] = XML::XQL::toList (\$arg[\$i]->solve (\$context, \$list));
+}
+else
+{
+\$arg[\$i] = XML::XQL::prepareRvalue (\$arg[\$i]->solve (\$context, \$list));
+return [] if XML::XQL::isEmptyList (\$arg[\$i]);
+\$arg[\$i] = \$arg[\$i]->xql_toString;
+}
+}
+END_CODE
+if (ref ($argCount) eq "ARRAY" && @$argCount == 2 &&
+	$argCount->[0] == $argCount->[1])
+{
+$argCount = $argCount->[0];
+}
+if ($queryArg != -1)
+{
+	$code .=<<END_CODE;
+my \@result = ();
+my \@qp = \@{\$arg[$queryArg]};
+for (my \$k = 0; \$k < \@qp; \$k++)
+{
+\$arg[$queryArg] = \$qp[\$k]->xql_toString;
+END_CODE
+}
+if (ref ($argCount) ne "ARRAY")
+{
+$code .= " my \$result = $funcName (";
+	for my $i (0 .. $argCount-1)
+	{
+	    $code .= ", " if $i;
+	    $code .= "\$arg[$i]";
+	}
+	$code .= ");\n";
+}
+elsif (@$argCount == 2)
+{
+	my ($start, $end) = ($argCount->[0], $argCount->[1]);
+	if ($end == -1)
+	{
+$code .= " my \$result = $funcName (";
+	    for my $i (0 .. ($start - 1))
+	    {
+		$code .= ", " if $i;
+		$code .= "\$arg[$i]";
+	    }
+	    $code .= ", \@arg[" . $start . " .. \$#arg]);\n";
+	}
+	else
+	{
+	    $code .= " my \$n = \@arg;\n my \$result;\n ";
+	    for my $j ($argCount->[0] .. $argCount->[1])
+	    {
+		$code .= " els" unless $j == $argCount->[0];
+		$code .= ($j == $argCount->[1] ? "e\n" :
+			"if (\$n == $j)\n");
+		$code .= " {\n  \$result = $funcName (";
+		for my $i (0 .. $j-1)
+		{
+		    $code .= ", " if $i;
+		    $code .= "\$arg[$i]";
+		}
+		$code .= ");\n }\n";
+	    }
+	}
+}
+else	 #?? what now...
+{
+	$code .= " my \$result = $funcName (\@arg);\n";
+}
+if ($returnType eq "*")	# return result as is
+{
+	$code .= " \$result = [] unless defined \$result;\n";
+}
+else
+{
+	$code .= " \$result = defined \$result ? new $returnType (\$result) : [];\n";
+}
+if ($queryArg == -1)
+{
+	$code .= " \$result;\n}\n";
+}
+else
+{
+$code .= "  push \@result, \$result;\n }\n \\\@result;\n}\n";
+}
+$code .= "\$func = \\\&$wrapperName;";
+#print "CODE=$code\n";
+eval "$code";
+if ($@) { croak "generateFunction failed for $funcName: $@\n"; }
+defineFunction ($name, $func, $argCount,
+		    $allowedOutsideSubquery, $const);
+}
+sub defineFunction
+{
+my ($name, $func, $argCount, $allowedOutside, $const) = @_;
+$Func{$name} = $func;
+$FuncArgCount{$name} = $argCount;
+$AllowedOutsideSubquery{$name} = 1 if $allowedOutside;
+$ConstFunc{$name} = $const;
+}
+sub defineMethod
+{
+my ($name, $func, $argCount, $allowedOutside) = @_;
+$Method{$name} = $func;
+$FuncArgCount{$name} = $argCount;
+$AllowedOutsideSubquery{$name} = 1 if $allowedOutside;
+}
+%CompareOper =
+(
+'eq' => \&XML::XQL::xql_eq,
+'ne' => \&XML::XQL::xql_ne,
+'le' => \&XML::XQL::xql_le,
+'ge' => \&XML::XQL::xql_ge,
+'gt' => \&XML::XQL::xql_gt,
+'lt' => \&XML::XQL::xql_lt,
+'ieq' => \&XML::XQL::xql_ieq,
+'ine' => \&XML::XQL::xql_ine,
+'ile' => \&XML::XQL::xql_ile,
+'ige' => \&XML::XQL::xql_ige,
+'igt' => \&XML::XQL::xql_igt,
+'ilt' => \&XML::XQL::xql_ilt,
+'='  => \&XML::XQL::xql_eq,
+'!=' => \&XML::XQL::xql_ne,
+'>'  => \&XML::XQL::xql_gt,
+'>=' => \&XML::XQL::xql_ge,
+'<'  => \&XML::XQL::xql_lt,
+'<=' => \&XML::XQL::xql_le,
+);
+sub defineComparisonOperators
+{
+my (%args) = @_;
+%CompareOper = (%CompareOper, %args);
+}
+sub defineTokenQ
+{
+$Token_q = $_[0];
+}
+sub defineTokenQQ
+{
+$Token_qq = $_[0];
+}
+my %ElementValueType = ();
+my $ElementValueTypeCount = 0;
+sub elementValue
+{
+my ($elem) = @_;
+#?? raw text/recursive ?
+return new XML::XQL::Text ($elem->xql_text, $elem)
+	if $ElementValueTypeCount == 0;   # user hasn't defined any types
+my $tagName = $elem->xql_nodeName;
+my $func = $ElementValueType{$tagName};
+return new XML::XQL::Text ($elem->xql_text, $elem) unless defined $func;
+&$func ($elem, $tagName);
+}
+sub defineElementValueConvertor
+{
+my ($elemTagName, $func) = @_;
+my $prev = defined $ElementValueType{$elemTagName};
+$ElementValueType{$elemTagName} = $func;
+if (defined $func != $prev)
+{
+	defined $func ? $ElementValueTypeCount++ : $ElementValueTypeCount--;
+}
+}
+my %AttrValueType = ();
+my $AttrValueTypeCount = 0;
+sub attrValue
+{
+my ($attr) = @_;
+#?? raw text/recursive ?
+return new XML::XQL::Text ($attr->xql_text, $attr)
+	if $AttrValueTypeCount == 0;    # user hasn't defined any types
+my $elem = $attr->xql_parent->xql_nodeName;
+my $attrName = $attr->xql_nodeName;
+my $func = $AttrValueType{"$elem $attrName"};
+if (not defined $func)
+{
+	$elem = "*";
+	$func = $AttrValueType{"$elem $attrName"};
+}
+return new XML::XQL::Text ($attr->xql_text, $attr) unless defined $func;
+&$func ($attr, $attrName, $elem);
+}
+sub defineAttrValueConvertor
+{
+my ($elemTagName, $attrName, $type) = @_;
+my $both = "$elemTagName $attrName";
+my $prev = defined $AttrValueType{$both};
+$AttrValueType{$both} = $type;
+if (defined $type != $prev)
+{
+	defined $type ? $AttrValueTypeCount++ : $AttrValueTypeCount--;
+}
+}
+#=== debug
+sub exception
+{
+my ($ex) = @_;
+print "Exception: $ex\n" if $ex;
+$ex;
+}
+sub d
+{
+my $n = shift;
+my $type = ref $n;
+if ($type eq "ARRAY")
+{
+	my $str = "";
+	for my $i (@$n)
+	{
+	    $str .= ", " unless $str eq "";
+	    $str .= d ($i);
+	}
+	return "[$str]";
+}
+elsif ($type eq "HASH")
+{
+	my $str = "";
+	while (my ($key, $val) = %$n)
+	{
+	    $str .= ", " unless $str eq "";
+	    $str .= $key . " => " . d ($val);
+	}
+	return "{$str}";
+}
+elsif ($type)
+{
+	return $n->xql_contextString if ($n->isa ('XML::XQL::Operator'));
+	return "${type}\[" . $n->xql_toString . "]" if $n->isa ('XML::XQL::PrimitiveType');
+#	return "${type}\[" . $n->toString . "]" if $n->isa ('XML::DOM::Element');
+}
+$n;
+}
+package XML::XQL::Query;
+use Carp;
+use XML::XQL::Parser;
+use vars qw( %Func %FuncArgCount );
+my $parser = new XML::XQL::Parser;
+# This is passed as 'yyerror' to YYParse
+sub Error
+{
+my($parser) = shift;
+print STDERR "Error in Query Expression near: " . $parser->YYData->{INPUT} . "\n";
+}
+sub defineFunction
+{
+my ($self, $name, $func, $argCount, $allowedOutside, $const) = @_;
+$self->{Func}->{$name} = $func;
+$self->{FuncArgCount}->{$name} = $argCount;
+$self->{AllowedOutsideSubquery}->{$name} = 1 if $allowedOutside;
+$self->{ConstFunc} = $const;
+}
+sub defineMethod
+{
+my ($self, $name, $func, $argCount, $allowedOutside) = @_;
+$self->{Method}->{$name} = $func;
+$self->{FuncArgCount}->{$name} = $argCount;
+$self->{AllowedOutsideSubquery}->{$name} = 1 if $allowedOutside;
+}
+sub defineComparisonOperators
+{
+my ($self, %args) = @_;
+$self->{CompareOper} = \%args;
+}
+sub defineTokenQ
+{
+$_[0]->{'q'} = $_[1];
+}
+sub defineTokenQQ
+{
+$_[0]->{'qq'} = $_[1];
+}
+sub new
+{
+my ($class, %args) = @_;
+croak "no Expr specified" unless defined $args{Expr};
+my $self = bless \%args, $class;
+my $error = $self->{'Error'} || \&XML::XQL::Query::Error;
+my $debug = defined ($self->{Debug}) ? $self->{Debug} : 0;   # 0x17;
+$self->{'q'} = $XML::XQL::Token_q unless exists $self->{'q'};
+$self->{'qq'} = $XML::XQL::Token_qq unless exists $self->{'qq'};
+# Invoke the query expression parser
+$parser->YYData->{INPUT} = $self->{Expr};
+$parser->{Query} = $self;
+$self->{Tree} = $parser->YYParse (yylex => \&XML::XQL::Lexer,
+				      yyerror => $error,
+				      yydebug => $debug);
+# Nothing but whitespace should be left over
+if ($parser->YYData->{INPUT} !~ /^\s*$/)
+{
+	XML::XQL::parseError ("Error when parsing expression. Unexpected characters at end of expression [" . $parser->YYData->{INPUT} . "]")
+}
+XML::XQL::parseError ("Error when parsing expression")
+	unless defined $self->{Tree};
+$self->{Tree}->{Query} = $self;
+$self->{Tree}->xql_check (0, 0);	# inSubQuery=0, inParam=0
+print "Expression parsed successfully\n" if $debug;
+$self;
+}
+sub dispose
+{
+my $self = shift;
+undef $self->{Tree}->{Query};
+$self->{Tree}->dispose;
+delete $self->{Tree};
+}
+sub isNodeQuery
+{
+$_[0]->{NodeQuery};
+}
+sub solve
+{
+my ($self, @list) = @_;
+my $context = undef;
+# clear cached "once" values
+$self->{Tree}->xql_prepCache;
+my $result = $self->{Tree}->solve ($context, \@list);
+ref ($result) eq "ARRAY" ? @$result : ($result);
+}
+sub toString
+{
+$_[0]->{Expr};
+}
+sub toDOM
+{
+my ($self, $doc) = @_;
+my $root = $doc->createElement ("XQL");
+$doc->appendChild ($root);
+$root->appendChild ($self->{Tree}->xql_toDOM ($doc));
+$doc;
+}
+sub findComparisonOperator
+{
+my ($self, $name) = @_;
+my $cmp;
+if (exists $self->{CompareOper}->{$name})
+{
+	$cmp = $self->{CompareOper}->{$name};
+}
+else
+{
+	$cmp = $XML::XQL::CompareOper{$name};
+}
+if (not defined $cmp)
+{
+XML::XQL::parseError ("undefined comparison operator '$name'");
+}
+$cmp;
+}
+# Return function pointer. Croak if wrong number of arguments.
+sub findFunctionOrMethod
+{
+my ($self, $name, $args) = @_;
+my $func;
+my $type = "function";
+if (exists $self->{Func}->{$name})
+{
+	$func = $self->{Func}->{$name};
+}
+elsif (exists $self->{Method}->{$name})
+{
+	$func = $self->{Method}->{$name};
+	$type = "method";
+}
+elsif (defined $XML::XQL::Func{$name})
+{
+	$func = $XML::XQL::Func{$name};
+}
+elsif (defined $XML::XQL::Method{$name})
+{
+	$func = $XML::XQL::Method{$name};
+	$type = "method";
+}
+elsif (not $XML::XQL::Restricted)
+{
+$func = XML::XQL::generatePerlWrapper ($name);
+}
+XML::XQL::parseError ("undefined function/method '$name' in query '" .
+		$self->toString . "'")
+unless defined &$func;
+my $funcArgCount = $self->{FuncArgCount}->{$name}
+			|| $XML::XQL::FuncArgCount{$name} || 0;
+# Check number of args
+my $nargs = @$args;
+#print "$args " . XML::XQL::d($args) . "\n";
+my $ok = 0;
+if (ref ($funcArgCount) eq "ARRAY")
+{
+	my $i = 0;
+	my $n = @$funcArgCount;
+	while ($i < $n)
+	{
+	    my $s = $funcArgCount->[$i++];
+	    my $e = $funcArgCount->[$i++] || $s;	# same as $s if odd #args
+	    if ($nargs >= $s && ($e == -1 || $nargs <= $e))
+	    {
+		$ok = 1;	# found it
+		last;
+	    }
+	}
+}
+else
+{
+	$ok = ($nargs eq $funcArgCount);
+}
+XML::XQL::parseError ("wrong number of args ($nargs) for $type $name in query '" .
+	    $self->toString . "', it should be " . XML::XQL::d($funcArgCount))
+	if not $ok;
+return ($func, $type);
+}
+sub isAllowedOutsideSubquery
+{
+my ($self, $funcName) = @_;
+my ($ok) = $self->{AllowedOutsideSubquery}->{$funcName};
+return $ok if defined $ok;
+$XML::XQL::AllowedOutsideSubquery{$funcName};
+}
+package XML::XQL::Operator;
+use fields qw{ Left Right Parent };
+sub new
+{
+my ($class, %attr) = @_;
+my $self = bless \%attr, $class;
+$self->{Left}->setParent ($self) if defined $self->{Left};
+$self->{Right}->setParent ($self) if defined $self->{Right};
+$self;
+}
+sub dispose
+{
+my $self = shift;
+if (defined ($self->{Left}))
+{
+	$self->{Left}->dispose;
+	undef $self->{Left};
+}
+if (defined ($self->{Right}))
+{
+	$self->{Right}->dispose;
+	undef $self->{Right};
+}
+undef $self->{Parent};
+}
+sub xql_check
+{
+my ($self, $inSubQuery, $inParam) = @_;
+$self->{Left}->xql_check ($inSubQuery, $inParam);
+$self->{Right}->xql_check ($inSubQuery, $inParam) if defined $self->{Right};
+}
+sub xql_prepCache
+{
+my ($self) = @_;
+$self->{Left}->xql_prepCache;
+$self->{Right}->xql_prepCache if defined $self->{Right};
+}
+sub xql_toDOM
+{
+my ($self, $doc) = @_;
+my $name = ref $self;
+$name =~ s/.*:://;
+my $elem = $doc->createElement ($name);
+if (defined $self->{Left})
+{
+	my $left = $doc->createElement ("left");
+	$elem->appendChild ($left);
+	$left->appendChild ($self->{Left}->xql_toDOM ($doc));
+}
+if (defined $self->{Right})
+{
+	my $right = $doc->createElement ("right");
+	$elem->appendChild ($right);
+	$right->appendChild ($self->{Right}->xql_toDOM ($doc));
+}
+$elem;
+}
+sub isConstant
+{
+0;
+}
+# Overriden by Union and Path operators
+sub mustSort
+{
+0;
+}
+sub setParent
+{
+$_[0]->{Parent} = $_[1];
+}
+sub warning
+{
+my ($self, $msg) = @_;
+print STDERR "WARNING: $msg";
+print STDERR "         Context: " . $self->toContextString . "\n";
+}
+sub root
+{
+my ($self) = @_;
+my $top = $self;
+while (defined ($top->{Parent}))
+{
+	$top = $top->{Parent};
+}
+$top;
+}
+sub query
+{
+$_[0]->root->{Query};
+}
+sub toContextString
+{
+my ($self) = @_;
+$self->root->xql_contextString ($self);
+}
+sub debugString
+{
+my ($self) = @_;
+my $str = "[" . ref($self);
+while (my ($key, $val) = each %$self)
+{
+	$str .= "$key=>" . XML::XQL::d($val);
+}
+$str . "]";
+}
+sub verbose
+{
+my ($self, $str, $list) = @_;
+#    print STDERR "$self - $str: " . XML::XQL::d($list) . "\n";
+$list;
+}
+package XML::XQL::Root;		# "/" at start of XQL expression
+use base 'XML::XQL::Operator';	# L -> L
+sub solve
+{
+my ($self, $context, $list) = @_;
+return [] if (@$list < 1);
+#?? what if first value is not a XML::XQL::Node? should we try the second one?
+[$list->[0]->xql_document];
+}
+#?? add isOnce here?
+sub xql_check
+{
+}
+sub xql_prepCache
+{
+}
+sub xql_contextString
+{
+XML::XQL::delim ("/", @_);
+}
+package XML::XQL::Path;
+use base 'XML::XQL::Operator';	# L -> L
+use fields qw{ PathOp };
+sub new
+{
+my ($class, %arg) = @_;
+my $self = bless \%arg, $class;
+$self->{Left} ||= new XML::XQL::Root;
+$self->{Left}->setParent ($self);
+$self->{Right}->setParent ($self);
+$self;
+}
+sub solve
+{
+my ($self, $context, $list) = @_;
+$list = $self->{Left}->solve ($context, $list);
+$self->verbose ("left", $list);
+return $list if @$list < 1;
+if ($self->{PathOp} eq '/')
+{
+	$self->verbose ("result", $self->{Right}->solve ($context, $list));
+}
+else	# recurse "//"
+{
+	my $new_list = [];
+	my $n = @$list;
+NODE: for (my $i = 0; $i < $n; $i++)
+	{
+	    my $node = $list->[$i];
+	    # Node must be an Element or must be allowed to contain Elements
+	    # i.e. must be an Element or a Document
+	    # (DocumentFragment is not expected here)
+	    my $nodeType = $node->xql_nodeType;
+	    next NODE unless ($nodeType == 1 || $nodeType == 9);
+	    # Skip the node if one of its ancestors is part of the input $list
+	    # (and therefore already processed)
+	    my $parent = $node->xql_parent;
+	    while (defined $parent)
+	    {
+		for (my $j = $i - 1; $j >= 0; $j--)
+		{
+		    next NODE if ($parent == $list->[$j]);
+		}
+		$parent = $parent->xql_parent;
+	    }
+	    recurse ($node, $new_list);
+	}
+	my $results = $self->{Right}->solve ($context, $new_list);
+	# Sort the result list unless the parent Operator will sort
+	my $parent = $self->{Parent};
+	XML::XQL::sortDocOrder ($results)
+		unless defined ($parent) and $parent->mustSort;
+	$self->verbose ("result //", $results);
+}
+}
+sub mustSort
+{
+$_[0]->{PathOp} eq '//';
+}
+sub recurse
+{
+my ($node, $list) = @_;
+push @$list, $node;
+for my $kid (@{$node->xql_element})
+{
+	recurse ($kid, $list);
+}
+}
+sub xql_contextString
+{
+my $self = shift;
+my $str = $self->{Left}->isa ('XML::XQL::Root') ?
+	"" : $self->{Left}->xql_contextString (@_);
+XML::XQL::delim ($str . XML::XQL::bold($self->{PathOp}) .
+		     $self->{Right}->xql_contextString (@_), $self, @_);
+}
+sub xql_toDOM
+{
+my ($self, $doc) = @_;
+my $elem = $self->SUPER::xql_toDOM ($doc);
+$elem->setAttribute ("pathOp", $self->{PathOp});
+$elem;
+}
+package XML::XQL::Sequence;		# "elem;elem" or "elem;;elem"
+use base 'XML::XQL::Operator';	# L -> L
+use fields qw{ Oper };
+# See "The Design of XQL" by Jonathan Robie
+# <URL:http://www.texcel.no/whitepapers/xql-design.html>
+# for definition of Sequence operators.
+# Note that the "naive" implementation slows things down quite a bit here...
+sub solve
+{
+my ($self, $context, $list) = @_;
+my $left = $self->{Left}->solve ($context, $list);
+$self->verbose ("left", $left);
+return [] unless @$left;
+my $right = $self->{Right}->solve ($context, $list);
+$self->verbose ("right", $right);
+return [] unless @$right;
+my @result;
+if ($self->{Oper} eq ';')	# immediately precedes
+{
+	my %hleft; @hleft{@$left} = ();	# initialize all values to undef
+	my %pushed;
+	for my $r (@$right)
+	{
+	    # Find previous sibling that is not a text node that has only
+	    # whitespace that can be ignored (because xml:space=preserve)
+	    my $prev = $r->xql_prevNonWS;
+	    # $prev must be defined and must exist in $left
+	    next unless $prev and exists $hleft{$prev};
+	    # Filter duplicates (no need to sort afterwards)
+	    push @result, $prev unless $pushed{$prev}++;
+	    push @result, $r unless $pushed{$r}++;
+	}
+}
+else	# oper eq ';;' (i.e. precedes)
+{
+	my %pushed;
+	for my $r (@$right)
+	{
+	    for my $l (@$left)
+	    {
+		# If left node precedes right node, add them
+		if ($l->xql_sortKey lt $r->xql_sortKey)
+		{
+		    # Filter duplicates
+		    push @result, $l unless $pushed{$l}++;
+		    push @result, $r unless $pushed{$r}++;
+		}
+	    }
+#?? optimize - left & right are already sorted...
+	    # sort in document order
+	    XML::XQL::sortDocOrder (\@result) if @result;
+	}
+}
+\@result;
+}
+sub xql_contextString
+{
+my $self = shift;
+XML::XQL::delim ($self->{Left}->xql_contextString (@_) .
+		     XML::XQL::bold($self->{Oper}) .
+		     $self->{Right}->xql_contextString (@_), $self, @_);
+}
+package XML::XQL::Current;		# "."
+use base 'XML::XQL::Operator';	# L -> L
+sub xql_check
+{
+}
+sub xql_prepCache
+{
+}
+sub solve
+{
+my ($self, $context, $list) = @_;
+$list;
+}
+sub xql_contextString
+{
+XML::XQL::delim (".", @_);
+}
+package XML::XQL::Parent;		# ".."
+use base 'XML::XQL::Operator';
+sub xql_check
+{
+}
+sub xql_prepCache
+{
+}
+sub solve
+{
+my ($self, $context, $list) = @_;
+my @result = ();
+for my $node (@$list)
+{
+	push @result, $node->xql_parent;
+}
+\@result;
+}
+sub xql_contextString
+{
+XML::XQL::delim ("..", @_);
+}
+package XML::XQL::Element;		# "elem"
+use base 'XML::XQL::Operator';		# L -> L
+use fields qw{ Name NameSpace Expr };
+sub new
+{
+my ($class, %args) = @_;
+if (not defined ($args{NameSpace}))
+{
+	if ($args{Name} eq "*")
+	{
+	    return bless \%args, 'XML::XQL::AllElements';
+	}
+	else
+	{
+	    return bless \%args, 'XML::XQL::SimpleElement';
+	}
+}
+$args{Expr} = XML::XQL::buildNameSpaceExpr ($args{NameSpace},
+						$args{Name});
+bless \%args, $class;
+}
+sub xql_check
+{
+}
+sub xql_prepCache
+{
+}
+sub solve
+{
+my ($self, $context, $list) = @_;
+my @result = ();
+my $expr = $self->{Expr};
+for my $node (@$list)
+{
+	for my $kid (@{$node->xql_element})
+	{
+	    push @result, $kid if $kid->xql_nodeName =~ /$expr/;
+	}
+}
+\@result;
+}
+sub xql_contextString
+{
+my $self = shift;
+my $name = $self->{Name};
+my $space = $self->{NameSpace};
+my $str = defined($space) ? "$space:$name" : $name;
+XML::XQL::delim ($str, $self, @_);
+}
+sub xql_toDOM
+{
+my ($self, $doc) = @_;
+my $elem = $self->SUPER::xql_toDOM ($doc);
+my $name = $self->{Name};
+my $space = $self->{NameSpace};
+my $str = defined($space) ? "$space:$name" : $name;
+$elem->setAttribute ("name", $str);
+$elem;
+}
+package XML::XQL::SimpleElement;	# "elem"
+use base 'XML::XQL::Element';		# L -> L
+sub solve
+{
+my ($self, $context, $list) = @_;
+my @result = ();
+my $name = $self->{Name};
+for my $node (@$list)
+{
+	push @result, @{ $node->xql_element ($name) };
+}
+\@result;
+}
+package XML::XQL::AllElements;		# "*"
+use base 'XML::XQL::Element';		# L -> L
+sub solve
+{
+my ($self, $context, $list) = @_;
+my @result = ();
+for my $node (@$list)
+{
+	push @result, @{$node->xql_element};
+}
+\@result;
+}
+package XML::XQL::Attribute;		# "@attr"
+use base 'XML::XQL::Operator';		# L -> L of Attributes
+use fields qw{ Name NameSpace Expr };
+sub new
+{
+my ($class, %args) = @_;
+if (not defined ($args{NameSpace}))
+{
+	if ($args{Name} eq "*")
+	{
+	    return bless \%args, 'XML::XQL::AllAttr';
+	}
+	else
+	{
+	    return bless \%args, 'XML::XQL::SimpleAttr';
+	}
+}
+$args{Expr} = XML::XQL::buildNameSpaceExpr ($args{NameSpace},
+						$args{Name});
+bless \%args, $class;
+}
+sub xql_check
+{
+}
+sub xql_prepCache
+{
+}
+sub solve
+{
+my ($self, $context, $list) = @_;
+my @result = ();
+my $expr = $self->{Expr};
+for my $node (@$list)
+{
+	for my $kid (@{$node->xql_attribute})
+	{
+	    push @result, $kid if $kid->xql_nodeName =~ /$expr/;
+	}
+}
+}
+sub xql_contextString
+{
+my $self = shift;
+my $name = $self->{Name};
+my $space = $self->{NameSpace};
+my $str = defined($space) ? "\@$space:$name" : ('@' . $name);
+XML::XQL::delim ($str, $self, @_);
+}
+package XML::XQL::SimpleAttr;		# "@attr"
+use base 'XML::XQL::Attribute';		# L -> L
+sub solve
+{
+my ($self, $context, $list) = @_;
+my @result = ();
+my $name = $self->{Name};
+for my $node (@$list)
+{
+	push @result, @{ $node->xql_attribute ($name) };
+}
+\@result;
+}
+package XML::XQL::AllAttr;		# "@*"
+use base 'XML::XQL::Attribute';		# L -> L
+sub solve
+{
+my ($self, $context, $list) = @_;
+my @result = ();
+for my $node (@$list)
+{
+	push @result, @{$node->xql_attribute};
+}
+\@result;
+}
+package XML::XQL::Subscript;		# "[3, 5 $to$ 7, -1]"
+use base 'XML::XQL::Operator';		# L -> L
+use fields qw{ IndexList };
+#?? optimize for simple subscripts
+sub solve
+{
+my ($self, $context, $inlist) = @_;
+my @result = ();
+for my $node (@$inlist)
+{
+	my $list = $self->{Left}->solve ($context, [$node]);
+	$self->verbose("Left", $list);
+	my $n = int (@$list);
+	next if ($n == 0);
+	# build ordered index list
+	my @indexFlags = ();
+	$#indexFlags = $n - 1;
+	my $index = $self->{IndexList};
+	my $len = @$index;
+#?? this is done a lot - optimize....
+	my $i = 0;
+	while ($i < $len)
+	{
+	    my $start = $index->[$i++];
+	    $start += $n if ($start < 0);
+	    my $end = $index->[$i++];
+	    $end += $n if ($end < 0);
+	    next unless $start <= $end && $end >=0 && $start < $n;
+	    $start = 0 if ($start < 0);
+	    $end = $n-1 if ($end >= $n);
+	    for my $j ($start .. $end)
+	    {
+		$indexFlags[$j] = 1;
+	    }
+	}
+	for $i (0 .. $n-1)
+	{
+	    push @result, $list->[$i] if $indexFlags[$i];
+	}
+}
+\@result;
+}
+sub xql_contextString
+{
+my $self = shift;
+my $index = $self->{IndexList};
+my $str = XML::XQL::bold("[");
+for (my $i = 0; $i < @$index; $i++)
+{
+	$str .= ", " if $i > 0;
+	my $s = $index->[$i++];
+	my $e = $index->[$i];
+	$str = ($s == $e) ? $s : "$s \$to\$ $e";
+}
+$str .= XML::XQL::bold("]");
+XML::XQL::delim ($self->{Left}->xql_contextString (@_) . $str, $self, @_);
+}
+sub xql_toDOM
+{
+my ($self, $doc) = @_;
+my $elem = $self->SUPER::xql_toDOM ($doc);
+my $index = $self->{IndexList};
+my $str = "";
+for (my $i = 0; $i < @$index; $i++)
+{
+	$str .= ", " if $i > 0;
+	my $s = $index->[$i++];
+	my $e = $index->[$i];
+	$str .= ($s == $e) ? $s : "$s \$to\$ $e";
+}
+my $ie = $doc->createElement ("index");
+$ie->setAttribute ("list", $str);
+$elem->appendChild ($ie);
+$elem;
+}
+package XML::XQL::Union;		# "book $union$ magazine", also "|"
+use base 'XML::XQL::Operator';		# L x L -> L
+sub solve
+{
+my ($self, $context, $list) = @_;
+my $left = XML::XQL::toList ($self->{Left}->solve ($context, $list));
+my $right = XML::XQL::toList ($self->{Right}->solve ($context, $list));
+return $right if (@$left < 1);
+return $left if (@$right < 1);
+my @result = @$left;
+for my $node (@$right)
+{
+	push @result, $node unless XML::XQL::listContains ($left, $node);
+}
+my $parent = $self->{Parent};
+# Don't sort if parent is a Union or //, because the parent will do the sort
+unless (defined $parent and $parent->mustSort)
+{
+	XML::XQL::sortDocOrder (\@result)
+}
+#    $self->verbose ("Union result", \@result);
+\@result;
+}
+sub mustSort
+{
+1;
+}
+sub xql_contextString
+{
+my $self = shift;
+XML::XQL::delim ($self->{Left}->xql_contextString (@_) .
+		     XML::XQL::bold (" \$union\$ ") .
+		     $self->{Right}->xql_contextString (@_), $self, @_);
+}
+package XML::XQL::Intersect;		# "book $intersect$ magazine"
+use base 'XML::XQL::Operator';		# L x L -> L
+sub solve
+{
+my ($self, $context, $list) = @_;
+my $left = XML::XQL::toList ($self->{Left}->solve ($context, $list));
+return [] if @$left < 1;
+my $right = XML::XQL::toList ($self->{Right}->solve ($context, $list));
+return [] if @$right < 1;
+# Assumption: $left and $right don't have duplicates themselves
+my @result = ();
+for my $node (@$left)
+{
+#? reimplement with hash - faster!
+	push @result, $node if XML::XQL::listContains ($right, $node);
+}
+\@result;
+}
+sub xql_contextString
+{
+my $self = shift;
+XML::XQL::delim ($self->{Left}->xql_contextString (@_) .
+		     XML::XQL::bold (" \$intersect\$ ") .
+		     $self->{Right}->xql_contextString (@_), $self, @_);
+}
+package XML::XQL::Filter;		# "elem[expr]"
+use base 'XML::XQL::Operator';		# L -> L
+sub solve
+{
+my ($self, $context, $inlist) = @_;
+my @result = ();
+for my $node (@$inlist)
+{
+	my $list = $self->{Left}->solve ($context, [$node]);
+	next if @$list == 0;
+	my $subQuery = $self->{Right};
+	$context = [0, scalar (@$list)];
+	for my $node (@$list)
+	{
+#?? optimize? only need the first one to succeed
+	    my $r = $subQuery->solve ($context, [ $node ]);
+	    push @result, $node if XML::XQL::toBoolean ($r);
+	    $context->[0]++;	# increase the index for the index() method
+	}
+}
+\@result;
+}
+sub xql_check
+{
+my ($self, $inSubQuery, $inParam) = @_;
+$self->{Left}->xql_check ($inSubQuery, $inParam);
+$self->{Right}->xql_check (1, $inParam);
+}
+sub xql_contextString
+{
+my $self = shift;
+XML::XQL::delim ($self->{Left}->xql_contextString (@_) .
+		     XML::XQL::bold ("[") .
+		     $self->{Right}->xql_contextString (@_) .
+		     XML::XQL::bold ("]"), $self, @_);
+}
+package XML::XQL::BooleanOp;
+use base 'XML::XQL::Operator';
+package XML::XQL::Or;
+use base 'XML::XQL::BooleanOp';
+sub solve
+{
+my ($self, $context, $list) = @_;
+my $left = $self->{Left}->solve ($context, $list);
+return $XML::XQL::Boolean::TRUE if XML::XQL::toBoolean ($left);
+return $self->{Right}->solve ($context, $list);
+}
+sub xql_contextString
+{
+my $self = shift;
+XML::XQL::delim ($self->{Left}->xql_contextString (@_) .
+		     XML::XQL::bold (" \$or\$ ") .
+	   $self->{Right}->xql_contextString (@_), $self, @_);
+}
+package XML::XQL::And;
+use base 'XML::XQL::BooleanOp';
+sub solve
+{
+my ($self, $context, $list) = @_;
+my $left = $self->{Left}->solve ($context, $list);
+return $XML::XQL::Boolean::FALSE unless XML::XQL::toBoolean ($left);
+return $self->{Right}->solve ($context, $list);
+}
+sub xql_contextString
+{
+my $self = shift;
+XML::XQL::delim ($self->{Left}->xql_contextString (@_) .
+		     XML::XQL::bold (" \$and\$ ") .
+		     $self->{Right}->xql_contextString (@_), $self, @_);
+}
+package XML::XQL::Not;
+use base 'XML::XQL::BooleanOp';
+sub solve
+{
+my ($self, $context, $list) = @_;
+my $left = $self->{Left}->solve ($context, $list);
+return XML::XQL::toBoolean ($left) ? $XML::XQL::Boolean::FALSE : $XML::XQL::Boolean::TRUE;
+}
+sub xql_contextString
+{
+my $self = shift;
+XML::XQL::delim (XML::XQL::bold ("\$not\$ ") .
+		     $self->{Left}->xql_contextString (@_), $self, @_);
+}
+package XML::XQL::Compare;
+use base 'XML::XQL::Operator';
+use fields qw{ Func All };
+use Carp;
+sub solve
+{
+my ($self, $context, $list) = @_;
+my $type;
+my $cmpFunc = $self->{Func};
+my $left = $self->verbose ("left", XML::XQL::toList ($self->{Left}->solve ($context, $list)));
+return [] if @$left < 1;
+my $right;
+eval {
+	$right = $self->verbose ("right", XML::XQL::prepareRvalue ($self->{Right}->solve ($context, $list)));
+};
+return [] if XML::XQL::exception ($@);
+if ($self->{All})
+{
+	for my $node (@$left)
+	{
+	    eval {
+		# Stop if any of the comparisons fails
+		return [] unless &$cmpFunc ($node, $right);
+	    };
+	    return [] if XML::XQL::exception ($@);
+	}
+	return $left;
+}
+else	# $any$
+{
+my @result = ();
+	for my $node (@$left)
+	{
+	    eval {
+		push (@result, $node)
+		    if &$cmpFunc ($node, $right);
+	    };
+	    return [] if XML::XQL::exception ($@);
+	}
+	return \@result;
+}
+}
+sub xql_contextString
+{
+my $self = shift;
+my $all = $self->{All} ? "\$all\$ " : "";
+XML::XQL::delim ($all . $self->{Left}->xql_contextString (@_) . " " .
+		     XML::XQL::bold ($self->{Oper}) . " " .
+		     $self->{Right}->xql_contextString (@_), $self, @_);
+}
+package XML::XQL::Func;
+use Carp;
+sub count
+{
+my ($context, $list, $expr) = @_;
+my $cnt;
+if (defined $expr)
+{
+	$list = XML::XQL::toList ($expr->solve ($context, $list));
+	$cnt = @$list;
+}
+else
+{
+	$cnt = $context->[1];
+}
+#?? ref node?
+new XML::XQL::Number ($cnt);
+}
+sub id
+{
+my ($context, $list, $query) = @_;
+return [] if @$list == 0;
+my $id = XML::XQL::prepareRvalue ($query->solve ($context, $list));
+#?? check result?
+#?? if [0] is not a Node, I should probably try the next one
+my $doc = $list->[0]->xql_document;
+_findId ($doc->xql_element->[0], $id);
+}
+sub _findId # static method
+{
+my ($elem, $id) = @_;
+my $attr = $elem->xql_attribute ("id");
+return [$elem] if (@$attr == 1 && $attr->[0]->xql_nodeName eq $id);
+for my $kid (@{$elem->xql_element})
+{
+	$attr = _findId ($kid);
+	return $attr if @$attr;
+}
+return [];
+}
+sub end
+{
+my ($context, $list) = @_;
+return [] if @$list == 0;
+new XML::XQL::Boolean ($context->[0] == $context->[1] - 1);
+}
+sub xql_index
+{
+my ($context, $list) = @_;
+#    print "index: " . XML::XQL::d($context) . "\n";
+#?? wrong!
+return [] if @$list == 0;
+new XML::XQL::Number ($context->[0]);
+}
+sub ancestor
+{
+my ($context, $list, $query) = @_;
+return [] if @$list == 0;
+my @anc = ();
+#?? fix for @$list > 1
+my $parent = $list->[0]->xql_parent;
+while (defined $parent)
+{
+	# keep list of ancestors so far
+	unshift @anc, $parent;
+	# solve the query for the ancestor
+	my $result = $query->solve ($context, [$parent]);
+	for my $node (@{$result})
+	{
+	    for my $anc (@anc)
+	    {
+		return [$node] if $node == $anc;
+	    }
+	}
+	$parent = $parent->xql_parent;
+}
+return [];
+}
+sub node
+{
+my ($context, $list) = @_;
+return [] if @$list == 0;
+return $list->[0]->xql_node if @$list == 1;
+my @result;
+for my $node (@$list)
+{
+	push @result, @{ $node->xql_node };
+}
+XML::XQL::sortDocOrder (\@result);
+}
+sub _nodesByType
+{
+my ($list, $type) = @_;
+return [] if @$list == 0;
+my @result;
+for my $node (@$list)
+{
+	for my $kid (@{ $node->xql_node })
+	{
+	    push @result, $kid if $kid->xql_nodeType == $type;
+	}
+}
+@$list > 1 ? XML::XQL::sortDocOrder (\@result) : \@result;
+}
+sub pi
+{
+my ($context, $list, $pi_name) = @_;
+if (defined $pi_name)
+{
+	return [] if @$list == 0;
+	$pi_name = $pi_name->solve ($context, $list)->xql_toString;
+	my @result;
+	for my $node (@$list)
+	{
+	    for my $kid (@{ $node->xql_node })
+	    {
+		push @result, $kid
+		    if $kid->xql_nodeType == 7 && $kid->getTarget eq $pi_name;
+	    }
+	}
+	return @$list > 1 ? XML::XQL::sortDocOrder (\@result) : \@result;
+}
+return _nodesByType ($_[1], 7);
+}
+sub comment
+{
+_nodesByType ($_[1], 8);
+}
+sub textNode
+{
+_nodesByType ($_[1], 3);
+}
+sub nodeName
+{
+my ($context, $list) = @_;
+return [] if @$list == 0;
+my @result;
+for my $node (@$list)
+{
+	push @result, new XML::XQL::Text ($node->xql_nodeName, $node);
+}
+\@result;
+}
+sub namespace
+{
+my ($context, $list) = @_;
+return [] if @$list == 0;
+my @result;
+for my $node (@$list)
+{
+	my $namespace = $node->xql_namespace;
+	next unless defined $namespace;
+	push @result, new XML::XQL::Text ($namespace, $node);
+}
+\@result;
+}
+sub prefix
+{
+my ($context, $list) = @_;
+return [] if @$list == 0;
+my @result;
+for my $node (@$list)
+{
+	my $prefix = $node->xql_prefix;
+	next unless defined $prefix;
+	push @result, new XML::XQL::Text ($prefix, $node);
+}
+\@result;
+}
+sub baseName
+{
+my ($context, $list) = @_;
+return [] if @$list == 0;
+my @result;
+for my $node (@$list)
+{
+	my $basename = $node->xql_baseName;
+	next unless defined $basename;
+	push @result, new XML::XQL::Text ($basename, $node);
+}
+\@result;
+}
+sub nodeType
+{
+my ($context, $list) = @_;
+return [] if @$list == 0;
+my @result;
+for my $node (@$list)
+{
+	push @result, new XML::XQL::Number ($node->xql_nodeType, $node);
+}
+\@result;
+}
+sub nodeTypeString
+{
+my ($context, $list) = @_;
+return [] if @$list == 0;
+my @result;
+for my $node (@$list)
+{
+	push @result, new XML::XQL::Text ($node->xql_nodeTypeString, $node);
+}
+@result;
+}
+sub value
+{
+my ($context, $list) = @_;
+return [] if @$list == 0;
+my @result;
+for my $node (@$list)
+{
+	push @result, $node->xql_value;	# value always returns an object
+}
+\@result;
+}
+sub text
+{
+my ($context, $list, $recurse) = @_;
+return [] if @$list == 0;
+if (defined $recurse)
+{
+	$recurse = $recurse->solve ($context, $list)->xql_toString;
+}
+else
+{
+	$recurse = 1;		# default
+}
+my @result;
+for my $node (@$list)
+{
+	my $text = $node->xql_text ($recurse);
+	next unless defined $text;
+	push @result, new XML::XQL::Text ($text, $node);
+}
+\@result;
+}
+sub rawText
+{
+my ($context, $list, $recurse) = @_;
+return [] if @$list == 0;
+if (defined $recurse)
+{
+	$recurse = $recurse->solve ($context, $list)->xql_toString;
+}
+else
+{
+	$recurse = 1;		# default
+}
+my @result;
+for my $node (@$list)
+{
+	my $text = $node->xql_rawText ($recurse);
+	next unless defined $text;
+	push @result, new XML::XQL::Text ($text, $node);
+}
+\@result;
+}
+sub true
+{
+return $XML::XQL::Boolean::TRUE;
+}
+sub false
+{
+return $XML::XQL::Boolean::FALSE;
+}
+#sub date() is in XQL::XML::Date
+sub element
+{
+my ($context, $list, $text) = @_;
+return [] if @$list == 0;
+my @result;
+if (defined $text)
+{
+	$text = XML::XQL::prepareRvalue ($text->solve ($context, $list))->xql_toString;
+	for my $node (@$list)
+	{
+	    push @result, @{$node->xql_element ($text)};
+	}
+}
+else
+{
+	for my $node (@$list)
+	{
+	    push @result, @{$node->xql_element};
+	}
+}
+@$list > 1 ? XML::XQL::sortDocOrder (\@result) : \@result;
+}
+sub attribute
+{
+my ($context, $list, $text) = @_;
+return [] if @$list == 0;
+my @result;
+if (defined $text)
+{
+	$text = XML::XQL::prepareRvalue ($text->solve ($context, $list))->xql_toString;
+	for my $node (@$list)
+	{
+	    push @result, @{ $node->xql_attribute ($text) };
+	}
+}
+else
+{
+	for my $node (@$list)
+	{
+	    push @result, @{ $node->xql_attribute };
+	}
+}
+\@result;
+}
+package XML::XQL::Bang;
+use base 'XML::XQL::Operator';
+sub solve
+{
+my ($self, $context, $list) = @_;
+$list = $self->{Left}->solve ($context, $list);
+$self->{Right}->solve ($context, $list);
+}
+sub xql_contextString
+{
+my $self = shift;
+XML::XQL::delim ($self->{Left}->xql_contextString (@_) .
+		     XML::XQL::bold ("!") .
+		     $self->{Right}->xql_contextString (@_), $self, @_);
+}
+package XML::XQL::Invocation;
+use base 'XML::XQL::Operator';
+use fields qw{ Args Name Type Once ConstVal };
+use Carp;
+sub new
+{
+my ($class, %args) = @_;
+my $self = bless \%args, $class;
+for my $par (@{$self->{Args}})
+{
+	$par->setParent ($self);
+}
+$self;
+}
+sub dispose
+{
+my $self = shift;
+for (@{ $self->{Args} })
+{
+	$_->dispose;
+}
+undef $self->{Args};
+undef $self->{Parent};
+}
+sub isConstant
+{
+my ($self) = @_;
+# An Invocation is constant, if all it's arguments are constant
+# and it's a "constant" function
+my $name = $self->{Name};
+my $cf = $self->query->{ConstFunc};
+my $const = exists ($cf->{$name}) ?
+	$cf->{name} : $XML::XQL::ConstFunc{$name};
+return 0 unless $const;
+for my $par (@{$self->{Args}})
+{
+	return 0 unless $par->isConstant;
+}
+1;
+}
+sub xql_check
+{
+my ($self, $inSubQuery, $inParam) = @_;
+# Syntactic Constraint 7:
+# In a node query this function or method is only valid inside an instance
+# of Subquery, unless it appears within an instance of Param.
+# Functions and methods are valid anywhere in a full query.
+my $query;
+if (not ($inSubQuery or $inParam) and ($query = $self->query)->isNodeQuery)
+{
+	unless ($query->isAllowedOutsideSubquery ($self->{Name}))
+	{
+	  XML::XQL::parseError $self->{Type} . " " . $self->{Name} .
+	    " is only allowed inside a Subquery or Param for 'Node Queries'." .
+	    " Context: " . $self->toContextString;
+	}
+}
+for my $par (@{$self->{Args}})
+{
+	$par->xql_check ($inSubQuery, 1);	# these are Params
+}
+# once() should only be evaluated once per query
+# "constant" functions should only be evaluated once *ever*
+$self->{Once} = $self->isOnce || $self->isConstant;
+}
+sub xql_prepCache
+{
+my ($self) = @_;
+# once() should only be evaluated once per query
+# "constant" functions should only be evaluated once *ever*
+delete $self->{ConstVal} if $self->isOnce;
+for my $par (@{$self->{Args}})
+{
+	$par->xql_prepCache;
+}
+}
+sub isOnce
+{
+$_[0]->{Name} eq "once";
+}
+sub isMethod
+{
+$_[0]->{Type} eq "method";
+}
+sub solve
+{
+my ($self, $context, $list) = @_;
+# Use the cached value if it's a "constant" function
+return $self->{ConstVal} if (exists $self->{ConstVal});
+my $func = $self->{Func};
+my $result;
+eval {
+	$result = &$func ($context, $list, @{$self->{Args}});
+	$self->{ConstVal} = $result if $self->{Once};
+};
+if ($@)
+{
+#?? or croak
+	$self->warning ("invocation of '" . $self->{Name} . "' failed:\n\t$@");
+	$self->{ConstVal} = [] if $self->{Once};
+	return [];
+}
+$result;
+}
+sub xql_contextString
+{
+my $self = shift;
+my $str = XML::XQL::bold ($self->{Name}) . "(";
+for (my $i = 0; $i < @{$self->{Args}}; $i++)
+{
+	$str .= ", " if $i > 0;
+	$str .= $self->{Args}->[$i]->xql_contextString (@_);
+}
+$str .= ")";
+XML::XQL::delim ($str, $self, @_);
+}
+# Base class shared by Node and PrimitiveType
+package XML::XQL::PrimitiveTypeBase;
+sub dispose
+{
+}
+sub xql_check
+{
+}
+sub xql_prepCache
+{
+}
+sub xql_prevSibling
+{
+undef;
+}
+# This method returns an integer that determines how values should be casted
+# for comparisons. If the left value (LHS) has a higher xql_primType, the
+# right value (RHS) is cast to the type of the LHS (otherwise, the LHS is casted
+# to the type of the LHS)
+#
+# Values for certain types:
+#	Node	0	(always cast a node to a Text string first)
+#	Text	1
+#	Number  2
+#	Boolean 3
+#	Date	4	(other classes automatically use 4 by default)
+sub xql_primType
+{
+4;	# default for all classes other then Node, Text, Number, Boolean
+}
+sub xql_toBoolean
+{
+1;	# it is true if it exists
+}
+sub xql_namespace
+{
+undef;
+}
+sub xql_baseName
+{
+undef;
+}
+sub xql_prefix
+{
+undef;
+}
+sub xql_sortKey
+{
+my $src = $_[0]->xql_sourceNode;
+$src ? $src->xql_sortKey : $XML::XQL::LAST_SORT_KEY;
+}
+sub xql_toDOM
+{
+my ($self, $doc) = @_;
+my $name = ref $self;
+$name =~ s/.*:://;
+my $elem = $doc->createElement ($name);
+$elem->setAttribute ("value", $self->xql_toString);
+$elem;
+}
+package XML::XQL::PrimitiveType;
+use vars qw( @ISA );
+@ISA = qw( XML::XQL::PrimitiveTypeBase );
+sub new
+{
+my ($class, $val, $srcNode) = @_;
+bless [$val, $srcNode], $class;
+}
+sub isConstant
+{
+1;
+}
+sub setParent
+{
+# not defined
+}
+sub solve
+{
+$_[0];	# evaluates to itself
+}
+#
+# Derived classes should not override this method.
+# Override xql_toString instead.
+#
+sub xql_contextString
+{
+my $self = shift;
+XML::XQL::delim ($self->xql_toString, $self, @_);
+}
+#
+# Return the value of the Object as a primitive Perl value, i.e. an integer,
+# a float, or a string.
+#
+sub xql_toString
+{
+$_[0]->[0];
+}
+sub xql_sourceNode
+{
+$_[0]->[1];
+}
+sub xql_setSourceNode
+{
+$_[0]->[1] = $_[1];
+}
+sub xql_setValue
+{
+# This could potentially change the value of a constant in the XQL
+# query expression.
+$_[0]->[0] = $_[1];
+}
+sub xql_nodeType
+{
+0;	# it's not a Node
+}
+sub xql_compare
+{
+# Temporarily switch off $WARNING flag, to disable messages a la:
+#  Argument "1993-02-14" isn't numeric in ncmp
+local $^W = 0;
+$_[0]->[0] <=> $_[1]->xql_toString;
+}
+sub xql_eq { my $self = shift; $self->xql_compare (@_) == 0; }
+sub xql_ne { my $self = shift; $self->xql_compare (@_) != 0; }
+sub xql_lt { my $self = shift; $self->xql_compare (@_) < 0; }
+sub xql_le { my $self = shift; $self->xql_compare (@_) <= 0; }
+sub xql_gt { my $self = shift; $self->xql_compare (@_) > 0; }
+sub xql_ge { my $self = shift; $self->xql_compare (@_) >= 0; }
+package XML::XQL::Boolean;
+use vars qw( @ISA @EXPORT $TRUE $FALSE );
+use Carp;
+@ISA = qw( XML::XQL::PrimitiveType );
+@EXPORT = qw( $TRUE $FALSE );
+$TRUE = new XML::XQL::Boolean (1);
+$FALSE = new XML::XQL::Boolean (0);
+sub xql_primType
+{
+3;
+}
+sub xql_toBoolean
+{
+$_[0]->[0];	# evaluate it to its value
+}
+sub xql_negate
+{
+#?? do we need to keep track of a source node here?
+$_[0]->[0] ? $FALSE : $TRUE;
+}
+sub xql_compare
+{
+#?? how do we convert string to boolean value
+$_[0]->[0] <=> ($_[1]->xql_toString ? 1 : 0);
+}
+sub xql_lt { badComparisonError (@_); }
+sub xql_gt { badComparisonError (@_); }
+sub xql_le { badComparisonError (@_); }
+sub xql_ge { badComparisonError (@_); }
+sub badComparisonError
+{
+croak 'comparison operator (other than =, !=, $ieq$, $ine$) not defined for type Boolean';
+}
+package XML::XQL::Number;
+use vars qw( @ISA );
+@ISA = qw( XML::XQL::PrimitiveType );
+#use overload
+#    'fallback' => 1,		# use default operators, if not specified
+#    '""' => \&debug;
+sub debug
+{
+"Number[" . $_[0]->[0] . "]";
+}
+sub xql_primType
+{
+2;
+}
+package XML::XQL::Text;
+use vars qw( @ISA );
+@ISA = qw( XML::XQL::PrimitiveType );
+#use overload
+#    'fallback' => 1,		# use default operators, if not specified
+#    '""' => \&debug;
+sub debug
+{
+"Text[" . $_[0]->[0] . "]";
+}
+sub xql_primType
+{
+1;
+}
+sub xql_compare
+{
+my ($self, $other, $ignoreCase) = @_;
+if ($ignoreCase)
+{
+	my $lhs = $self->[0];
+	my $rhs = $other->xql_toString;
+	"\U$lhs" cmp "\U$rhs";
+}
+else
+{
+	$self->[0] cmp $other->xql_toString;
+}
+}
+# Declare package XML::XQL::Node so that XML implementations can say
+# that their nodes derive from it:
+#
+# This worked for me when I added XQL support for XML::DOM:
+#
+# BEGIN
+# {
+#    push @XML::DOM::Node::ISA, 'XML::XQL::Node';
+# }
+#
+package XML::XQL::Node;
+use vars qw( @ISA );
+@ISA = qw( XML::XQL::PrimitiveTypeBase );
+use Carp;
+sub xql_primType
+{
+0;
+}
+sub xql_toBoolean
+{
+1;	# it is true if it exists
+}
+sub xql_attribute
+{
+[];
+}
+sub xql_sourceNode
+{
+$_[0];
+}
+# Default implementation - override this for speed
+sub xql_element
+{
+my ($node, $elem) = @_;
+my @list = ();
+if (defined $elem)
+{
+	for my $kid (@{$_[0]->xql_node})
+	{
+	    # 1: element
+	    push @list, $kid
+		if $kid->xql_nodeType == 1 && $kid->xql_nodeName eq $elem;
+	}
+}
+else
+{
+	for my $kid (@{$_[0]->xql_node})
+	{
+	    push @list, $kid if $kid->xql_nodeType == 1;	# 1: element
+	}
+}
+\@list;
+}
+sub xql_text
+{
+undef;
+}
+sub xql_rawText
+{
+undef;
+}
+sub xql_rawTextBlocks
+{
+undef;
+}
+sub xql_value
+{
+new XML::XQL::Text ($_[0]->xql_text ($_[1]), $_[0]);
+}
+# Convert xql_value to Perl string (or undef if xql_value is undefined)
+sub xql_toString
+{
+my $val = $_[0]->xql_value;
+return undef if XML::XQL::isEmptyList ($val);
+$val->xql_toString;
+}
+sub xql_setValue
+{
+# Not implemented for most node types
+}
+sub xql_data
+{
+"";
+}
+sub xql_nodeType
+{
+0;
+}
+sub xql_nodeName
+{
+[];
+}
+# Java code from "XML:: Namespaces in 20 lines" by James Clark:
+# see: http://www.oasis-open.org/cover/clarkNS-980804.html
+#
+# String expandName(String name, Element element, boolean isAttribute) {
+#   // The index of the colon character in the name.
+#   int colonIndex = name.indexOf(':');
+#   // The name of the attribute that declares the namespace prefix.
+#   String declAttName;
+#   if (colonIndex == -1) {
+#     // Default namespace applies only to element type names.
+#     if (isAttribute)
+#       return name;
+#     declAttName = "xmlns";
+#   }
+#   else {
+#     String prefix = name.substring(0, colonIndex);
+#     // "xml:" is special
+#     if (prefix.equals("xml"))
+#       return name;
+#     declAttName = "xmlns:" + prefix;
+#   }
+#   for (; element != null; element = element.getParent()) {
+#     String ns = element.getAttributeValue(declAttName);
+#     if (ns != null) {
+#       // Handle special meaning of xmlns=""
+#       if (ns.length() == 0 && colonIndex == -1)
+#         return name;
+#       return ns + '+' + name.substring(colonIndex + 1);
+#     }
+#   }
+#   return null;
+# }
+# From "Namespaces in XML"
+# at http://www.w3.org/TR/1998/WD-xml-names-19980916
+#
+# The prefix xml is by definition bound to the namespace name
+# urn:Connolly:input:required. The prefix xmlns is used only for
+# namespace bindings and is not itself bound to any namespace name.
+my $DEFAULT_NAMESPACE = undef;
+my $XML_NAMESPACE = "urn:Connolly:input:required";
+#?? default namespace
+sub xql_namespace
+{
+my ($self) = @_;
+my $nodeType = $self->xql_nodeType;
+my $element = $self;
+if ($nodeType == 2)		# 2: Attr
+{
+	$element = $self->xql_parent;
+}
+elsif ($nodeType != 1)	# 1: Element
+{
+	return undef;
+}
+my $name = $self->xql_nodeName;
+my $declAttName;
+if ($name =~ /([^:]+):([^:]+)/)
+{
+	my ($prefix, $basename) = ($1, $2);
+	# "xml:" is special
+	return $XML_NAMESPACE if $prefix eq "xml";
+	$declAttName = "xmlns:$prefix";
+}
+else
+{
+	# Default namespace applies only to element type names.
+	return $DEFAULT_NAMESPACE if $nodeType == 2;	# 2: Attr
+#?? default namespace?
+	$declAttName = "xmlns";
+}
+do
+{
+	my $ns = $element->xql_attribute ($declAttName);
+	next unless defined $ns;
+	return $ns->xql_rawText;
+	$element = $element->xql_parent;
+}
+while (defined ($element) and $element->xql_nodeType == 1);
+# namespace not found
+undef;
+}
+sub xql_basename
+{
+my ($self) = @_;
+my $nodeType = $self->xql_nodeType;
+return undef unless $nodeType == 1 || $nodeType == 2;
+my $name = $self->xql_nodeName;
+$name =~ s/^[^:]://;	    # strip prefix
+$name;
+}
+sub xql_prefix
+{
+my ($self) = @_;
+my $nodeType = $self->xql_nodeType;
+return undef unless $nodeType == 1 || $nodeType == 2;
+$self->xql_nodeName =~ /^([^:]+):/;
+$1;
+}
+# Used by ancestor()
+sub xql_parent
+{
+undef;
+}
+my @NodeTypeString =
+(
+"", "element", "attribute", "text", "", "", "", "processing_instruction",
+"comment", "document"
+);
+sub xql_nodeTypeString
+{
+my $i = $_[0]->xql_nodeType;
+return $NodeTypeString[$i] if ($i >= 1 && $i <= 3 || $i >= 7 && $i <= 9);
+#?? what should this return?
+"<unknown xql_nodeType $i>";
+}
+if (not $XML::XQL::Restricted)
+{
+require XML::XQL::Plus;
+}
+# All nodes should implement:
+#?? this section must be updated!!
+# - xql_document
+# - xql_node: return an unblessed list reference with childNodes (not
+#	attributes)
+# - xql_nodeType (default implementation for XML::XQL::Node returns 0):
+#   Element:			1
+#   Element Attribute:		2
+#   Markup-Delimited Region of Text (Text and CDATASection): 3
+#   Processing Instruction:	7
+#   Comment:			8
+#   Document (Entity):		9
+# - xql_text
+# - xql_value (default implementation is xql_text)
+# - xql_parent: return parent node or undef (Document, DocumentFragment)
+#
+# Element should define/override the following:
+# - xql_nodeName: return the element name
+# - xql_attribute("attributeName"): return an unblessed reference to a list
+#	with the attribute, or [] if no such attribute
+# - xql_attribute(): return an unblessed reference to a list with
+#	all attribute nodes
+# - xql_baseName, xql_prefix
+#
+# Attribute:
+# - xql_nodeName: return the attribute name
+# - xql_baseName, xql_prefix
+#
+# EntityReference:
+# - xql_data: return expanded text value
+#
+# Text, CDATASection:
+# - xql_data: return expanded text value
+#
+# -xql_element could be overriden to speed up performance
+#
+1;
+__END__
+=head1 NAME
+XML::XQL - A perl module for querying XML tree structures with XQL
+=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);
+$query->dispose; # Avoid memory leaks - Remove circular references
+# Or (to save some typing)
+@result = XML::XQL::solve ("book/title", $doc);
+# Or (to save even more typing)
+@result = $doc->xql ("book/title");
+=head1 DESCRIPTION
+The XML::XQL module implements the XQL (XML Query Language) proposal
+submitted to the XSL Working Group in September 1998.
+The spec can be found at: L<http://www.w3.org/TandS/QL/QL98/pp/xql.html>
+Most of the contents related to the XQL syntax can also be found in the
+L<XML::XQL::Tutorial> that comes with this distribution.
+Note that XQL is not the same as XML-QL!
+The current implementation only works with the L<XML::DOM> module, but once the
+design is stable and the major bugs are flushed out, other extensions might
+follow, e.g. for XML::Grove.
+XQL was designed to be extensible and this implementation tries to stick to that.
+Users can add their own functions, methods, comparison operators and data types.
+Plugging in a new XML tree structure (like XML::Grove) should be a piece of cake.
+To use the XQL module, either
+use XML::XQL;
+or
+use XML::XQL::Strict;
+The Strict module only provides the core XQL functionality as found in the
+XQL spec. By default (i.e. by using XML::XQL) you get 'XQL+', which has
+some additional features.
+See the section L<Additional Features in XQL+> for the differences.
+This module is still in development. See the To-do list in XQL.pm for what
+still needs to be done. Any suggestions are welcome, the sooner these
+implementation issues are resolved, the faster we can all use this module.
+If you find a bug, you would do me great favor by sending it to me in the
+form of a test case. See the file t/xql_template.t that comes with this distribution.
+If you have written a cool comparison operator, function, method or XQL data
+type that you would like to share, send it to enno@att.com and I will
+add it to this module.
+=head1 XML::XQL global functions
+=over 4
+=item solve (QUERY_STRING, INPUT_LIST...)
+@result = XML::XQL::solve ("doc//book", $doc);
+This is provided as a shortcut for:
+$query = new XML::XQL::Query (Expr => "doc//book");
+@result = $query->solve ($doc);
+$query->dispose;
+Note that with L<XML::XQL::DOM>, you can also write (see L<XML::DOM::Node>
+for details):
+@result = $doc->xql ("doc//book");
+=item setDocParser (PARSER)
+Sets the XML::DOM::Parser that is used by the new XQL+ document() method.
+By default it uses an XML::DOM::Parser that was created without any arguments,
+i.e.
+$PARSER = new XML::DOM::Parser;
+=item defineFunction (NAME, FUNCREF, ARGCOUNT [, ALLOWED_OUTSIDE [, CONST, [QUERY_ARG]]])
+Defines the XQL function (at the global level, i.e. for all newly created
+queries) with the specified NAME. The ARGCOUNT parameter can either be a single
+number or a reference to a list with numbers.
+A single number expands to [ARGCOUNT, ARGCOUNT]. The list contains pairs of
+numbers, indicating the number of arguments that the function allows. The value
+-1 means infinity. E.g. [2, 5, 7, 9, 12, -1] means that the function can have
+2, 3, 4, 5, 7, 8, 9, 12 or more arguments.
+The number of arguments is checked when parsing the XQL query string.
+The second parameter must be a reference to a Perl function or an anonymous
+sub. E.g. '\&my_func' or 'sub { ... code ... }'
+If ALLOWED_OUTSIDE (default is 0) is set to 1, the function or method may
+also be used outside subqueries in I<node queries>.
+(See NodeQuery parameter in Query constructor)
+If CONST (default is 0) is set to 1, the function is considered to be
+"constant". See L<Constant Function Invocations> for details.
+If QUERY_ARG (default is 0) is not -1, the argument with that index is
+considered to be a 'query parameter'. If the query parameter is a subquery,
+that returns multiple values, the result list of the function invocation will
+contain one result value for each value of the subquery.
+E.g. 'length(book/author)' will return a list of Numbers, denoting the string
+lengths of all the author elements returned by 'book/author'.
+Note that only methods (not functions) may appear after a Bang "!" operator.
+This is checked when parsing the XQL query string.
+See also: defineMethod
+=item generateFunction (NAME, FUNCNAME, RETURN_TYPE [, ARGCOUNT [, ALLOWED_OUTSIDE [, CONST [, QUERY_ARG]]]])
+Generates and defines an XQL function wrapper for the Perl function with the
+name FUNCNAME. The function name will be NAME in XQL query expressions.
+The return type should be one of the builtin XQL Data Types or a class derived
+from XML::XQL::PrimitiveType (see L<Adding Data Types>.)
+See defineFunction for the meaning of ARGCOUNT, ALLOWED_OUTSIDE, CONST and
+QUERY_ARG.
+Function values are always converted to Perl strings with xql_toString before
+they are passed to the Perl function implementation. The function return value
+is cast to an object of type RETURN_TYPE, or to the empty list [] if the
+result is undef. It uses expandType to expand XQL primitive type names.
+If RETURN_TYPE is "*", it returns the function
+result as is, unless the function result is undef, in which case it returns [].
+=item defineMethod (NAME, FUNCREF, ARGCOUNT [, ALLOWED_OUTSIDE])
+Defines the XQL method (at the global level, i.e. for all newly created
+queries) with the specified NAME. The ARGCOUNT parameter can either be a single
+number or a reference to a list with numbers.
+A single number expands to [ARGCOUNT, ARGCOUNT]. The list contains pairs of
+numbers, indicating the number of arguments that the method allows. The value
+-1 means infinity. E.g. [2, 5, 7, 9, 12, -1] means that the method can have
+2, 3, 4, 5, 7, 8, 9, 12 or more arguments.
+The number of arguments is checked when parsing the XQL query string.
+The second parameter must be a reference to a Perl function or an anonymous
+sub. E.g. '\&my_func' or 'sub { ... code ... }'
+If ALLOWED_OUTSIDE (default is 0) is set to 1, the function or method may
+also be used outside subqueries in I<node queries>.
+(See NodeQuery parameter in Query constructor)
+Note that only methods (not functions) may appear after a Bang "!" operator.
+This is checked when parsing the XQL query string.
+See also: defineFunction
+=item defineComparisonOperators (NAME => FUNCREF [, NAME => FUNCREF]*)
+Defines XQL comparison operators at the global level.
+The FUNCREF parameters must be a references to a Perl function or an anonymous
+sub. E.g. '\&my_func' or 'sub { ... code ... }'
+E.g. define the operators $my_op$ and $my_op2$:
+defineComparisonOperators ('my_op' => \&my_op,
+'my_op2' => sub { ... insert code here ... });
+=item defineElementValueConvertor (TAG_NAME, FUNCREF)
+Defines that the result of the value() call for Elements with the specified
+TAG_NAME uses the specified function. The function will receive
+two parameters. The second one is the TAG_NAME of the Element node
+and the first parameter is the Element node itself.
+FUNCREF should be a reference to a Perl function, e.g. \&my_sub, or
+an anonymous sub.
+E.g. to define that all Elements with tag name 'date-of-birth' should return
+XML::XQL::Date objects:
+	defineElementValueConvertor ('date-of-birth', sub {
+		my $elem = shift;
+		# Always pass in the node as the second parameter. This is
+		# the reference node for the object, which is used when
+		# sorting values in document order.
+		new XML::XQL::Date ($elem->xql_text, $elem);
+	});
+These convertors can only be specified at a global level, not on a per query
+basis. To undefine a convertor, simply pass a FUNCREF of undef.
+=item defineAttrValueConvertor (ELEM_TAG_NAME, ATTR_NAME, FUNCREF)
+Defines that the result of the value() call for Attributes with the specified
+ATTR_NAME and a parent Element with the specified ELEM_TAG_NAME
+uses the specified function. An ELEM_TAG_NAME of "*" will match regardless of
+the tag name of the parent Element. The function will receive
+3 parameters. The third one is the tag name of the parent Element (even if
+ELEM_TAG_NAME was "*"), the second is the ATTR_NAME and the first is the
+Attribute node itself.
+FUNCREF should be a reference to a Perl function, e.g. \&my_sub, or
+an anonymous sub.
+These convertors can only be specified at a global level, not on a per query
+basis. To undefine a convertor, simply pass a FUNCREF of undef.
+=item defineTokenQ (Q)
+Defines the token for the q// string delimiters at a global level.
+The default value for XQL+ is 'q', for XML::XQL::Strict it is undef.
+A value of undef will deactivate this feature.
+=item defineTokenQQ (QQ)
+Defines the token for the qq// string delimiters at a global level.
+The default value for XQL+ is 'qq', for XML::XQL::Strict it is undef.
+A value of undef will deactivate this feature.
+=item expandType (TYPE)
+Used internally to expand type names of XQL primitive types.
+E.g. it expands "Number" to "XML::XQL::Number" and is not case-sensitive, so
+"number" and "NuMbEr" will both expand correctly.
+=item defineExpandedTypes (ALIAS, FULL_NAME [, ...])
+For each pair of arguments it allows the class name FULL_NAME to be abbreviated
+with ALIAS. The definitions are used by expandType().
+(ALIAS is always converted to lowercase internally, because expandType
+is case-insensitive.)
+Overriding the ALIAS for "date", also affects the object type returned by the
+date() function.
+=item setErrorContextDelimiters (START, END, BOLD_ON, BOLD_OFF)
+Sets the delimiters used when printing error messages during query evaluation.
+The default delimiters on Unix are `tput smul` (underline on) and `tput rmal`
+(underline off). On other systems (that don't have tput), the delimiters are
+">>" and "<<" resp.
+When printing the error message, the subexpression that caused the error will
+be enclosed by the delimiters, i.e. underlined on Unix.
+For certain subexpressions the significant keyword, e.g. "$and$" is enclosed in
+the bold delimiters BOLD_ON (default: `tput bold` on Unix, "" elsewhere) and
+BOLD_OFF (default: (`tput rmul` . `tput smul`) on Unix, "" elsewhere,
+see $BoldOff in XML::XQL::XQL.pm for details.)
+=item isEmptyList (VAR)
+Returns 1 if VAR is [], else 0. Can be used in user defined functions.
+=back
+=head1 Additional Features in XQL+
+=over 4
+=item Parent operator '..'
+The '..' operator returns the parent of the current node, where '.' would
+return the current node. This is not part of any XQL standard, because you
+would normally use return operators, which are not implemented here.
+=item Sequence operators ';' and ';;'
+The sequence operators ';' (precedes) and ';;' (immediately precedes) are
+not in the XQL spec, but are described in 'The Design of XQL' by Jonathan Robie
+who is one of the designers of XQL. It can be found at
+L<http://www.texcel.no/whitepapers/xql-design.html>
+See also the XQL Tutorial for a description of what they mean.
+=item q// and qq// String Tokens
+String tokens a la q// and qq// are allowed. q// evaluates like Perl's single
+quotes and qq// like Perl's double quotes. Note that the default XQL strings do
+not allow escaping etc., so it's not possible to define a string with both
+single and double quotes. If 'q' and 'qq' are not to your liking, you may
+redefine them to something else or undefine them altogether, by assigning undef
+to them. E.g:
+# at a global level - shared by all queries (that don't (re)define 'q')
+XML::XQL::defineTokenQ ('k');
+XML::XQL::defineTokenQQ (undef);
+# at a query level - only defined for this query
+$query = new XML::XQL::Query (Expr => "book/title", q => 'k', qq => undef);
+From now on k// works like q// did and qq// doesn't work at all anymore.
+=item Query strings can have embedded Comments
+For example:
+$queryExpr = "book/title          # this comment is inside the query string
+	       [. = 'Moby Dick']"; # this comment is outside
+=item Optional dollar delimiters and case-insensitive XQL keywords
+The following XQL keywords are case-insensitive and the dollar sign delimiters
+may be omitted: $and$, $or$, $not$, $union$, $intersect$, $to$, $any$, $all$,
+$eq$, $ne$, $lt$, $gt$, $ge$, $le$, $ieq$, $ine$, $ilt$, $igt$, $ige$, $ile$.
+E.g. $AND$, $And$, $aNd$, and, And, aNd are all valid replacements for $and$.
+Note that XQL+ comparison operators ($match$, $no_match$, $isa$, $can$) still
+require dollar delimiters and are case-sensitive.
+=item Comparison operator: $match$ or '=~'
+E.g. "book/title =~ '/(Moby|Dick)/']" will return all book titles containing
+Moby or Dick. Note that the match expression needs to be quoted and should
+contain the // or m// delimiters for Perl.
+When casting the values to be matched, both are converted to Text.
+=item Comparison operator: $no_match$ or '!~'
+E.g. "book/title !~ '/(Moby|Dick)/']" will return all book titles that don't
+contain Moby or Dick. Note that the match expression needs to be quoted and
+should contain the // or m// delimiters for Perl.
+When casting the values to be matched, both are converted to Text.
+=item Comparison operator: $isa$
+E.g. '//. $isa$ "XML::XQL::Date"' returns all elements for which the value()
+function returns an XML::XQL::Date object. (Note that the value() function can
+be overridden to return a specific object type for certain elements and
+attributes.) It uses expandType to expand XQL primitive type names.
+=item Comparison operator: $can$
+E.g. '//. $can$ "swim"' returns all elements for which the value()
+function returns an object that implements the (Perl) swim() method.
+(Note that the value() function can be overridden to return a specific object
+type for certain elements and attributes.)
+=item Function: once (QUERY)
+E.g. 'once(id("foo"))' will evaluate the QUERY expression only once per query.
+Certain query results (like the above example) will always return the same
+value within a query. Using once() will cache the QUERY result for the
+rest of the query.
+Note that "constant" function invocations are always cached.
+See also L<Constant Function Invocations>
+=item Function: subst (QUERY, EXPR, EXPR [,MODIFIERS, [MODE]])
+E.g. 'subst(book/title, "[M|m]oby", "Dick", "g")' will replace Moby or moby
+with Dick globally ("g") in all book title elements. Underneath it uses Perl's
+substitute operator s///. Don't worry about which delimiters are used underneath.
+The function returns all the book/titles for which a substitution occurred.
+The default MODIFIERS string is "" (empty.) The function name may be abbreviated
+to "s".
+For most Node types, it converts the value() to a string (with xql_toString)
+to match the string and xql_setValue to set the new value in case it matched.
+For XQL primitives (Boolean, Number, Text) and other data types (e.g. Date) it
+uses xql_toString to match the String and xql_setValue to set the result.
+Beware that performing a substitution on a primitive that was found in the
+original XQL query expression, changes the value of that constant.
+If MODE is 0 (default), it treats Element nodes differently by matching and
+replacing I<text blocks> occurring in the Element node. A text block is defined
+as the concatenation of the raw text of subsequent Text, CDATASection and
+EntityReference nodes. In this mode it skips embedded Element nodes.
+If a text block matches, it is replaced by a single Text node, regardless
+of the original node type(s).
+If MODE is 1, it treats Element nodes like the other nodes, i.e. it converts
+the value() to a string etc. Note that the default implementation of value()
+calls text(), which normalizes whitespace and includes embedded Element
+descendants (recursively.) This is probably not what you want to use in most
+cases, but since I'm not a professional psychic... :-)
+=item Function: map (QUERY, CODE)
+E.g. 'map(book/title, "s/[M|m]oby/Dick/g; $_")' will replace Moby or moby
+with Dick globally ("g") in all book title elements. Underneath it uses Perl's
+map operator. The function returns all the book/titles for which a
+change occurred.
+??? add more specifics
+=item Function: eval (EXPR [,TYPE])
+Evaluates the Perl expression EXPR and returns an object of the specified TYPE.
+It uses expandType to expand XQL primitive type names.
+If the result of the eval was undef, the empty list [] is returned.
+E.g. 'eval("2 + 5", "Number")' returns a Number object with the value 7, and
+'eval("%ENV{USER}")' returns a Text object with the user name.
+Consider using once() to cache the return value, when the invocation will
+return the same result for each invocation within a query.
+??? add more specifics
+=item Function: new (TYPE [, QUERY [, PAR] *])
+Creates a new object of the specified object TYPE. The constructor may have any
+number of arguments. The first argument of the constructor (the 2nd argument
+of the new() function) is considered to be a 'query parameter'.
+See defineFunction for a definition of I<query parameter>.
+It uses expandType to expand XQL primitive type names.
+=item Function: document (QUERY) or doc (QUERY)
+The document() function creates a new L<XML::XML::Document> for each result
+of QUERY (QUERY may be a simple string expression, like "/usr/enno/file.xml".
+See t/xql_document.t or below for an example with a more complex QUERY.)
+document() may be abbreviated to doc().
+document() uses an XML::DOM::Parser underneath, which can be set with
+XML::XQL::setDocParser(). By default it uses a parser that was created without
+any arguments, i.e.
+$PARSER = new XML::DOM::Parser;
+Let's try a more complex example, assuming $doc contains:
+<doc>
+<file name="file1.xml"/>
+<file name="file2.xml"/>
+</doc>
+Then the following query will return two L<XML::XML::Document>s,
+one for file1.xml and one for file2.xml:
+@result = XML::XQL::solve ("document(doc/file/@name)", $doc);
+The resulting documents can be used as input for following queries, e.g.
+@result = XML::XQL::solve ("document(doc/file/@name)/root/bla", $doc);
+will return all /root/bla elements from the documents returned by document().
+=item Method: DOM_nodeType ()
+Returns the DOM node type. Note that these are mostly the same as nodeType(),
+except for CDATASection and EntityReference nodes. DOM_nodeType() returns
+4 and 5 respectively, whereas nodeType() returns 3, because they are
+considered text nodes.
+=item Function wrappers for Perl builtin functions
+XQL function wrappers have been provided for most Perl builtin functions.
+When using a Perl builtin function like "substr" in an XQL+ querry, an
+XQL function wrapper will be generated on the fly. The arguments to these
+functions may be regular XQL+ subqueries (that return one or more values) for
+a I<query parameter> (see generateFunction for a definition.)
+Most wrappers of Perl builtin functions have argument 0 for a query parameter,
+except for: chmod (parameter 1 is the query parameter), chown (2) and utime (2).
+The following functions have no query parameter, which means that all parameters
+should be a single value: atan2, rand, srand, sprintf, rename, unlink, system.
+The function result is casted to the appropriate XQL primitive type (Number,
+Text or Boolean), or to an empty list if the result was undef.
+=back
+=head2 XPath functions and methods
+The following functions were found in the XPath specification:
+=over 4
+=item Function: concat (STRING, STRING, STRING*)
+The concat function returns the concatenation of its arguments.
+=item Function: starts-with (STRING, STRING)
+The starts-with function returns true if the first argument string starts with
+the second argument string, and otherwise returns false.
+=item Function: contains (STRING, STRING)
+The contains function returns true if the first argument string contains the
+second argument string, and otherwise returns false.
+=item Function: substring-before (STRING, STRING)
+The substring-before function returns the substring of the first argument
+string that precedes the first occurrence of the second argument string
+in the first argument string, or the empty string if the first argument
+string does not contain the second argument string. For example,
+substring-before("1999/04/01","/") returns 1999.
+=item Function: substring-after (STRING, STRING)
+The substring-after function returns the substring of the first argument string
+that follows the first occurrence of the second argument string in
+the first argument string, or the empty string if the first argument string does
+not contain the second argument string. For example,
+substring-after("1999/04/01","/") returns 04/01,
+and
+substring-after("1999/04/01","19") returns 99/04/01.
+=item Function: substring (STRING, NUMBER [, NUMBER] )
+The substring function returns the substring of the first argument starting at
+the position specified in the second argument with length specified in
+the third argument. For example,
+substring("12345",2,3) returns "234".
+If the third argument is not specified, it returns the substring
+starting at the position specified in the second argument and continuing to
+the end of the string. For example,
+substring("12345",2) returns "2345".
+More precisely, each character in the string is considered
+to have a numeric position: the position of the first character is 1,
+the position of the second character is 2 and so on.
+NOTE: This differs from the B<substr> method , in which the
+method treats the position of the first character as 0.
+The XPath spec says this about rounding, but that is not true in this
+implementation:
+I<The returned substring contains those characters for which the position of the
+character is greater than or equal to the rounded value of the
+second argument and, if the third argument is specified, less than the
+sum of the rounded value of the second argument and the rounded value of
+the third argument; the comparisons and addition used for the above
+follow the standard IEEE 754 rules; rounding is done as if by a call to the
+round function.>
+=item Method: string-length ( [ QUERY ] )
+The string-length returns the number of characters in the string.
+If the argument is omitted, it defaults to the context node
+converted to a string, in other words the string-value of the context node.
+Note that the generated XQL wrapper for the Perl built-in B<substr> does not
+allow the argument to be omitted.
+=item Method: normalize-space ( [ QUERY ] )
+The normalize-space function returns the argument string with whitespace
+normalized by stripping leading and trailing whitespace and replacing
+sequences of whitespace characters by a single space. Whitespace characters are
+the same as those allowed by the S production in XML. If the
+argument is omitted, it defaults to the context node converted to a string, in
+other words the string-value of the context node.
+=item Function: translate (STRING, STRING, STRING)
+The translate function returns the first argument string with occurrences of
+characters in the second argument string replaced by the character at
+the corresponding position in the third argument string. For example,
+translate("bar","abc","ABC") returns the string BAr.
+If there is a
+character in the second argument string with no character at a corresponding
+position in the third argument string (because the second argument
+string is longer than the third argument string), then occurrences of that
+character in the first argument string are removed. For example,
+translate("--aaa--","abc-","ABC") returns "AAA".
+If a character occurs more than once in the second argument string, then the
+first occurrence determines the replacement character. If the third argument
+string is longer than the second argument string, then excess characters
+are ignored.
+NOTE: The translate function is not a sufficient solution for case conversion
+in all languages. A future version may
+provide additional functions for case conversion.
+This function was implemented using tr///d.
+=item Function: sum ( QUERY )
+The sum function returns the sum of the QUERY results, by
+converting the string values of each result to a number.
+=item Function: floor (NUMBER)
+The floor function returns the largest (closest to positive infinity) number
+that is not greater than the argument and that is an integer.
+=item Function: ceiling (NUMBER)
+The ceiling function returns the smallest (closest to negative infinity) number
+that is not less than the argument and that is an integer.
+=item Function: round (NUMBER)
+The round function returns the number that is closest to the argument
+and that is an integer. If there are two such numbers, then the one that is
+closest to positive infinity is returned.
+=back
+=head1 Implementation Details
+=over 4
+=item XQL Builtin Data Types
+The XQL engine uses the following object classes internally. Only Number,
+Boolean and Text are considered I<primitive XQL types>:
+=over 4
+=item * XML::XQL::Number
+For integers and floating point numbers.
+=item * XML::XQL::Boolean
+For booleans, e.g returned by true() and false().
+=item * XML::XQL::Text
+For string values.
+=item * XML::XQL::Date
+For date, time and date/time values. E.g. returned by the date() function.
+=item * XML::XQL::Node
+Superclass of all XML node types. E.g. all subclasses of XML::DOM::Node subclass
+from this.
+=item * Perl list reference
+Lists of values are passed by reference (i.e. using [] delimiters).
+The empty list [] has a double meaning. It also means 'undef' in certain
+situations, e.g. when a function invocation or comparison failed.
+=back
+=item Type casting in comparisons
+When two values are compared in an XML comparison (e.g. $eq$) the values are
+first casted to the same data type. Node values are first replaced by their
+value() (i.e. the XQL value() function is used, which returns a Text value by
+default, but may return any data type if the user so chooses.)
+The resulting values are then casted to the type of the object with the highest
+xql_primType() value. They are as follows: Node (0), Text (1), Number (2),
+Boolean (3), Date (4), other data types (4 by default, but this may be
+overriden by the user.)
+E.g. if one value is a Text value and the other is a Number, the Text value is
+cast to a Number and the resulting low-level (Perl) comparison is (for $eq$):
+$number->xql_toString == $text->xql_toString
+If both were Text values, it would have been
+$text1->xql_toString eq $text2->xql_toString
+Note that the XQL spec is vague and even conflicting where it concerns type
+casting. This implementation resulted after talking to Joe Lapp, one of the
+spec writers.
+=item Adding Data Types
+If you want to add your own data type, make sure it derives from
+XML::XQL::PrimitiveType and implements the necessary methods.
+I will add more stuff here to explain it all, but for now, look at the code
+for the primitive XQL types or the Date class (L<XML::XQL::Date> in Date.pm.)
+=item Document Order
+The XQL spec states that query results always return their values in
+I<document order>, which means the order in which they appeared in the original
+XML document. Values extracted from Nodes (e.g. with value(), text(), rawText(),
+nodeName(), etc.) always have a pointer to the reference node (i.e. the Node
+from which the value was extracted.) These pointers are acknowledged when
+(intermediate) result lists are sorted. Currently, the only place where a
+result list is sorted is in a $union$ expression, which is the only place
+where the result list can be unordered.
+(If you find that this is not true, let me know.)
+Non-node values that have no associated reference node, always end up at the end
+of the result list in the order that they were added.
+The XQL spec states that the reference node for an XML Attribute is the Element
+to which it belongs, and that the order of values with the same reference node
+is undefined. This means that the order of an Element and its attributes would
+be undefined.
+But since the XML::DOM module keeps track of the order of the attributes, the
+XQL engine does the same, and therefore, the attributes of an Element are
+sorted and appear after their parent Element in a sorted result list.
+=item Constant Function Invocations
+If a function always returns the same value when given "constant" arguments,
+the function is considered to be "constant". A "constant" argument can be
+either an XQL primitive (Number, Boolean, Text) or a "constant" function
+invocation. E.g.
+date("12-03-1998")
+true()
+sin(0.3)
+length("abc")
+date(substr("12-03-1998 is the date", 0, 10))
+are constant, but not:
+length(book[2])
+Results of constant function invocations are cached and calculated only once
+for each query. See also the CONST parameter in defineFunction.
+It is not necessary to wrap constant function invocations in a once() call.
+Constant XQL functions are: date, true, false and a lot of the XQL+
+wrappers for Perl builtin functions. Function wrappers for certain builtins
+are not made constant on purpose to force the invocation to be evaluated
+every time, e.g. 'mkdir("/user/enno/my_dir", "0644")' (although constant
+in appearance) may return different results for multiple invocations.
+See %PerlFunc in Plus.pm for details.
+=item Function: count ([QUERY])
+The count() function has no parameters in the XQL spec. In this implementation
+it will return the number of QUERY results when passed a QUERY parameter.
+=item Method: text ([RECURSE])
+When expanding an Element node, the text() method adds the expanded text() value
+of sub-Elements. When RECURSE is set to 0 (default is 1), it will not include
+sub-elements. This is useful e.g. when using the $match$ operator in a recursive
+context (using the // operator), so it won't return parent Elements when one of
+the children matches.
+=item Method: rawText ([RECURSE])
+See text().
+=back
+=head1 SEE ALSO
+L<XML::XQL::Query>, L<XML::XQL::DOM>, L<XML::XQL::Date>
+The Japanese version of this document can be found on-line at
+L<http://member.nifty.ne.jp/hippo2000/perltips/xml/xql.htm>
+The L<XML::XQL::Tutorial> manual page. The Japanese version can be found at
+L<http://member.nifty.ne.jp/hippo2000/perltips/xml/xql/tutorial.htm>
+The XQL spec at L<http://www.w3.org/TandS/QL/QL98/pp/xql.html>
+The Design of XQL at L<http://www.texcel.no/whitepapers/xql-design.html>
+The DOM Level 1 specification at L<http://www.w3.org/TR/REC-DOM-Level-1>
+The XML spec (Extensible Markup Language 1.0) at L<http://www.w3.org/TR/REC-xml>
+The L<XML::Parser> and L<XML::Parser::Expat> manual pages.
+=head1 AUTHOR
+Please send bugs, comments and suggestions to Enno Derksen <F<enno@att.com>>
+=cut

changeset 662	60be34e1b006
parent 655	3f65fd25dfd4