dummy_foundation/lib/XML/XQL.pm
changeset 0 02cd6b52f378
equal deleted inserted replaced
-1:000000000000 0:02cd6b52f378
       
     1 ############################################################################
       
     2 # Copyright (c) 1998,1999 Enno Derksen
       
     3 # All rights reserved.
       
     4 # This program is free software; you can redistribute it and/or modify it
       
     5 # under the same terms as Perl itself. 
       
     6 ############################################################################
       
     7 #
       
     8 # To do (in no particular order):
       
     9 #
       
    10 # - Element tag names that are the same as a XQL keyword (e.g. "or", "not", ..)
       
    11 #   are currently not supported. The parser and lexer needs to be smarter and
       
    12 #   know what context they are in.
       
    13 # - output using xql:result etc.
       
    14 # - xml:space=preserve still needs to be adhered to in text() etc.
       
    15 #   - I already added xql_preserveSpace. Still need to use it in (raw)text() etc.
       
    16 # - XQL functions (like value()) should probably work on input lists > 1 node
       
    17 #   (The code was changed, but it needs to be tested. ancestor() wasn't fixed)
       
    18 # - verify implementation of xql_namespace
       
    19 # - verify implementation of end, index
       
    20 # - check passing of context to the solve() methods
       
    21 # - functions/methods may be wrong. They receive the entire LHS set,
       
    22 #   so count() is right, but the rest may be wrong!
       
    23 # - may need to use different comment delimiters, '#' may be used in future XQL
       
    24 #   definition (according to Joe Lapp, one of the XQL spec authors)
       
    25 # - caching of Node xql_values (?)
       
    26 # - finish the Date class
       
    27 #   - discuss which classes: Date, Time, and/or DateTime ?
       
    28 # - conversion of Query result to Perl primitives, i.e. how do we return the
       
    29 #   result of a query.
       
    30 # - add support for ordering/formatting the query results, see XML-QL
       
    31 # - discuss typecasting mechanism
       
    32 # - error reporting mechanism
       
    33 #   - yyerror handler doesn't seem to work
       
    34 #   - passing intermediate exceptions ($@) to the user
       
    35 #   - more debugging support
       
    36 # - subst, map etc. 
       
    37 #   - use rawText for Nodes?
       
    38 #     - recurse or not?
       
    39 # - text/rawText default - recurse or not? 
       
    40 #   - what should default value() implementation use?
       
    41 # - check if all Syntactic Constraints in XQL spec are implemented
       
    42 # - support all node types, i.e. Notation, Attlist etc.
       
    43 #   - sorting in 'document order' doesn't work yet for 'other' DOM nodes
       
    44 # - generateFunction - support functions that return lists?
       
    45 # - match() function - what should it return?
       
    46 # - keeping track of reference nodes not always done right
       
    47 #   - also think about Perl builtin functions
       
    48 # - conversion to Perl number throws warnings with -w (in comparisons etc.)
       
    49 # - sorting
       
    50 #   - add sorting by attribute name (within same element)
       
    51 #     (or other criteria)
       
    52 #   - optional sorting in $union$ ?
       
    53 #     - could add a flag that says "don't worry about document order for $union$"
       
    54 #   - user defined sort?
       
    55 # - OPTIMIZE!
       
    56 #   - Subscript operator
       
    57 #   - Filter operator
       
    58 #   - etc.
       
    59 
       
    60 package XML::XQL;
       
    61 use strict;
       
    62 
       
    63 use Carp;
       
    64 use XML::RegExp;
       
    65 
       
    66 use vars qw( @EXPORT $VERSION 
       
    67 	     $ContextStart $ContextEnd $BoldOn $BoldOff 
       
    68 	     %Func %Method %FuncArgCount
       
    69 	     %AllowedOutsideSubquery %ConstFunc %ExpandedType
       
    70 	     $Restricted $Included $ReXQLName
       
    71 	     %CompareOper $Token_q $Token_qq $LAST_SORT_KEY
       
    72 	   );
       
    73 
       
    74 @EXPORT = qw( $VERSION $Restricted $Included );
       
    75 
       
    76 BEGIN
       
    77 {
       
    78     $VERSION = '0.63';
       
    79 
       
    80     die "XML::XQL is already used/required" if defined $Included;
       
    81     $Included = 1;
       
    82     
       
    83     # From XQL spec (The '-' was added to allow XPath style function names.)
       
    84     $ReXQLName =	  "(?:[-a-zA-Z_]+\\w*)";
       
    85     
       
    86     $Token_q = undef;
       
    87     $Token_qq = undef;
       
    88     
       
    89     $Restricted = 0 unless defined $Restricted;
       
    90 
       
    91     if (not $Restricted)
       
    92     {
       
    93 	# Allow names with Perl package prefixes
       
    94 	$ReXQLName = "(?:$ReXQLName(?:::$ReXQLName)*)";
       
    95 
       
    96 	# Support q// and qq// strings
       
    97 	$Token_q = "q";
       
    98 	$Token_qq = "qq";
       
    99     }
       
   100 };
       
   101 
       
   102 # To save the user some typing for the simplest cases
       
   103 sub solve
       
   104 {
       
   105     my ($expr, @args) = @_;
       
   106     my $query = new XML::XQL::Query (Expr => $expr);
       
   107     my @result = $query->solve (@args);
       
   108     $query->dispose;
       
   109 
       
   110     @result;
       
   111 }
       
   112 
       
   113 #---------- Parser related stuff ----------------------------------------------
       
   114 
       
   115 # Find (nested) closing delimiter in q{} or qq{} strings
       
   116 sub parse_q
       
   117 {
       
   118     my ($qname, $q, $str, $d1, $d2) = @_;
       
   119     my ($match) = "";
       
   120     my ($found);
       
   121 
       
   122     while ($str =~ /^([^$d1$d2]*)($d1|($d2))(.*)/s)
       
   123     {
       
   124 	defined ($3) and return ($4, $match . $1);		# $d2 found
       
   125 
       
   126 	# match delimiters recursively
       
   127 	$match .= $1 . $2;
       
   128 
       
   129 	($str, $found) = parse_q ($qname, $q, $4, $d1, $d2);
       
   130 	$match .= $found . $d2;
       
   131     }
       
   132     XML::XQL::parseError ("no $qname// closing delimiter found near '$q$d1'");
       
   133 }
       
   134 
       
   135 # To support nested delimiters in q{} and qq() strings
       
   136 my %MatchingCloseDelim =
       
   137 (
       
   138  '{' => '}',
       
   139  '(' => ')',
       
   140  '<' => '>',
       
   141  '[' => ']'
       
   142 );
       
   143 
       
   144 sub Lexer 
       
   145 {
       
   146     my($parser)=shift;
       
   147 
       
   148     exists($parser->YYData->{LINE})
       
   149 	or $parser->YYData->{LINE} = 1;
       
   150 
       
   151     $parser->YYData->{INPUT}
       
   152 	or return('', undef);
       
   153 
       
   154     print "Lexer input=[" . $parser->YYData->{INPUT} . "]\n"
       
   155 	if $parser->{yydebug};
       
   156 
       
   157     if ($Restricted)
       
   158     {
       
   159 	# strip leading whitespace
       
   160 	$parser->YYData->{INPUT} =~ s/^\s*//;
       
   161     }
       
   162     else
       
   163     {
       
   164 	# strip leading whitespace and comments
       
   165 	$parser->YYData->{INPUT} =~ s/^(\s|#.*)*//;
       
   166     }
       
   167 
       
   168 
       
   169     for ($parser->YYData->{INPUT}) 
       
   170     {
       
   171 	s#^"([^"]*)"##o	and return ('TEXT', $1);
       
   172 	s#^'([^']*)'##o	and return ('TEXT', $1);
       
   173 	
       
   174 	if (not $Restricted)
       
   175 	{
       
   176 	    # Support q// and qq// string delimiters
       
   177 	    for my $qname ('q', 'qq')
       
   178 	    {
       
   179 		my ($q) = $parser->{Query}->{$qname};
       
   180 		if (defined ($q) and s/^$q(\[\(\{\<#!=-\+|'":;\.,\?\/!@\%^\*)//)
       
   181 		{
       
   182 		    my ($d1, $d2) = ($1, $MatchingCloseDelim{$1});
       
   183 		    my ($str);
       
   184 		    if (defined $d2)
       
   185 		    {
       
   186 			($parser->YYData->{INPUT}, $str) = parse_q (
       
   187 					$qname, $q, $_, $d1, $d2);
       
   188 		    }
       
   189 		    else	# close delim is same open delim 
       
   190 		    {
       
   191 			$d2 = $d1;
       
   192 			s/([^$d2])*$d2// or XML::XQL::parseError (
       
   193 			    "no $qname// closing delimiter found near '$q$d1'");
       
   194 			$str = $1;
       
   195 		    }
       
   196 		    return ('TEXT', eval "$q$d1$str$d2");
       
   197 		}
       
   198 	    }
       
   199 	}
       
   200 
       
   201 	s/^(-?\d+\.(\d+)?)//		and return ('NUMBER', $1);
       
   202 	s/^(-?\d+)//			and return ('INTEGER', $1);
       
   203 
       
   204 	s/^(\$|\b)(i?(eq|ne|lt|le|gt|ge))\1(?=\W)//i
       
   205 					and return ('COMPARE', "\L$2");
       
   206 
       
   207 	s/^((\$|\b)(any|all|or|and|not|to|intersect)\2)(?=\W)//i
       
   208 					and return ("\L$3", $1);
       
   209 
       
   210   	s/^((\$|\b)union\2(?=\W)|\|)//i	and return ('UnionOp', $1);
       
   211 
       
   212   	s/^(;;?)//			and return ('SeqOp', $1);
       
   213 
       
   214 	if (not $Restricted)
       
   215 	{
       
   216 	    s/^(=~|!~)//		and return ('MATCH', $1);
       
   217 	    s/^\$((no_)?match)\$//i
       
   218 					and return ('MATCH', "\L$1");
       
   219 	    s/^\$($ReXQLName)\$//o	and return ('COMPARE', $1);
       
   220 	}
       
   221 
       
   222 	s/^(=|!=|<|<=|>|>=)//		and return ('COMPARE', $1);
       
   223 
       
   224 	s!^(//|/|\(|\)|\.\.?|@|\!|\[|\]|\*|:|,)!!
       
   225 					and return ($1, $1);
       
   226 
       
   227  	s/^($ReXQLName)\s*\(//o
       
   228 					and return ('XQLName_Paren', $1);
       
   229 
       
   230 	s/^($XML::RegExp::Name)//o	and return ('NCName', $1);	
       
   231     }
       
   232 }
       
   233 
       
   234 #------ end Parser related stuff ----------------------------------------------
       
   235 
       
   236 # Converts result from a Disjunction to a 0 or 1.
       
   237 # If it's a XML::XQL::Boolean, its value is returned.
       
   238 # If it's an empty list it returns 0.
       
   239 # If it's a node or a Text or Number, it returns 1.
       
   240 # If it's a list with 1 or more elements, it returns 1 if at least one
       
   241 # element evaluates to 1 (with toBoolean)
       
   242 sub toBoolean	# static method
       
   243 {
       
   244     my $arg = shift;
       
   245 
       
   246     my $type = ref ($arg);
       
   247     if ($type eq "ARRAY")
       
   248     {
       
   249 	for my $n (@$arg)
       
   250 	{
       
   251 	    return 1 if toBoolean ($n);
       
   252 	}
       
   253 	return 0;
       
   254     }
       
   255     return $arg->xql_toBoolean;
       
   256 }
       
   257 
       
   258 sub listContains
       
   259 {
       
   260     my ($list, $x) = @_;
       
   261 
       
   262 #?? $n should be a PrimitiveType or an XML Node
       
   263     for my $y (@$list)
       
   264     {
       
   265 #??	return 1 if $x == $y;
       
   266 
       
   267 	if (ref($x) eq ref($y))		# same object class
       
   268 	{
       
   269 	    my ($src1, $src2) = ($x->xql_sourceNode, $y->xql_sourceNode);
       
   270 	    next if ((defined $src1 or defined $src2) and $src1 != $src2);
       
   271 
       
   272 	    return ($x == $y) if (UNIVERSAL::isa ($x, 'XML::XQL::Node'));
       
   273 
       
   274 	    return 1 if $x->xql_eq ($y);
       
   275 	}
       
   276     }
       
   277     0;
       
   278 }
       
   279 
       
   280 sub toList
       
   281 {
       
   282     my $r = shift;
       
   283     (ref ($r) eq "ARRAY") ? $r : [ $r ];
       
   284 }
       
   285 
       
   286 # Prepare right hand side for a comparison, i.e.
       
   287 # turn it into a single value.
       
   288 # If it is a list with 2 or more values, it croaks.
       
   289 sub prepareRvalue
       
   290 {
       
   291     my $r = shift;
       
   292 
       
   293     if (ref ($r) eq "ARRAY")
       
   294     {
       
   295 	# more than 1 value gives a runtime error (as per Joe Lapp)
       
   296         croak "bad rvalue $r" if @$r > 1;
       
   297 	$r = $r->[0];
       
   298     }
       
   299 
       
   300     if (ref ($r) and $r->isa ('XML::XQL::Node'))
       
   301     {
       
   302 	$r = $r->xql_value;
       
   303     }
       
   304     $r;
       
   305 }
       
   306 
       
   307 sub trimSpace
       
   308 {
       
   309     $_[0] =~ s/^\s+//;
       
   310     $_[0] =~ s/\s+$//;
       
   311     $_[0];
       
   312 }
       
   313 
       
   314 # Assumption: max. 32768 (2**15 = 2**($BITS-1)) children (or attributes) per node
       
   315 # Use setMaxChildren() to support larger offspring.
       
   316 my $BITS = 16;
       
   317 $LAST_SORT_KEY = (2 ** $BITS) - 1;
       
   318 
       
   319 # Call with values: $max = 128 * (256**N), where N=0, 1, 2, ...
       
   320 sub setMaxChildren
       
   321 {
       
   322     my $max = shift;
       
   323     my $m = 128;
       
   324     $BITS = 8;
       
   325     while ($max > $m)
       
   326     {
       
   327 	$m = $m * 256;
       
   328 	$BITS += 8;
       
   329     }
       
   330     $LAST_SORT_KEY = (2 ** $BITS) - 1;
       
   331 }
       
   332 
       
   333 sub createSortKey
       
   334 {
       
   335     # $_[0] = parent sort key, $_[1] = child index, 
       
   336     # $_[2] = 0 for attribute nodes, 1 for other node types
       
   337     my $vec = "";
       
   338     vec ($vec, 0, $BITS) = $_[1];
       
   339     vec ($vec, 7, 1) = $_[2] if $_[2];	# set leftmost bit (for non-attributes)
       
   340     $_[0] . $vec;
       
   341 }
       
   342 
       
   343 #--------------- Sorting source nodes ----------------------------------------
       
   344 
       
   345 # Sort the list by 'document order' (as per the XQL spec.)
       
   346 # Values with an associated source node are sorted by the position of their 
       
   347 # source node in the XML document.
       
   348 # Values without a source node are placed at the end of the resulting list.
       
   349 # The source node of an Attribute node, is its (parent) Element node 
       
   350 # (per definition.) The source node of the other types of XML nodes, is itself.
       
   351 # The order for values with the same source node is undefined.
       
   352 
       
   353 sub sortDocOrder
       
   354 {
       
   355 #?? or should I just use: sort { $a->xql_sortKey cmp $b->xql_sortKey }
       
   356 
       
   357     my $list = shift;
       
   358 
       
   359 #print "before---\n";
       
   360 #for (@$list)
       
   361 #{
       
   362 #    print "key=" . keyStr($_->xql_sortKey) . " node=" . $_->getTagName . " id=" . $_->getAttribute('id') . "\n";
       
   363 #}
       
   364 
       
   365     @$list =	map { $_->[1] }			# 3) extract nodes
       
   366 		sort { $a->[0] cmp $b->[0] }	# 2) sort by sortKey
       
   367 		map { [$_->xql_sortKey, $_] }	# 1) make [sortKey,node] records
       
   368 		@$list;
       
   369 
       
   370 #print "after---\n";
       
   371 #for (@$list)
       
   372 #{
       
   373 #    print "key=" . keyStr($_->xql_sortKey) . " node=" . $_->getTagName . " id=" . $_->getAttribute('id') . "\n";
       
   374 #}
       
   375 
       
   376     $list;
       
   377 }
       
   378 
       
   379 # Converts sort key from createSortKey in human readable form
       
   380 # For debugging only.
       
   381 sub keyStr
       
   382 {
       
   383     my $key = shift;
       
   384     my $n = $BITS / 8;
       
   385     my $bitn = 2 ** ($BITS - 1);
       
   386     my $str;
       
   387     for (my $i = 0; $i < length $key; $i += $n)
       
   388     {
       
   389 	my $dig = substr ($key, $i, $n);
       
   390 	my $v = vec ($dig, 0, $BITS);
       
   391 	my $elem = 0;
       
   392 	if ($v >= $bitn)
       
   393 	{
       
   394 	    $v -= $bitn;
       
   395 	    $elem = 1;
       
   396 	}
       
   397 	$str .= "/" if defined $str;
       
   398 	$str .= "@" unless $elem;
       
   399 	$str .= $v;
       
   400     }
       
   401     $str;
       
   402 }
       
   403 
       
   404 sub isEmptyList
       
   405 {
       
   406     my $list = shift;
       
   407     (ref ($list) eq "ARRAY") && (@$list == 0);
       
   408 }
       
   409 
       
   410 # Used by Element and Attribute nodes
       
   411 sub buildNameSpaceExpr
       
   412 {
       
   413     my ($nameSpace, $name) = @_;
       
   414     $name = ".*" if $name eq "*";
       
   415     if (defined $nameSpace)
       
   416     {
       
   417 	$nameSpace = ".*" if $nameSpace eq "*";
       
   418 	"^$nameSpace:$name\$";
       
   419     }
       
   420     else
       
   421     {
       
   422 	"^$name\$";
       
   423     }
       
   424 }
       
   425 
       
   426 sub prepareForCompare
       
   427 {
       
   428     my ($left, $right) = @_;
       
   429     my $leftType = $left->xql_primType;
       
   430     if ($leftType == 0)		# Node
       
   431     {
       
   432 	$left = $left->xql_value;
       
   433 	$leftType = $left->xql_primType;
       
   434     }
       
   435     my $rightType = $right->xql_primType;
       
   436     if ($rightType == 0)		# Node
       
   437     {
       
   438 	$right = $right->xql_value;
       
   439 	$rightType = $right->xql_primType;
       
   440     }
       
   441     # Note: reverse the order if $leftType < $rightType
       
   442     ($leftType < $rightType, $left, $right);
       
   443 }
       
   444 
       
   445 sub xql_eq
       
   446 {
       
   447     my ($left, $right, $ignoreCase) = @_;
       
   448     my $reverse;
       
   449     ($reverse, $left, $right) = prepareForCompare ($left, $right);
       
   450     $reverse ? $right->xql_eq ($left, $ignoreCase)
       
   451 	     : $left->xql_eq ($right, $ignoreCase);
       
   452 }
       
   453 
       
   454 sub xql_ne
       
   455 {
       
   456     my ($left, $right, $ignoreCase) = @_;
       
   457     my $reverse;
       
   458     ($reverse, $left, $right) = prepareForCompare ($left, $right);
       
   459     $reverse ? $right->xql_ne ($left, $ignoreCase)
       
   460 	     : $left->xql_ne ($right, $ignoreCase);
       
   461 }
       
   462 
       
   463 sub xql_lt
       
   464 {
       
   465     my ($left, $right, $ignoreCase) = @_;
       
   466     my $reverse;
       
   467     ($reverse, $left, $right) = prepareForCompare ($left, $right);
       
   468     $reverse ? $right->xql_ge ($left, $ignoreCase)
       
   469 	     : $left->xql_lt ($right, $ignoreCase);
       
   470 }
       
   471 
       
   472 sub xql_le
       
   473 {
       
   474     my ($left, $right, $ignoreCase) = @_;
       
   475     my $reverse;
       
   476     ($reverse, $left, $right) = prepareForCompare ($left, $right);
       
   477     $reverse ? $right->xql_gt ($left, $ignoreCase)
       
   478 	     : $left->xql_le ($right, $ignoreCase);
       
   479 }
       
   480 
       
   481 sub xql_gt
       
   482 {
       
   483     my ($left, $right, $ignoreCase) = @_;
       
   484     my $reverse;
       
   485     ($reverse, $left, $right) = prepareForCompare ($left, $right);
       
   486     $reverse ? $right->xql_le ($left, $ignoreCase)
       
   487 	     : $left->xql_gt ($right, $ignoreCase);
       
   488 }
       
   489 
       
   490 sub xql_ge
       
   491 {
       
   492     my ($left, $right, $ignoreCase) = @_;
       
   493     my $reverse;
       
   494     ($reverse, $left, $right) = prepareForCompare ($left, $right);
       
   495     $reverse ? $right->xql_lt ($left, $ignoreCase)
       
   496 	     : $left->xql_ge ($right, $ignoreCase);
       
   497 }
       
   498 
       
   499 sub xql_ieq { xql_eq (@_, 1); }
       
   500 sub xql_ine { xql_ne (@_, 1); }
       
   501 sub xql_ilt { xql_lt (@_, 1); }
       
   502 sub xql_igt { xql_gt (@_, 1); }
       
   503 sub xql_ige { xql_ge (@_, 1); }
       
   504 sub xql_ile { xql_le (@_, 1); }
       
   505 
       
   506 sub tput
       
   507 {
       
   508     # Let me know if I need to add other systems for which 'tput' is not 
       
   509     # available.
       
   510     if ($^O =~ /Win|MacOS/)
       
   511     {
       
   512 	return undef;
       
   513     }
       
   514     else
       
   515     {
       
   516 	my $c = shift;
       
   517 
       
   518 	# tput is only available on Unix systems.
       
   519 	# Calling `tput ...` on Windows generates warning messages
       
   520 	# that can not be suppressed.
       
   521 	return `tput $c`;
       
   522     }
       
   523 }
       
   524 
       
   525 # Underline the query subexpression that fails (if tput exists)
       
   526 $ContextStart = tput ('smul') || ">>";	# smul: underline on
       
   527 $ContextEnd = tput ('rmul') || "<<";	# rmul: underline off
       
   528 # Used for making the significant keyword of a subexpression bold, e.g. "$and$"
       
   529 $BoldOn = tput ('bold') || "";
       
   530 $BoldOff = tput ('rmul') . tput ('smul') || "";
       
   531 # rmul reverts the string back to normal text, smul makes it underlined again, 
       
   532 # so the rest of the subexpresion will be underlined.
       
   533 
       
   534 sub setErrorContextDelimiters
       
   535 {
       
   536     ($ContextStart, $ContextEnd, $BoldOn, $BoldOff) = @_;
       
   537 }
       
   538 
       
   539 sub delim
       
   540 {
       
   541     my ($str, $node, $contextNode) = @_;
       
   542     if ($node == $contextNode)
       
   543     {
       
   544 	$str =~ s/\016([^\017]*)\017/$BoldOn$1$BoldOff/g;
       
   545 	"$ContextStart$str$ContextEnd";
       
   546     }
       
   547     else
       
   548     {
       
   549 	$str =~ s/\016([^\017]*)\017/$1/g;
       
   550 	$str;
       
   551     }
       
   552 }
       
   553 
       
   554 sub bold
       
   555 {
       
   556     my $x = shift;
       
   557     "\016$x\017";	# arbitrary ASCII codes
       
   558 }
       
   559 
       
   560 sub parseError
       
   561 {
       
   562     my ($msg) = @_;
       
   563     print STDERR $msg . "\n";
       
   564     croak $msg;
       
   565 }
       
   566 
       
   567 # Builtin XQL functions (may not appear after Bang "!")
       
   568 %Func = 
       
   569 (
       
   570  ancestor	=> \&XML::XQL::Func::ancestor,
       
   571  attribute	=> \&XML::XQL::Func::attribute,
       
   572  comment	=> \&XML::XQL::Func::comment,
       
   573  element	=> \&XML::XQL::Func::element,
       
   574  id		=> \&XML::XQL::Func::id,
       
   575  node		=> \&XML::XQL::Func::node,
       
   576  pi		=> \&XML::XQL::Func::pi,
       
   577  textNode	=> \&XML::XQL::Func::textNode,
       
   578  true		=> \&XML::XQL::Func::true,
       
   579  false		=> \&XML::XQL::Func::false,
       
   580 
       
   581 # NOTE: date() is added with:   use XML::XQL::Date;
       
   582 );
       
   583 
       
   584 # Builtin XQL methods (may appear after Bang "!")
       
   585 %Method = 
       
   586 (
       
   587  baseName	=> \&XML::XQL::Func::baseName,
       
   588  count		=> \&XML::XQL::Func::count,
       
   589  end		=> \&XML::XQL::Func::end,
       
   590  'index'	=> \&XML::XQL::Func::xql_index,
       
   591  namespace	=> \&XML::XQL::Func::namespace,
       
   592  nodeName	=> \&XML::XQL::Func::nodeName,
       
   593  nodeType	=> \&XML::XQL::Func::nodeType,
       
   594  nodeTypeString	=> \&XML::XQL::Func::nodeTypeString,
       
   595  prefix		=> \&XML::XQL::Func::prefix,
       
   596  text		=> \&XML::XQL::Func::text,
       
   597  rawText	=> \&XML::XQL::Func::rawText,
       
   598  value		=> \&XML::XQL::Func::value,
       
   599 );
       
   600 
       
   601 # Number of arguments for builtin XQL functions:
       
   602 # Value is either an integer or a range. Value is 0 if not specified.
       
   603 # Range syntax:
       
   604 #
       
   605 #  range ::= '[' start ',' end [ ',' start ',' end ]*  ']' 
       
   606 #  start ::= INTEGER
       
   607 #  end   ::= INTEGER | '-1'    ('-1' means: "or more")
       
   608 #
       
   609 # Example: [2, 4, 7, 7, 10, -1] means (2,3,4,7,10,11,...)
       
   610 
       
   611 %FuncArgCount =
       
   612 (
       
   613  ancestor	=> 1,
       
   614  attribute	=> [0,1],
       
   615  count		=> [0,1],
       
   616 # date		=> 1,
       
   617  element	=> [0,1],
       
   618  id		=> 1,
       
   619  text		=> [0,1],
       
   620  rawText	=> [0,1],
       
   621 );
       
   622 
       
   623 %AllowedOutsideSubquery = 
       
   624 (
       
   625  ancestor	=> 1,
       
   626  attribute	=> 1,
       
   627  comment	=> 1,
       
   628  element	=> 1,
       
   629  id		=> 1,
       
   630  node		=> 1,
       
   631  pi		=> 1,
       
   632  textNode	=> 1,
       
   633 
       
   634 #?? what about subst etc.
       
   635 );
       
   636 
       
   637 # Functions that always return the same thing if their arguments are constant
       
   638 %ConstFunc =
       
   639 (
       
   640  true		=> 1,
       
   641  false		=> 1,
       
   642 # date		=> 1,
       
   643 );
       
   644 
       
   645 %ExpandedType =
       
   646 (
       
   647  "boolean"	=> "XML::XQL::Boolean",
       
   648  "text"		=> "XML::XQL::Text",
       
   649  "number"	=> "XML::XQL::Number",
       
   650  "date"		=> "XML::XQL::Date",
       
   651  "node"		=> "XML::XQL::Node",
       
   652 );
       
   653 
       
   654 sub expandType
       
   655 {
       
   656     my ($type) = @_;
       
   657     # Expand "number" to "XML::XQL::Number" etc.
       
   658     my $expanded = $ExpandedType{"\L$type"};
       
   659     defined $expanded ? $expanded : $type;
       
   660 }
       
   661 
       
   662 sub defineExpandedTypes
       
   663 {
       
   664     my (%args) = @_;
       
   665     while (my ($key, $val) = each %args)
       
   666     {
       
   667 	# Convert keys to lowercase
       
   668 	$ExpandedType{"\L$key"} = $val;
       
   669     }
       
   670 }
       
   671 
       
   672 sub generateFunction
       
   673 {
       
   674     my ($name, $funcName, $returnType, $argCount, $allowedOutsideSubquery, 
       
   675 	$const, $queryArg) = @_;
       
   676     $argCount = 0 unless defined $argCount;
       
   677     $allowedOutsideSubquery = 1 unless defined $allowedOutsideSubquery;
       
   678     $const = 0 unless defined $const;
       
   679     $queryArg = 0 unless defined $queryArg;
       
   680 
       
   681     $returnType = expandType ($returnType);
       
   682     my $wrapperName = "xql_wrap_$name";
       
   683     $wrapperName =~ s/\W/_/g;		# replace colons etc.
       
   684 
       
   685     my $func;
       
   686     my $code = <<END_CODE;
       
   687 sub $wrapperName {
       
   688  my (\$context, \$list, \@arg) = \@_;
       
   689  for my \$i (0 .. \$#arg)
       
   690  {
       
   691   if (\$i == $queryArg)
       
   692   {
       
   693    \$arg[\$i] = XML::XQL::toList (\$arg[\$i]->solve (\$context, \$list));
       
   694   }
       
   695   else
       
   696   {
       
   697    \$arg[\$i] = XML::XQL::prepareRvalue (\$arg[\$i]->solve (\$context, \$list));
       
   698    return [] if XML::XQL::isEmptyList (\$arg[\$i]);
       
   699    \$arg[\$i] = \$arg[\$i]->xql_toString;
       
   700   }
       
   701  }
       
   702 END_CODE
       
   703 
       
   704     if (ref ($argCount) eq "ARRAY" && @$argCount == 2 && 
       
   705 	$argCount->[0] == $argCount->[1])
       
   706     {
       
   707         $argCount = $argCount->[0];
       
   708     }
       
   709 
       
   710     if ($queryArg != -1)
       
   711     {
       
   712 	$code .=<<END_CODE;
       
   713  my \@result = ();
       
   714  my \@qp = \@{\$arg[$queryArg]};
       
   715  for (my \$k = 0; \$k < \@qp; \$k++)
       
   716  {
       
   717   \$arg[$queryArg] = \$qp[\$k]->xql_toString;
       
   718 END_CODE
       
   719     }
       
   720 
       
   721     if (ref ($argCount) ne "ARRAY")
       
   722     {
       
   723         $code .= " my \$result = $funcName (";
       
   724 	for my $i (0 .. $argCount-1)
       
   725 	{
       
   726 	    $code .= ", " if $i;
       
   727 	    $code .= "\$arg[$i]";
       
   728 	}
       
   729 	$code .= ");\n";
       
   730     }
       
   731     elsif (@$argCount == 2)
       
   732     {
       
   733 	my ($start, $end) = ($argCount->[0], $argCount->[1]);
       
   734 	if ($end == -1)
       
   735 	{
       
   736             $code .= " my \$result = $funcName (";
       
   737 	    for my $i (0 .. ($start - 1))
       
   738 	    {
       
   739 		$code .= ", " if $i;
       
   740 		$code .= "\$arg[$i]";
       
   741 	    }
       
   742 	    $code .= ", \@arg[" . $start . " .. \$#arg]);\n";
       
   743 	}
       
   744 	else
       
   745 	{
       
   746 	    $code .= " my \$n = \@arg;\n my \$result;\n ";
       
   747 	    for my $j ($argCount->[0] .. $argCount->[1])
       
   748 	    {
       
   749 		$code .= " els" unless $j == $argCount->[0];
       
   750 		$code .= ($j == $argCount->[1] ? "e\n" : 
       
   751 			"if (\$n == $j)\n");
       
   752 		$code .= " {\n  \$result = $funcName (";
       
   753 		for my $i (0 .. $j-1)
       
   754 		{
       
   755 		    $code .= ", " if $i;
       
   756 		    $code .= "\$arg[$i]";
       
   757 		}
       
   758 		$code .= ");\n }\n";
       
   759 	    }
       
   760 	}
       
   761     }
       
   762     else	 #?? what now...
       
   763     {
       
   764 	$code .= " my \$result = $funcName (\@arg);\n";
       
   765     }
       
   766 
       
   767     if ($returnType eq "*")	# return result as is
       
   768     {
       
   769 	$code .= " \$result = [] unless defined \$result;\n";
       
   770     }
       
   771     else
       
   772     {
       
   773 	$code .= " \$result = defined \$result ? new $returnType (\$result) : [];\n";
       
   774     }
       
   775 
       
   776     if ($queryArg == -1)
       
   777     {
       
   778 	$code .= " \$result;\n}\n";
       
   779     }
       
   780     else
       
   781     {
       
   782         $code .= "  push \@result, \$result;\n }\n \\\@result;\n}\n";
       
   783     }
       
   784     $code .= "\$func = \\\&$wrapperName;";
       
   785 
       
   786 #print "CODE=$code\n";
       
   787 
       
   788     eval "$code";
       
   789     if ($@) { croak "generateFunction failed for $funcName: $@\n"; }
       
   790 
       
   791     defineFunction ($name, $func, $argCount, 
       
   792 		    $allowedOutsideSubquery, $const);
       
   793 }
       
   794 
       
   795 sub defineFunction
       
   796 {
       
   797     my ($name, $func, $argCount, $allowedOutside, $const) = @_;
       
   798     $Func{$name} = $func;
       
   799     $FuncArgCount{$name} = $argCount;
       
   800     $AllowedOutsideSubquery{$name} = 1 if $allowedOutside;
       
   801     $ConstFunc{$name} = $const;
       
   802 }
       
   803 
       
   804 sub defineMethod
       
   805 {
       
   806     my ($name, $func, $argCount, $allowedOutside) = @_;
       
   807     $Method{$name} = $func;
       
   808     $FuncArgCount{$name} = $argCount;
       
   809     $AllowedOutsideSubquery{$name} = 1 if $allowedOutside;
       
   810 }
       
   811 
       
   812 %CompareOper =
       
   813 (
       
   814  'eq' => \&XML::XQL::xql_eq,
       
   815  'ne' => \&XML::XQL::xql_ne,
       
   816  'le' => \&XML::XQL::xql_le,
       
   817  'ge' => \&XML::XQL::xql_ge,
       
   818  'gt' => \&XML::XQL::xql_gt,
       
   819  'lt' => \&XML::XQL::xql_lt,
       
   820 
       
   821  'ieq' => \&XML::XQL::xql_ieq,
       
   822  'ine' => \&XML::XQL::xql_ine,
       
   823  'ile' => \&XML::XQL::xql_ile,
       
   824  'ige' => \&XML::XQL::xql_ige,
       
   825  'igt' => \&XML::XQL::xql_igt,
       
   826  'ilt' => \&XML::XQL::xql_ilt,
       
   827 
       
   828  '='  => \&XML::XQL::xql_eq,
       
   829  '!=' => \&XML::XQL::xql_ne,
       
   830  '>'  => \&XML::XQL::xql_gt,
       
   831  '>=' => \&XML::XQL::xql_ge,
       
   832  '<'  => \&XML::XQL::xql_lt,
       
   833  '<=' => \&XML::XQL::xql_le,
       
   834 );
       
   835 
       
   836 sub defineComparisonOperators
       
   837 {
       
   838     my (%args) = @_;
       
   839     %CompareOper = (%CompareOper, %args);
       
   840 }
       
   841 
       
   842 sub defineTokenQ
       
   843 {
       
   844     $Token_q = $_[0];
       
   845 }
       
   846 
       
   847 sub defineTokenQQ
       
   848 {
       
   849     $Token_qq = $_[0];
       
   850 }
       
   851 
       
   852 my %ElementValueType = ();
       
   853 my $ElementValueTypeCount = 0;
       
   854 
       
   855 sub elementValue
       
   856 {
       
   857     my ($elem) = @_;
       
   858 
       
   859 #?? raw text/recursive ?
       
   860 
       
   861     return new XML::XQL::Text ($elem->xql_text, $elem) 
       
   862 	if $ElementValueTypeCount == 0;   # user hasn't defined any types
       
   863 
       
   864     my $tagName = $elem->xql_nodeName;
       
   865     my $func = $ElementValueType{$tagName};
       
   866     return new XML::XQL::Text ($elem->xql_text, $elem) unless defined $func;
       
   867 
       
   868     &$func ($elem, $tagName); 
       
   869 }
       
   870 
       
   871 sub defineElementValueConvertor
       
   872 {
       
   873     my ($elemTagName, $func) = @_;
       
   874     my $prev = defined $ElementValueType{$elemTagName};
       
   875     $ElementValueType{$elemTagName} = $func;
       
   876     if (defined $func != $prev)
       
   877     {
       
   878 	defined $func ? $ElementValueTypeCount++ : $ElementValueTypeCount--;
       
   879     }
       
   880 }
       
   881 
       
   882 my %AttrValueType = ();
       
   883 my $AttrValueTypeCount = 0;
       
   884 
       
   885 sub attrValue
       
   886 {
       
   887     my ($attr) = @_;
       
   888 
       
   889 #?? raw text/recursive ?
       
   890     return new XML::XQL::Text ($attr->xql_text, $attr) 
       
   891 	if $AttrValueTypeCount == 0;    # user hasn't defined any types
       
   892 
       
   893     my $elem = $attr->xql_parent->xql_nodeName;    
       
   894     my $attrName = $attr->xql_nodeName;
       
   895     my $func = $AttrValueType{"$elem $attrName"};
       
   896     
       
   897     if (not defined $func)
       
   898     {
       
   899 	$elem = "*";
       
   900 	$func = $AttrValueType{"$elem $attrName"};
       
   901     }
       
   902     return new XML::XQL::Text ($attr->xql_text, $attr) unless defined $func;
       
   903 
       
   904     &$func ($attr, $attrName, $elem);
       
   905 }
       
   906 
       
   907 sub defineAttrValueConvertor
       
   908 {
       
   909     my ($elemTagName, $attrName, $type) = @_;
       
   910     my $both = "$elemTagName $attrName";
       
   911 
       
   912     my $prev = defined $AttrValueType{$both};
       
   913     $AttrValueType{$both} = $type;
       
   914     if (defined $type != $prev)
       
   915     {
       
   916 	defined $type ? $AttrValueTypeCount++ : $AttrValueTypeCount--;
       
   917     }
       
   918 }
       
   919 
       
   920 #=== debug
       
   921 
       
   922 sub exception
       
   923 {
       
   924     my ($ex) = @_;
       
   925     print "Exception: $ex\n" if $ex;
       
   926     $ex;
       
   927 }
       
   928 
       
   929 sub d
       
   930 {
       
   931     my $n = shift;
       
   932     my $type = ref $n;
       
   933 
       
   934     if ($type eq "ARRAY")
       
   935     {
       
   936 	my $str = "";
       
   937 	for my $i (@$n)
       
   938 	{
       
   939 	    $str .= ", " unless $str eq "";
       
   940 	    $str .= d ($i);
       
   941 	}
       
   942 	return "[$str]";
       
   943     }
       
   944     elsif ($type eq "HASH")
       
   945     {
       
   946 	my $str = "";
       
   947 	while (my ($key, $val) = %$n)
       
   948 	{
       
   949 	    $str .= ", " unless $str eq "";
       
   950 	    $str .= $key . " => " . d ($val);    
       
   951 	}
       
   952 	return "{$str}";
       
   953     }
       
   954     elsif ($type)
       
   955     {
       
   956 	return $n->xql_contextString if ($n->isa ('XML::XQL::Operator'));
       
   957 	return "${type}\[" . $n->xql_toString . "]" if $n->isa ('XML::XQL::PrimitiveType');
       
   958 #	return "${type}\[" . $n->toString . "]" if $n->isa ('XML::DOM::Element');
       
   959     }
       
   960     $n;
       
   961 }
       
   962 
       
   963 
       
   964 package XML::XQL::Query;
       
   965 
       
   966 use Carp;
       
   967 use XML::XQL::Parser;
       
   968 
       
   969 use vars qw( %Func %FuncArgCount );
       
   970 
       
   971 my $parser = new XML::XQL::Parser;
       
   972 
       
   973 # This is passed as 'yyerror' to YYParse
       
   974 sub Error 
       
   975 {
       
   976     my($parser) = shift;
       
   977 
       
   978     print STDERR "Error in Query Expression near: " . $parser->YYData->{INPUT} . "\n";
       
   979 }
       
   980 
       
   981 sub defineFunction
       
   982 {
       
   983     my ($self, $name, $func, $argCount, $allowedOutside, $const) = @_;
       
   984     $self->{Func}->{$name} = $func;
       
   985     $self->{FuncArgCount}->{$name} = $argCount;
       
   986     $self->{AllowedOutsideSubquery}->{$name} = 1 if $allowedOutside;
       
   987     $self->{ConstFunc} = $const;
       
   988 }
       
   989 
       
   990 sub defineMethod
       
   991 {
       
   992     my ($self, $name, $func, $argCount, $allowedOutside) = @_;
       
   993     $self->{Method}->{$name} = $func;
       
   994     $self->{FuncArgCount}->{$name} = $argCount;
       
   995     $self->{AllowedOutsideSubquery}->{$name} = 1 if $allowedOutside;
       
   996 }
       
   997 
       
   998 sub defineComparisonOperators
       
   999 {
       
  1000     my ($self, %args) = @_;
       
  1001     $self->{CompareOper} = \%args;
       
  1002 }
       
  1003 
       
  1004 sub defineTokenQ
       
  1005 {
       
  1006     $_[0]->{'q'} = $_[1];
       
  1007 }
       
  1008 
       
  1009 sub defineTokenQQ
       
  1010 {
       
  1011     $_[0]->{'qq'} = $_[1];
       
  1012 }
       
  1013 
       
  1014 sub new
       
  1015 {
       
  1016     my ($class, %args) = @_;
       
  1017 
       
  1018     croak "no Expr specified" unless defined $args{Expr};
       
  1019 
       
  1020     my $self = bless \%args, $class;
       
  1021 
       
  1022     my $error = $self->{'Error'} || \&XML::XQL::Query::Error;
       
  1023     my $debug = defined ($self->{Debug}) ? $self->{Debug} : 0;   # 0x17;
       
  1024 
       
  1025     $self->{'q'} = $XML::XQL::Token_q unless exists $self->{'q'};
       
  1026     $self->{'qq'} = $XML::XQL::Token_qq unless exists $self->{'qq'};
       
  1027 
       
  1028     # Invoke the query expression parser
       
  1029     $parser->YYData->{INPUT} = $self->{Expr};
       
  1030     $parser->{Query} = $self;
       
  1031     $self->{Tree} = $parser->YYParse (yylex => \&XML::XQL::Lexer,
       
  1032 				      yyerror => $error, 
       
  1033 				      yydebug => $debug);
       
  1034 
       
  1035     # Nothing but whitespace should be left over
       
  1036     if ($parser->YYData->{INPUT} !~ /^\s*$/)
       
  1037     {
       
  1038 	XML::XQL::parseError ("Error when parsing expression. Unexpected characters at end of expression [" . $parser->YYData->{INPUT} . "]")
       
  1039     }
       
  1040 
       
  1041     XML::XQL::parseError ("Error when parsing expression")
       
  1042 	unless defined $self->{Tree};
       
  1043 
       
  1044     $self->{Tree}->{Query} = $self;
       
  1045     $self->{Tree}->xql_check (0, 0);	# inSubQuery=0, inParam=0
       
  1046 
       
  1047     print "Expression parsed successfully\n" if $debug;
       
  1048 
       
  1049     $self;
       
  1050 }
       
  1051 
       
  1052 sub dispose
       
  1053 {
       
  1054     my $self = shift;
       
  1055 
       
  1056     undef $self->{Tree}->{Query};
       
  1057 
       
  1058     $self->{Tree}->dispose;
       
  1059     delete $self->{Tree};
       
  1060 }
       
  1061 
       
  1062 sub isNodeQuery
       
  1063 {
       
  1064     $_[0]->{NodeQuery};
       
  1065 }
       
  1066 
       
  1067 sub solve
       
  1068 {
       
  1069     my ($self, @list) = @_;
       
  1070     my $context = undef;
       
  1071 
       
  1072     # clear cached "once" values
       
  1073     $self->{Tree}->xql_prepCache;
       
  1074     my $result = $self->{Tree}->solve ($context, \@list);
       
  1075     ref ($result) eq "ARRAY" ? @$result : ($result);
       
  1076 }
       
  1077 
       
  1078 sub toString
       
  1079 {
       
  1080     $_[0]->{Expr};
       
  1081 }
       
  1082 
       
  1083 sub toDOM
       
  1084 {
       
  1085     my ($self, $doc) = @_;
       
  1086     my $root = $doc->createElement ("XQL");
       
  1087     $doc->appendChild ($root);
       
  1088     $root->appendChild ($self->{Tree}->xql_toDOM ($doc));
       
  1089     $doc;
       
  1090 }
       
  1091 
       
  1092 sub findComparisonOperator
       
  1093 {
       
  1094     my ($self, $name) = @_;
       
  1095     my $cmp;
       
  1096     if (exists $self->{CompareOper}->{$name})
       
  1097     {
       
  1098 	$cmp = $self->{CompareOper}->{$name};
       
  1099     }
       
  1100     else
       
  1101     {
       
  1102 	$cmp = $XML::XQL::CompareOper{$name};
       
  1103     }
       
  1104     if (not defined $cmp)
       
  1105     {
       
  1106         XML::XQL::parseError ("undefined comparison operator '$name'");
       
  1107     }
       
  1108     $cmp;
       
  1109 }
       
  1110 
       
  1111 # Return function pointer. Croak if wrong number of arguments.
       
  1112 sub findFunctionOrMethod
       
  1113 {
       
  1114     my ($self, $name, $args) = @_;
       
  1115 
       
  1116     my $func;
       
  1117     my $type = "function";
       
  1118     if (exists $self->{Func}->{$name})
       
  1119     {
       
  1120 	$func = $self->{Func}->{$name};
       
  1121     }
       
  1122     elsif (exists $self->{Method}->{$name})
       
  1123     {
       
  1124 	$func = $self->{Method}->{$name};
       
  1125 	$type = "method";
       
  1126     }
       
  1127     elsif (defined $XML::XQL::Func{$name})
       
  1128     {
       
  1129 	$func = $XML::XQL::Func{$name};
       
  1130     }
       
  1131     elsif (defined $XML::XQL::Method{$name})
       
  1132     {
       
  1133 	$func = $XML::XQL::Method{$name};
       
  1134 	$type = "method";
       
  1135     }
       
  1136     elsif (not $XML::XQL::Restricted)
       
  1137     {
       
  1138         $func = XML::XQL::generatePerlWrapper ($name);
       
  1139     }
       
  1140 
       
  1141     XML::XQL::parseError ("undefined function/method '$name' in query '" . 
       
  1142 		$self->toString . "'")
       
  1143         unless defined &$func;
       
  1144 
       
  1145     my $funcArgCount = $self->{FuncArgCount}->{$name} 
       
  1146 			|| $XML::XQL::FuncArgCount{$name} || 0;
       
  1147 
       
  1148     # Check number of args
       
  1149     my $nargs = @$args;
       
  1150 
       
  1151 #print "$args " . XML::XQL::d($args) . "\n";
       
  1152 
       
  1153     my $ok = 0;
       
  1154     if (ref ($funcArgCount) eq "ARRAY")
       
  1155     {
       
  1156 	my $i = 0;
       
  1157 	my $n = @$funcArgCount;
       
  1158 	while ($i < $n)
       
  1159 	{
       
  1160 	    my $s = $funcArgCount->[$i++];
       
  1161 	    my $e = $funcArgCount->[$i++] || $s;	# same as $s if odd #args
       
  1162 	    if ($nargs >= $s && ($e == -1 || $nargs <= $e))
       
  1163 	    {
       
  1164 		$ok = 1;	# found it
       
  1165 		last;
       
  1166 	    }
       
  1167 	}
       
  1168     }
       
  1169     else
       
  1170     {
       
  1171 	$ok = ($nargs eq $funcArgCount);
       
  1172     }
       
  1173 
       
  1174     XML::XQL::parseError ("wrong number of args ($nargs) for $type $name in query '" .
       
  1175 	    $self->toString . "', it should be " . XML::XQL::d($funcArgCount))
       
  1176 	if not $ok;
       
  1177 
       
  1178     return ($func, $type);
       
  1179 }
       
  1180 
       
  1181 sub isAllowedOutsideSubquery
       
  1182 {
       
  1183     my ($self, $funcName) = @_;
       
  1184     my ($ok) = $self->{AllowedOutsideSubquery}->{$funcName};
       
  1185     return $ok if defined $ok;
       
  1186     $XML::XQL::AllowedOutsideSubquery{$funcName};
       
  1187 }
       
  1188 
       
  1189 package XML::XQL::Operator;
       
  1190 use fields qw{ Left Right Parent };
       
  1191 
       
  1192 sub new
       
  1193 {
       
  1194     my ($class, %attr) = @_;
       
  1195     my $self = bless \%attr, $class;
       
  1196 
       
  1197     $self->{Left}->setParent ($self) if defined $self->{Left};
       
  1198     $self->{Right}->setParent ($self) if defined $self->{Right};
       
  1199 
       
  1200     $self;
       
  1201 }
       
  1202 
       
  1203 sub dispose
       
  1204 {
       
  1205     my $self = shift;
       
  1206     if (defined ($self->{Left}))
       
  1207     {
       
  1208 	$self->{Left}->dispose;
       
  1209 	undef $self->{Left};
       
  1210     }
       
  1211     if (defined ($self->{Right}))
       
  1212     {
       
  1213 	$self->{Right}->dispose;
       
  1214 	undef $self->{Right};
       
  1215     }
       
  1216 
       
  1217     undef $self->{Parent};
       
  1218 }
       
  1219 
       
  1220 sub xql_check
       
  1221 {
       
  1222     my ($self, $inSubQuery, $inParam) = @_;
       
  1223     $self->{Left}->xql_check ($inSubQuery, $inParam);
       
  1224     $self->{Right}->xql_check ($inSubQuery, $inParam) if defined $self->{Right};
       
  1225 }
       
  1226 
       
  1227 sub xql_prepCache
       
  1228 {
       
  1229     my ($self) = @_;
       
  1230     $self->{Left}->xql_prepCache;
       
  1231     $self->{Right}->xql_prepCache if defined $self->{Right};
       
  1232 }
       
  1233 
       
  1234 sub xql_toDOM
       
  1235 {
       
  1236     my ($self, $doc) = @_;
       
  1237     my $name = ref $self;
       
  1238     $name =~ s/.*:://;
       
  1239     my $elem = $doc->createElement ($name);
       
  1240     if (defined $self->{Left})
       
  1241     {
       
  1242 	my $left = $doc->createElement ("left");
       
  1243 	$elem->appendChild ($left);
       
  1244 	$left->appendChild ($self->{Left}->xql_toDOM ($doc));
       
  1245     }
       
  1246     if (defined $self->{Right})
       
  1247     {
       
  1248 	my $right = $doc->createElement ("right");
       
  1249 	$elem->appendChild ($right);
       
  1250 	$right->appendChild ($self->{Right}->xql_toDOM ($doc));
       
  1251     }
       
  1252     $elem;
       
  1253 }
       
  1254 
       
  1255 sub isConstant
       
  1256 {
       
  1257     0;
       
  1258 }
       
  1259 
       
  1260 # Overriden by Union and Path operators
       
  1261 sub mustSort
       
  1262 {
       
  1263     0;
       
  1264 }
       
  1265 
       
  1266 sub setParent
       
  1267 {
       
  1268     $_[0]->{Parent} = $_[1];
       
  1269 }
       
  1270 
       
  1271 sub warning
       
  1272 {
       
  1273     my ($self, $msg) = @_;
       
  1274     print STDERR "WARNING: $msg";
       
  1275     print STDERR "         Context: " . $self->toContextString . "\n";
       
  1276 }
       
  1277 
       
  1278 sub root
       
  1279 {
       
  1280     my ($self) = @_;
       
  1281     my $top = $self;
       
  1282 
       
  1283     while (defined ($top->{Parent}))
       
  1284     {
       
  1285 	$top = $top->{Parent};
       
  1286     }
       
  1287     $top;
       
  1288 }
       
  1289 
       
  1290 sub query
       
  1291 {
       
  1292     $_[0]->root->{Query};
       
  1293 }
       
  1294 
       
  1295 sub toContextString
       
  1296 {
       
  1297     my ($self) = @_;
       
  1298     $self->root->xql_contextString ($self);
       
  1299 }
       
  1300 
       
  1301 sub debugString
       
  1302 {
       
  1303     my ($self) = @_;
       
  1304     my $str = "[" . ref($self);
       
  1305     while (my ($key, $val) = each %$self)
       
  1306     {
       
  1307 	$str .= "$key=>" . XML::XQL::d($val);
       
  1308     }
       
  1309     $str . "]";
       
  1310 }
       
  1311 
       
  1312 sub verbose
       
  1313 {
       
  1314     my ($self, $str, $list) = @_;
       
  1315 #    print STDERR "$self - $str: " . XML::XQL::d($list) . "\n";
       
  1316     $list;
       
  1317 }
       
  1318 
       
  1319 package XML::XQL::Root;		# "/" at start of XQL expression
       
  1320 use base 'XML::XQL::Operator';	# L -> L
       
  1321 
       
  1322 sub solve
       
  1323 {
       
  1324     my ($self, $context, $list) = @_;
       
  1325     return [] if (@$list < 1);
       
  1326 
       
  1327 #?? what if first value is not a XML::XQL::Node? should we try the second one?
       
  1328     [$list->[0]->xql_document];
       
  1329 }
       
  1330 #?? add isOnce here?
       
  1331 
       
  1332 sub xql_check
       
  1333 {
       
  1334 }
       
  1335 
       
  1336 sub xql_prepCache
       
  1337 {
       
  1338 }
       
  1339 
       
  1340 sub xql_contextString
       
  1341 {
       
  1342     XML::XQL::delim ("/", @_);
       
  1343 }
       
  1344 
       
  1345 package XML::XQL::Path;
       
  1346 use base 'XML::XQL::Operator';	# L -> L
       
  1347 use fields qw{ PathOp };
       
  1348 
       
  1349 sub new
       
  1350 {
       
  1351     my ($class, %arg) = @_;
       
  1352     my $self = bless \%arg, $class;
       
  1353 
       
  1354     $self->{Left} ||= new XML::XQL::Root;
       
  1355 
       
  1356     $self->{Left}->setParent ($self);
       
  1357     $self->{Right}->setParent ($self);
       
  1358 
       
  1359     $self;
       
  1360 }
       
  1361 
       
  1362 sub solve
       
  1363 {
       
  1364     my ($self, $context, $list) = @_;
       
  1365     $list = $self->{Left}->solve ($context, $list);
       
  1366     $self->verbose ("left", $list);
       
  1367 
       
  1368     return $list if @$list < 1;
       
  1369 
       
  1370     if ($self->{PathOp} eq '/') 
       
  1371     {
       
  1372 	$self->verbose ("result", $self->{Right}->solve ($context, $list));
       
  1373     }
       
  1374     else	# recurse "//"
       
  1375     {
       
  1376 	my $new_list = [];
       
  1377 	my $n = @$list;
       
  1378         NODE: for (my $i = 0; $i < $n; $i++)
       
  1379 	{
       
  1380 	    my $node = $list->[$i];
       
  1381 	    # Node must be an Element or must be allowed to contain Elements
       
  1382 	    # i.e. must be an Element or a Document 
       
  1383 	    # (DocumentFragment is not expected here)
       
  1384 	    my $nodeType = $node->xql_nodeType;
       
  1385 	    next NODE unless ($nodeType == 1 || $nodeType == 9);
       
  1386 	    
       
  1387 	    # Skip the node if one of its ancestors is part of the input $list
       
  1388 	    # (and therefore already processed)
       
  1389 	    my $parent = $node->xql_parent;
       
  1390 	    while (defined $parent)
       
  1391 	    {
       
  1392 		for (my $j = $i - 1; $j >= 0; $j--)
       
  1393 		{
       
  1394 		    next NODE if ($parent == $list->[$j]);
       
  1395 		}
       
  1396 		$parent = $parent->xql_parent;
       
  1397 	    }
       
  1398 	    recurse ($node, $new_list);
       
  1399 	}
       
  1400 	
       
  1401 	my $results = $self->{Right}->solve ($context, $new_list);
       
  1402 
       
  1403 	# Sort the result list unless the parent Operator will sort
       
  1404 	my $parent = $self->{Parent};
       
  1405 	XML::XQL::sortDocOrder ($results) 
       
  1406 		unless defined ($parent) and $parent->mustSort;
       
  1407 
       
  1408 	$self->verbose ("result //", $results);
       
  1409     }
       
  1410 }
       
  1411 
       
  1412 sub mustSort
       
  1413 {
       
  1414     $_[0]->{PathOp} eq '//'; 
       
  1415 }
       
  1416 
       
  1417 sub recurse
       
  1418 {
       
  1419     my ($node, $list) = @_;
       
  1420     push @$list, $node;
       
  1421     for my $kid (@{$node->xql_element})
       
  1422     {
       
  1423 	recurse ($kid, $list);
       
  1424     }
       
  1425 }
       
  1426 
       
  1427 sub xql_contextString
       
  1428 {
       
  1429     my $self = shift;
       
  1430 
       
  1431     my $str = $self->{Left}->isa ('XML::XQL::Root') ? 
       
  1432 	"" : $self->{Left}->xql_contextString (@_);
       
  1433 
       
  1434     XML::XQL::delim ($str . XML::XQL::bold($self->{PathOp}) . 
       
  1435 		     $self->{Right}->xql_contextString (@_), $self, @_);
       
  1436 }
       
  1437 
       
  1438 sub xql_toDOM
       
  1439 {
       
  1440     my ($self, $doc) = @_;
       
  1441     my $elem = $self->SUPER::xql_toDOM ($doc);
       
  1442     $elem->setAttribute ("pathOp", $self->{PathOp});
       
  1443     $elem;
       
  1444 }
       
  1445 
       
  1446 package XML::XQL::Sequence;		# "elem;elem" or "elem;;elem"
       
  1447 use base 'XML::XQL::Operator';	# L -> L
       
  1448 use fields qw{ Oper };
       
  1449 
       
  1450 # See "The Design of XQL" by Jonathan Robie
       
  1451 # <URL:http://www.texcel.no/whitepapers/xql-design.html>
       
  1452 # for definition of Sequence operators.
       
  1453 
       
  1454 # Note that the "naive" implementation slows things down quite a bit here...
       
  1455 sub solve
       
  1456 {
       
  1457     my ($self, $context, $list) = @_;
       
  1458     my $left = $self->{Left}->solve ($context, $list);
       
  1459     $self->verbose ("left", $left);
       
  1460     return [] unless @$left;
       
  1461 
       
  1462     my $right = $self->{Right}->solve ($context, $list);
       
  1463     $self->verbose ("right", $right);
       
  1464     return [] unless @$right;
       
  1465 
       
  1466     my @result;
       
  1467     if ($self->{Oper} eq ';')	# immediately precedes
       
  1468     {
       
  1469 	my %hleft; @hleft{@$left} = ();	# initialize all values to undef
       
  1470 	my %pushed;
       
  1471 
       
  1472 	for my $r (@$right)
       
  1473 	{
       
  1474 	    # Find previous sibling that is not a text node that has only 
       
  1475 	    # whitespace that can be ignored (because xml:space=preserve)
       
  1476 	    my $prev = $r->xql_prevNonWS;
       
  1477 	    # $prev must be defined and must exist in $left
       
  1478 	    next unless $prev and exists $hleft{$prev};
       
  1479 
       
  1480 	    # Filter duplicates (no need to sort afterwards)
       
  1481 	    push @result, $prev unless $pushed{$prev}++;
       
  1482 	    push @result, $r unless $pushed{$r}++;
       
  1483 	}
       
  1484     }
       
  1485     else	# oper eq ';;' (i.e. precedes)
       
  1486     {
       
  1487 	my %pushed;
       
  1488 
       
  1489 	for my $r (@$right)
       
  1490 	{
       
  1491 	    for my $l (@$left)
       
  1492 	    {
       
  1493 		# If left node precedes right node, add them
       
  1494 		if ($l->xql_sortKey lt $r->xql_sortKey)
       
  1495 		{
       
  1496 		    # Filter duplicates
       
  1497 		    push @result, $l unless $pushed{$l}++;
       
  1498 		    push @result, $r unless $pushed{$r}++;
       
  1499 		}
       
  1500 	    }
       
  1501 
       
  1502 #?? optimize - left & right are already sorted...
       
  1503 	    # sort in document order
       
  1504 	    XML::XQL::sortDocOrder (\@result) if @result;
       
  1505 	}
       
  1506     }
       
  1507     \@result;
       
  1508 }
       
  1509 
       
  1510 sub xql_contextString
       
  1511 {
       
  1512     my $self = shift;
       
  1513     XML::XQL::delim ($self->{Left}->xql_contextString (@_) . 
       
  1514 		     XML::XQL::bold($self->{Oper}) . 
       
  1515 		     $self->{Right}->xql_contextString (@_), $self, @_);
       
  1516 }
       
  1517 
       
  1518 package XML::XQL::Current;		# "."
       
  1519 use base 'XML::XQL::Operator';	# L -> L
       
  1520 
       
  1521 sub xql_check
       
  1522 {
       
  1523 }
       
  1524 
       
  1525 sub xql_prepCache
       
  1526 {
       
  1527 }
       
  1528 
       
  1529 sub solve
       
  1530 {
       
  1531     my ($self, $context, $list) = @_;
       
  1532     $list;
       
  1533 }
       
  1534 
       
  1535 sub xql_contextString
       
  1536 {
       
  1537     XML::XQL::delim (".", @_);
       
  1538 }
       
  1539 
       
  1540 package XML::XQL::Parent;		# ".."
       
  1541 use base 'XML::XQL::Operator';
       
  1542 
       
  1543 sub xql_check
       
  1544 {
       
  1545 }
       
  1546 
       
  1547 sub xql_prepCache
       
  1548 {
       
  1549 }
       
  1550 
       
  1551 sub solve
       
  1552 {
       
  1553     my ($self, $context, $list) = @_;
       
  1554     my @result = ();
       
  1555     for my $node (@$list)
       
  1556     {
       
  1557 	push @result, $node->xql_parent;
       
  1558     }
       
  1559     \@result;
       
  1560 }
       
  1561 
       
  1562 sub xql_contextString
       
  1563 {
       
  1564     XML::XQL::delim ("..", @_);
       
  1565 }
       
  1566 
       
  1567 package XML::XQL::Element;		# "elem"
       
  1568 use base 'XML::XQL::Operator';		# L -> L
       
  1569 use fields qw{ Name NameSpace Expr };
       
  1570 
       
  1571 sub new
       
  1572 {
       
  1573     my ($class, %args) = @_;
       
  1574     if (not defined ($args{NameSpace}))
       
  1575     {
       
  1576 	if ($args{Name} eq "*")
       
  1577 	{
       
  1578 	    return bless \%args, 'XML::XQL::AllElements';
       
  1579 	}
       
  1580 	else
       
  1581 	{
       
  1582 	    return bless \%args, 'XML::XQL::SimpleElement';
       
  1583 	}
       
  1584     }
       
  1585 
       
  1586     $args{Expr} = XML::XQL::buildNameSpaceExpr ($args{NameSpace}, 
       
  1587 						$args{Name});
       
  1588     bless \%args, $class;
       
  1589 }
       
  1590 
       
  1591 sub xql_check
       
  1592 {
       
  1593 }
       
  1594 
       
  1595 sub xql_prepCache
       
  1596 {
       
  1597 }
       
  1598 
       
  1599 sub solve
       
  1600 {
       
  1601     my ($self, $context, $list) = @_;
       
  1602     my @result = ();
       
  1603 
       
  1604     my $expr = $self->{Expr};
       
  1605     for my $node (@$list)
       
  1606     {
       
  1607 	for my $kid (@{$node->xql_element})
       
  1608 	{
       
  1609 	    push @result, $kid if $kid->xql_nodeName =~ /$expr/;
       
  1610 	}
       
  1611     }
       
  1612     \@result;
       
  1613 }
       
  1614 
       
  1615 sub xql_contextString
       
  1616 {
       
  1617     my $self = shift;
       
  1618     my $name = $self->{Name};
       
  1619     my $space = $self->{NameSpace};
       
  1620 
       
  1621     my $str = defined($space) ? "$space:$name" : $name;
       
  1622 
       
  1623     XML::XQL::delim ($str, $self, @_);
       
  1624 }
       
  1625 
       
  1626 sub xql_toDOM
       
  1627 {
       
  1628     my ($self, $doc) = @_;
       
  1629     my $elem = $self->SUPER::xql_toDOM ($doc);
       
  1630 
       
  1631     my $name = $self->{Name};
       
  1632     my $space = $self->{NameSpace};
       
  1633     my $str = defined($space) ? "$space:$name" : $name;
       
  1634 
       
  1635     $elem->setAttribute ("name", $str);
       
  1636     $elem;
       
  1637 }
       
  1638 
       
  1639 package XML::XQL::SimpleElement;	# "elem"
       
  1640 use base 'XML::XQL::Element';		# L -> L
       
  1641 
       
  1642 sub solve
       
  1643 {
       
  1644     my ($self, $context, $list) = @_;
       
  1645     my @result = ();
       
  1646     my $name = $self->{Name};
       
  1647 
       
  1648     for my $node (@$list)
       
  1649     {
       
  1650 	push @result, @{ $node->xql_element ($name) };
       
  1651     }
       
  1652     \@result;
       
  1653 }
       
  1654 
       
  1655 package XML::XQL::AllElements;		# "*"
       
  1656 use base 'XML::XQL::Element';		# L -> L
       
  1657 
       
  1658 sub solve
       
  1659 {
       
  1660     my ($self, $context, $list) = @_;
       
  1661     my @result = ();
       
  1662 
       
  1663     for my $node (@$list)
       
  1664     {
       
  1665 	push @result, @{$node->xql_element};
       
  1666     }
       
  1667     \@result;
       
  1668 }
       
  1669 
       
  1670 package XML::XQL::Attribute;		# "@attr"
       
  1671 use base 'XML::XQL::Operator';		# L -> L of Attributes
       
  1672 use fields qw{ Name NameSpace Expr };
       
  1673 
       
  1674 sub new
       
  1675 {
       
  1676     my ($class, %args) = @_;
       
  1677 
       
  1678     if (not defined ($args{NameSpace}))
       
  1679     {
       
  1680 	if ($args{Name} eq "*")
       
  1681 	{
       
  1682 	    return bless \%args, 'XML::XQL::AllAttr';
       
  1683 	}
       
  1684 	else
       
  1685 	{
       
  1686 	    return bless \%args, 'XML::XQL::SimpleAttr';
       
  1687 	}
       
  1688     }
       
  1689 
       
  1690     $args{Expr} = XML::XQL::buildNameSpaceExpr ($args{NameSpace}, 
       
  1691 						$args{Name});
       
  1692     bless \%args, $class;
       
  1693 }
       
  1694 
       
  1695 sub xql_check
       
  1696 {
       
  1697 }
       
  1698 
       
  1699 sub xql_prepCache
       
  1700 {
       
  1701 }
       
  1702 
       
  1703 sub solve
       
  1704 {
       
  1705     my ($self, $context, $list) = @_;
       
  1706     my @result = ();
       
  1707 
       
  1708     my $expr = $self->{Expr};
       
  1709     for my $node (@$list)
       
  1710     {
       
  1711 	for my $kid (@{$node->xql_attribute})
       
  1712 	{
       
  1713 	    push @result, $kid if $kid->xql_nodeName =~ /$expr/;
       
  1714 	}
       
  1715     }
       
  1716 }
       
  1717 
       
  1718 sub xql_contextString
       
  1719 {
       
  1720     my $self = shift;
       
  1721     my $name = $self->{Name};
       
  1722     my $space = $self->{NameSpace};
       
  1723 
       
  1724     my $str = defined($space) ? "\@$space:$name" : ('@' . $name);
       
  1725 
       
  1726     XML::XQL::delim ($str, $self, @_);
       
  1727 }
       
  1728 
       
  1729 package XML::XQL::SimpleAttr;		# "@attr"
       
  1730 use base 'XML::XQL::Attribute';		# L -> L
       
  1731 
       
  1732 sub solve
       
  1733 {
       
  1734     my ($self, $context, $list) = @_;
       
  1735     my @result = ();
       
  1736     my $name = $self->{Name};
       
  1737 
       
  1738     for my $node (@$list)
       
  1739     {
       
  1740 	push @result, @{ $node->xql_attribute ($name) };
       
  1741     }
       
  1742     \@result;
       
  1743 }
       
  1744 
       
  1745 package XML::XQL::AllAttr;		# "@*"
       
  1746 use base 'XML::XQL::Attribute';		# L -> L
       
  1747 
       
  1748 sub solve
       
  1749 {
       
  1750     my ($self, $context, $list) = @_;
       
  1751     my @result = ();
       
  1752 
       
  1753     for my $node (@$list)
       
  1754     {
       
  1755 	push @result, @{$node->xql_attribute};
       
  1756     }
       
  1757     \@result;
       
  1758 }
       
  1759 
       
  1760 package XML::XQL::Subscript;		# "[3, 5 $to$ 7, -1]"
       
  1761 use base 'XML::XQL::Operator';		# L -> L
       
  1762 use fields qw{ IndexList };
       
  1763 
       
  1764 #?? optimize for simple subscripts
       
  1765 sub solve
       
  1766 {
       
  1767     my ($self, $context, $inlist) = @_;
       
  1768     my @result = ();
       
  1769 
       
  1770     for my $node (@$inlist)
       
  1771     {
       
  1772 
       
  1773 	my $list = $self->{Left}->solve ($context, [$node]);
       
  1774 	$self->verbose("Left", $list);
       
  1775 
       
  1776 	my $n = int (@$list);
       
  1777 	next if ($n == 0);
       
  1778 
       
  1779 	# build ordered index list
       
  1780 	my @indexFlags = ();
       
  1781 	$#indexFlags = $n - 1;
       
  1782 	
       
  1783 	my $index = $self->{IndexList};
       
  1784 	my $len = @$index;
       
  1785 
       
  1786 #?? this is done a lot - optimize....	
       
  1787 	my $i = 0;
       
  1788 	while ($i < $len)
       
  1789 	{
       
  1790 	    my $start = $index->[$i++];
       
  1791 	    $start += $n if ($start < 0);
       
  1792 	    my $end = $index->[$i++];
       
  1793 	    $end += $n if ($end < 0);
       
  1794 	    
       
  1795 	    next unless $start <= $end && $end >=0 && $start < $n;
       
  1796 	    $start = 0 if ($start < 0);
       
  1797 	    $end = $n-1 if ($end >= $n);
       
  1798 	    
       
  1799 	    for my $j ($start .. $end)
       
  1800 	    {
       
  1801 		$indexFlags[$j] = 1;
       
  1802 	    }
       
  1803 	}
       
  1804 	for $i (0 .. $n-1)
       
  1805 	{
       
  1806 	    push @result, $list->[$i] if $indexFlags[$i];
       
  1807 	}
       
  1808     }
       
  1809     \@result;
       
  1810 }
       
  1811 
       
  1812 sub xql_contextString
       
  1813 {
       
  1814     my $self = shift;
       
  1815 
       
  1816     my $index = $self->{IndexList};
       
  1817     my $str = XML::XQL::bold("[");
       
  1818     for (my $i = 0; $i < @$index; $i++)
       
  1819     {
       
  1820 	$str .= ", " if $i > 0;
       
  1821 
       
  1822 	my $s = $index->[$i++];
       
  1823 	my $e = $index->[$i];
       
  1824 	$str = ($s == $e) ? $s : "$s \$to\$ $e";
       
  1825     }
       
  1826     $str .= XML::XQL::bold("]");
       
  1827 
       
  1828     XML::XQL::delim ($self->{Left}->xql_contextString (@_) . $str, $self, @_);
       
  1829 }
       
  1830 
       
  1831 sub xql_toDOM
       
  1832 {
       
  1833     my ($self, $doc) = @_;
       
  1834     my $elem = $self->SUPER::xql_toDOM ($doc);
       
  1835 
       
  1836     my $index = $self->{IndexList};
       
  1837     my $str = "";
       
  1838     for (my $i = 0; $i < @$index; $i++)
       
  1839     {
       
  1840 	$str .= ", " if $i > 0;
       
  1841 
       
  1842 	my $s = $index->[$i++];
       
  1843 	my $e = $index->[$i];
       
  1844 	$str .= ($s == $e) ? $s : "$s \$to\$ $e";
       
  1845     }
       
  1846 
       
  1847     my $ie = $doc->createElement ("index");
       
  1848     $ie->setAttribute ("list", $str);
       
  1849     $elem->appendChild ($ie);
       
  1850     $elem;
       
  1851 }
       
  1852 
       
  1853 package XML::XQL::Union;		# "book $union$ magazine", also "|"
       
  1854 use base 'XML::XQL::Operator';		# L x L -> L
       
  1855 
       
  1856 sub solve
       
  1857 {
       
  1858     my ($self, $context, $list) = @_;
       
  1859     my $left = XML::XQL::toList ($self->{Left}->solve ($context, $list));
       
  1860     my $right = XML::XQL::toList ($self->{Right}->solve ($context, $list));
       
  1861 
       
  1862     return $right if (@$left < 1);
       
  1863     return $left if (@$right < 1);
       
  1864 
       
  1865     my @result = @$left;
       
  1866     for my $node (@$right)
       
  1867     {
       
  1868 	push @result, $node unless XML::XQL::listContains ($left, $node);
       
  1869     }
       
  1870 
       
  1871     my $parent = $self->{Parent};
       
  1872 
       
  1873     # Don't sort if parent is a Union or //, because the parent will do the sort
       
  1874     unless (defined $parent and $parent->mustSort)
       
  1875     {
       
  1876 	XML::XQL::sortDocOrder (\@result)
       
  1877     }
       
  1878 #    $self->verbose ("Union result", \@result);
       
  1879 
       
  1880     \@result;
       
  1881 }
       
  1882 
       
  1883 sub mustSort
       
  1884 {
       
  1885     1;
       
  1886 }
       
  1887 
       
  1888 sub xql_contextString
       
  1889 {
       
  1890     my $self = shift;
       
  1891     XML::XQL::delim ($self->{Left}->xql_contextString (@_) . 
       
  1892 		     XML::XQL::bold (" \$union\$ ") . 
       
  1893 		     $self->{Right}->xql_contextString (@_), $self, @_);
       
  1894 }
       
  1895 
       
  1896 package XML::XQL::Intersect;		# "book $intersect$ magazine"
       
  1897 use base 'XML::XQL::Operator';		# L x L -> L
       
  1898 
       
  1899 sub solve
       
  1900 {
       
  1901     my ($self, $context, $list) = @_;
       
  1902     my $left = XML::XQL::toList ($self->{Left}->solve ($context, $list));
       
  1903     return [] if @$left < 1;
       
  1904 
       
  1905     my $right = XML::XQL::toList ($self->{Right}->solve ($context, $list));
       
  1906     return [] if @$right < 1;
       
  1907 
       
  1908     # Assumption: $left and $right don't have duplicates themselves
       
  1909     my @result = ();
       
  1910     for my $node (@$left)
       
  1911     {
       
  1912 #? reimplement with hash - faster!
       
  1913 	push @result, $node if XML::XQL::listContains ($right, $node);
       
  1914     }
       
  1915     \@result;
       
  1916 }
       
  1917 
       
  1918 sub xql_contextString
       
  1919 {
       
  1920     my $self = shift;
       
  1921     XML::XQL::delim ($self->{Left}->xql_contextString (@_) . 
       
  1922 		     XML::XQL::bold (" \$intersect\$ ") . 
       
  1923 		     $self->{Right}->xql_contextString (@_), $self, @_);
       
  1924 }
       
  1925 
       
  1926 package XML::XQL::Filter;		# "elem[expr]"
       
  1927 use base 'XML::XQL::Operator';		# L -> L
       
  1928 
       
  1929 sub solve
       
  1930 {
       
  1931     my ($self, $context, $inlist) = @_;
       
  1932     my @result = ();
       
  1933 
       
  1934     for my $node (@$inlist)
       
  1935     {
       
  1936 
       
  1937 	my $list = $self->{Left}->solve ($context, [$node]);
       
  1938 	next if @$list == 0;
       
  1939 	
       
  1940 	my $subQuery = $self->{Right};
       
  1941 	
       
  1942 	$context = [0, scalar (@$list)];
       
  1943 	for my $node (@$list)
       
  1944 	{
       
  1945 #?? optimize? only need the first one to succeed
       
  1946 	    my $r = $subQuery->solve ($context, [ $node ]);
       
  1947 	    push @result, $node if XML::XQL::toBoolean ($r);
       
  1948 	    $context->[0]++;	# increase the index for the index() method
       
  1949 	}
       
  1950     }
       
  1951     \@result;
       
  1952 }
       
  1953 
       
  1954 sub xql_check
       
  1955 {
       
  1956     my ($self, $inSubQuery, $inParam) = @_;
       
  1957     $self->{Left}->xql_check ($inSubQuery, $inParam);
       
  1958     $self->{Right}->xql_check (1, $inParam);
       
  1959 }
       
  1960 
       
  1961 sub xql_contextString
       
  1962 {
       
  1963     my $self = shift;
       
  1964     XML::XQL::delim ($self->{Left}->xql_contextString (@_) . 
       
  1965 		     XML::XQL::bold ("[") . 
       
  1966 		     $self->{Right}->xql_contextString (@_) . 
       
  1967 		     XML::XQL::bold ("]"), $self, @_);
       
  1968 }
       
  1969 
       
  1970 package XML::XQL::BooleanOp;
       
  1971 use base 'XML::XQL::Operator';
       
  1972 
       
  1973 package XML::XQL::Or;
       
  1974 use base 'XML::XQL::BooleanOp';
       
  1975 
       
  1976 sub solve
       
  1977 {
       
  1978     my ($self, $context, $list) = @_;
       
  1979     my $left = $self->{Left}->solve ($context, $list);
       
  1980     return $XML::XQL::Boolean::TRUE if XML::XQL::toBoolean ($left);
       
  1981     return $self->{Right}->solve ($context, $list);
       
  1982 }
       
  1983 
       
  1984 sub xql_contextString
       
  1985 {
       
  1986     my $self = shift;
       
  1987     XML::XQL::delim ($self->{Left}->xql_contextString (@_) . 
       
  1988 		     XML::XQL::bold (" \$or\$ ") . 
       
  1989 	   $self->{Right}->xql_contextString (@_), $self, @_);
       
  1990 }
       
  1991 
       
  1992 package XML::XQL::And;
       
  1993 use base 'XML::XQL::BooleanOp';
       
  1994 
       
  1995 sub solve
       
  1996 {
       
  1997     my ($self, $context, $list) = @_;
       
  1998     my $left = $self->{Left}->solve ($context, $list);
       
  1999     return $XML::XQL::Boolean::FALSE unless XML::XQL::toBoolean ($left);
       
  2000     return $self->{Right}->solve ($context, $list);
       
  2001 }
       
  2002 
       
  2003 sub xql_contextString
       
  2004 {
       
  2005     my $self = shift;
       
  2006     XML::XQL::delim ($self->{Left}->xql_contextString (@_) . 
       
  2007 		     XML::XQL::bold (" \$and\$ ") . 
       
  2008 		     $self->{Right}->xql_contextString (@_), $self, @_);
       
  2009 }
       
  2010 
       
  2011 package XML::XQL::Not;
       
  2012 use base 'XML::XQL::BooleanOp';
       
  2013 
       
  2014 sub solve
       
  2015 {
       
  2016     my ($self, $context, $list) = @_;
       
  2017     my $left = $self->{Left}->solve ($context, $list);
       
  2018     return XML::XQL::toBoolean ($left) ? $XML::XQL::Boolean::FALSE : $XML::XQL::Boolean::TRUE;
       
  2019 }
       
  2020 
       
  2021 sub xql_contextString
       
  2022 {
       
  2023     my $self = shift;
       
  2024     XML::XQL::delim (XML::XQL::bold ("\$not\$ ") . 
       
  2025 		     $self->{Left}->xql_contextString (@_), $self, @_);
       
  2026 }
       
  2027 
       
  2028 package XML::XQL::Compare;
       
  2029 use base 'XML::XQL::Operator';
       
  2030 use fields qw{ Func All };
       
  2031 
       
  2032 use Carp;
       
  2033 
       
  2034 sub solve
       
  2035 {
       
  2036     my ($self, $context, $list) = @_;
       
  2037     
       
  2038     my $type;
       
  2039     my $cmpFunc = $self->{Func};
       
  2040 
       
  2041     my $left = $self->verbose ("left", XML::XQL::toList ($self->{Left}->solve ($context, $list)));
       
  2042     return [] if @$left < 1;
       
  2043 
       
  2044     my $right;
       
  2045     eval {
       
  2046 	$right = $self->verbose ("right", XML::XQL::prepareRvalue ($self->{Right}->solve ($context, $list)));
       
  2047     };
       
  2048     return [] if XML::XQL::exception ($@);
       
  2049 
       
  2050     if ($self->{All})
       
  2051     {
       
  2052 	for my $node (@$left)
       
  2053 	{
       
  2054 	    eval {
       
  2055 		# Stop if any of the comparisons fails
       
  2056 		return [] unless &$cmpFunc ($node, $right);
       
  2057 	    };
       
  2058 	    return [] if XML::XQL::exception ($@);
       
  2059 	}
       
  2060 	return $left;
       
  2061     }
       
  2062     else	# $any$ 
       
  2063     {
       
  2064         my @result = ();
       
  2065 	for my $node (@$left)
       
  2066 	{
       
  2067 	    eval {
       
  2068 		push (@result, $node)
       
  2069 		    if &$cmpFunc ($node, $right);
       
  2070 	    };
       
  2071 	    return [] if XML::XQL::exception ($@);
       
  2072 	}
       
  2073 	return \@result;
       
  2074     }
       
  2075 }
       
  2076 
       
  2077 sub xql_contextString
       
  2078 {
       
  2079     my $self = shift;
       
  2080     my $all = $self->{All} ? "\$all\$ " : "";
       
  2081 
       
  2082     XML::XQL::delim ($all . $self->{Left}->xql_contextString (@_) . " " . 
       
  2083 		     XML::XQL::bold ($self->{Oper}) . " " .
       
  2084 		     $self->{Right}->xql_contextString (@_), $self, @_);
       
  2085 }
       
  2086 
       
  2087 package XML::XQL::Func;
       
  2088 
       
  2089 use Carp;
       
  2090 
       
  2091 sub count
       
  2092 {
       
  2093     my ($context, $list, $expr) = @_;
       
  2094 
       
  2095     my $cnt;
       
  2096     if (defined $expr)
       
  2097     {
       
  2098 	$list = XML::XQL::toList ($expr->solve ($context, $list));
       
  2099 	$cnt = @$list;
       
  2100     }
       
  2101     else
       
  2102     {
       
  2103 	$cnt = $context->[1];
       
  2104     }
       
  2105 #?? ref node?
       
  2106     new XML::XQL::Number ($cnt);
       
  2107 }
       
  2108 
       
  2109 sub id
       
  2110 {
       
  2111     my ($context, $list, $query) = @_;
       
  2112 
       
  2113     return [] if @$list == 0;
       
  2114 
       
  2115     my $id = XML::XQL::prepareRvalue ($query->solve ($context, $list));
       
  2116 #?? check result?
       
  2117 
       
  2118 #?? if [0] is not a Node, I should probably try the next one
       
  2119     my $doc = $list->[0]->xql_document;
       
  2120     
       
  2121     _findId ($doc->xql_element->[0], $id);
       
  2122 }
       
  2123 
       
  2124 sub _findId # static method
       
  2125 {
       
  2126     my ($elem, $id) = @_;
       
  2127     my $attr = $elem->xql_attribute ("id");
       
  2128     return [$elem] if (@$attr == 1 && $attr->[0]->xql_nodeName eq $id);
       
  2129 
       
  2130     for my $kid (@{$elem->xql_element})
       
  2131     {
       
  2132 	$attr = _findId ($kid);
       
  2133 	return $attr if @$attr;
       
  2134     }
       
  2135     return [];
       
  2136 }
       
  2137 
       
  2138 sub end
       
  2139 {
       
  2140     my ($context, $list) = @_;
       
  2141 
       
  2142     return [] if @$list == 0;
       
  2143     new XML::XQL::Boolean ($context->[0] == $context->[1] - 1);
       
  2144 }
       
  2145 
       
  2146 sub xql_index
       
  2147 {
       
  2148     my ($context, $list) = @_;
       
  2149 
       
  2150 #    print "index: " . XML::XQL::d($context) . "\n";
       
  2151 #?? wrong!
       
  2152     return [] if @$list == 0;
       
  2153     new XML::XQL::Number ($context->[0]);
       
  2154 }
       
  2155 
       
  2156 sub ancestor
       
  2157 {
       
  2158     my ($context, $list, $query) = @_;
       
  2159 
       
  2160     return [] if @$list == 0;
       
  2161  
       
  2162     my @anc = ();
       
  2163 #?? fix for @$list > 1
       
  2164     my $parent = $list->[0]->xql_parent;
       
  2165 
       
  2166     while (defined $parent)
       
  2167     {
       
  2168 	# keep list of ancestors so far
       
  2169 	unshift @anc, $parent;
       
  2170 
       
  2171 	# solve the query for the ancestor
       
  2172 	my $result = $query->solve ($context, [$parent]);
       
  2173 	for my $node (@{$result})
       
  2174 	{
       
  2175 	    for my $anc (@anc)
       
  2176 	    {
       
  2177 		return [$node] if $node == $anc;
       
  2178 	    }
       
  2179 	}
       
  2180 	$parent = $parent->xql_parent;
       
  2181     }
       
  2182     return [];
       
  2183 }
       
  2184 
       
  2185 sub node
       
  2186 {
       
  2187     my ($context, $list) = @_;
       
  2188 
       
  2189     return [] if @$list == 0;
       
  2190     return $list->[0]->xql_node if @$list == 1;
       
  2191 
       
  2192     my @result;
       
  2193     for my $node (@$list)
       
  2194     {
       
  2195 	push @result, @{ $node->xql_node };
       
  2196     }
       
  2197     XML::XQL::sortDocOrder (\@result);
       
  2198 }
       
  2199 
       
  2200 sub _nodesByType
       
  2201 {
       
  2202     my ($list, $type) = @_;
       
  2203 
       
  2204     return [] if @$list == 0;
       
  2205 
       
  2206     my @result;
       
  2207     for my $node (@$list)
       
  2208     {
       
  2209 	for my $kid (@{ $node->xql_node })
       
  2210 	{
       
  2211 	    push @result, $kid if $kid->xql_nodeType == $type;
       
  2212 	}
       
  2213     }
       
  2214     @$list > 1 ? XML::XQL::sortDocOrder (\@result) : \@result;
       
  2215 }
       
  2216 
       
  2217 sub pi
       
  2218 {
       
  2219     my ($context, $list, $pi_name) = @_;
       
  2220     if (defined $pi_name)
       
  2221     {
       
  2222 	return [] if @$list == 0;
       
  2223 
       
  2224 	$pi_name = $pi_name->solve ($context, $list)->xql_toString;
       
  2225 
       
  2226 	my @result;
       
  2227 	for my $node (@$list)
       
  2228 	{
       
  2229 	    for my $kid (@{ $node->xql_node })
       
  2230 	    {
       
  2231 		push @result, $kid 
       
  2232 		    if $kid->xql_nodeType == 7 && $kid->getTarget eq $pi_name;
       
  2233 	    }
       
  2234 	}
       
  2235 	return @$list > 1 ? XML::XQL::sortDocOrder (\@result) : \@result;
       
  2236     }
       
  2237 
       
  2238     return _nodesByType ($_[1], 7);
       
  2239 }
       
  2240 
       
  2241 sub comment
       
  2242 {
       
  2243     _nodesByType ($_[1], 8);
       
  2244 }
       
  2245 
       
  2246 sub textNode
       
  2247 {
       
  2248     _nodesByType ($_[1], 3);
       
  2249 }
       
  2250 
       
  2251 sub nodeName
       
  2252 {
       
  2253     my ($context, $list) = @_;
       
  2254 
       
  2255     return [] if @$list == 0;
       
  2256 
       
  2257     my @result;
       
  2258     for my $node (@$list)
       
  2259     {
       
  2260 	push @result, new XML::XQL::Text ($node->xql_nodeName, $node);
       
  2261     }
       
  2262     \@result;
       
  2263 }
       
  2264 
       
  2265 sub namespace
       
  2266 {
       
  2267     my ($context, $list) = @_;
       
  2268 
       
  2269     return [] if @$list == 0;
       
  2270 
       
  2271     my @result;
       
  2272     for my $node (@$list)
       
  2273     {
       
  2274 	my $namespace = $node->xql_namespace;
       
  2275 	next unless defined $namespace;
       
  2276 	push @result, new XML::XQL::Text ($namespace, $node);
       
  2277     }
       
  2278     \@result;
       
  2279 }
       
  2280 
       
  2281 sub prefix
       
  2282 {
       
  2283     my ($context, $list) = @_;
       
  2284 
       
  2285     return [] if @$list == 0;
       
  2286 
       
  2287     my @result;
       
  2288     for my $node (@$list)
       
  2289     {
       
  2290 	my $prefix = $node->xql_prefix;
       
  2291 	next unless defined $prefix;
       
  2292 	push @result, new XML::XQL::Text ($prefix, $node);
       
  2293     }
       
  2294     \@result;
       
  2295 }
       
  2296 
       
  2297 sub baseName
       
  2298 {
       
  2299     my ($context, $list) = @_;
       
  2300 
       
  2301     return [] if @$list == 0;
       
  2302 
       
  2303     my @result;
       
  2304     for my $node (@$list)
       
  2305     {
       
  2306 	my $basename = $node->xql_baseName;
       
  2307 	next unless defined $basename;
       
  2308 	push @result, new XML::XQL::Text ($basename, $node);
       
  2309     }
       
  2310     \@result;
       
  2311 }
       
  2312 
       
  2313 sub nodeType
       
  2314 {
       
  2315     my ($context, $list) = @_;
       
  2316 
       
  2317     return [] if @$list == 0;
       
  2318 
       
  2319     my @result;
       
  2320     for my $node (@$list)
       
  2321     {
       
  2322 	push @result, new XML::XQL::Number ($node->xql_nodeType, $node);
       
  2323     }
       
  2324     \@result;
       
  2325 }
       
  2326 
       
  2327 sub nodeTypeString
       
  2328 {
       
  2329     my ($context, $list) = @_;
       
  2330 
       
  2331     return [] if @$list == 0;
       
  2332 
       
  2333     my @result;
       
  2334     for my $node (@$list)
       
  2335     {
       
  2336 	push @result, new XML::XQL::Text ($node->xql_nodeTypeString, $node);
       
  2337     } 
       
  2338     @result;
       
  2339 }
       
  2340 
       
  2341 sub value
       
  2342 {
       
  2343     my ($context, $list) = @_;
       
  2344 
       
  2345     return [] if @$list == 0;
       
  2346 
       
  2347     my @result;
       
  2348     for my $node (@$list)
       
  2349     {
       
  2350 	push @result, $node->xql_value;	# value always returns an object
       
  2351     }
       
  2352     \@result;
       
  2353 }
       
  2354 
       
  2355 sub text
       
  2356 {
       
  2357     my ($context, $list, $recurse) = @_;
       
  2358 
       
  2359     return [] if @$list == 0;
       
  2360 
       
  2361     if (defined $recurse)
       
  2362     {
       
  2363 	$recurse = $recurse->solve ($context, $list)->xql_toString;
       
  2364     }
       
  2365     else
       
  2366     {
       
  2367 	$recurse = 1;		# default
       
  2368     }
       
  2369 
       
  2370     my @result;
       
  2371     for my $node (@$list)
       
  2372     {
       
  2373 	my $text = $node->xql_text ($recurse);
       
  2374 	next unless defined $text;
       
  2375 	
       
  2376 	push @result, new XML::XQL::Text ($text, $node);
       
  2377     }
       
  2378     \@result;
       
  2379 }
       
  2380 
       
  2381 sub rawText
       
  2382 {
       
  2383     my ($context, $list, $recurse) = @_;
       
  2384 
       
  2385     return [] if @$list == 0;
       
  2386 
       
  2387     if (defined $recurse)
       
  2388     {
       
  2389 	$recurse = $recurse->solve ($context, $list)->xql_toString;
       
  2390     }
       
  2391     else
       
  2392     {
       
  2393 	$recurse = 1;		# default
       
  2394     }
       
  2395 
       
  2396     my @result;
       
  2397     for my $node (@$list)
       
  2398     {
       
  2399 	my $text = $node->xql_rawText ($recurse);
       
  2400 	next unless defined $text;
       
  2401 	
       
  2402 	push @result, new XML::XQL::Text ($text, $node);
       
  2403     }
       
  2404     \@result;
       
  2405 }
       
  2406 
       
  2407 sub true
       
  2408 {
       
  2409     return $XML::XQL::Boolean::TRUE;
       
  2410 }
       
  2411 
       
  2412 sub false
       
  2413 {
       
  2414     return $XML::XQL::Boolean::FALSE;
       
  2415 }
       
  2416 
       
  2417 #sub date() is in XQL::XML::Date
       
  2418 
       
  2419 sub element
       
  2420 {
       
  2421     my ($context, $list, $text) = @_;
       
  2422 
       
  2423     return [] if @$list == 0;
       
  2424 
       
  2425     my @result;
       
  2426     if (defined $text)
       
  2427     {
       
  2428 	$text = XML::XQL::prepareRvalue ($text->solve ($context, $list))->xql_toString;
       
  2429 	for my $node (@$list)
       
  2430 	{
       
  2431 	    push @result, @{$node->xql_element ($text)};
       
  2432 	}
       
  2433     }
       
  2434     else
       
  2435     {
       
  2436 	for my $node (@$list)
       
  2437 	{
       
  2438 	    push @result, @{$node->xql_element};
       
  2439 	}
       
  2440     }
       
  2441     @$list > 1 ? XML::XQL::sortDocOrder (\@result) : \@result;
       
  2442 }
       
  2443 
       
  2444 sub attribute
       
  2445 {
       
  2446     my ($context, $list, $text) = @_;
       
  2447 
       
  2448     return [] if @$list == 0;
       
  2449 
       
  2450     my @result;
       
  2451     if (defined $text)
       
  2452     {
       
  2453 	$text = XML::XQL::prepareRvalue ($text->solve ($context, $list))->xql_toString;
       
  2454 	for my $node (@$list)
       
  2455 	{
       
  2456 	    push @result, @{ $node->xql_attribute ($text) };
       
  2457 	}
       
  2458     }
       
  2459     else
       
  2460     {
       
  2461 	for my $node (@$list)
       
  2462 	{
       
  2463 	    push @result, @{ $node->xql_attribute };
       
  2464 	}
       
  2465     }
       
  2466     \@result;
       
  2467 }
       
  2468 
       
  2469 package XML::XQL::Bang;
       
  2470 use base 'XML::XQL::Operator';
       
  2471 
       
  2472 sub solve
       
  2473 {
       
  2474     my ($self, $context, $list) = @_;
       
  2475     $list = $self->{Left}->solve ($context, $list);
       
  2476     $self->{Right}->solve ($context, $list);
       
  2477 }
       
  2478 
       
  2479 sub xql_contextString
       
  2480 {
       
  2481     my $self = shift;
       
  2482     XML::XQL::delim ($self->{Left}->xql_contextString (@_) . 
       
  2483 		     XML::XQL::bold ("!") .
       
  2484 		     $self->{Right}->xql_contextString (@_), $self, @_);
       
  2485 }
       
  2486 
       
  2487 package XML::XQL::Invocation;
       
  2488 use base 'XML::XQL::Operator';
       
  2489 use fields qw{ Args Name Type Once ConstVal };
       
  2490 
       
  2491 use Carp;
       
  2492 
       
  2493 sub new
       
  2494 {
       
  2495     my ($class, %args) = @_;
       
  2496 
       
  2497     my $self = bless \%args, $class;
       
  2498     for my $par (@{$self->{Args}})
       
  2499     {
       
  2500 	$par->setParent ($self);
       
  2501     }
       
  2502     $self;
       
  2503 }
       
  2504 
       
  2505 sub dispose
       
  2506 {
       
  2507     my $self = shift;
       
  2508     for (@{ $self->{Args} })
       
  2509     {
       
  2510 	$_->dispose;
       
  2511     }
       
  2512     undef $self->{Args};
       
  2513 
       
  2514     undef $self->{Parent};
       
  2515 }
       
  2516 
       
  2517 sub isConstant
       
  2518 {
       
  2519     my ($self) = @_;
       
  2520     
       
  2521     # An Invocation is constant, if all it's arguments are constant
       
  2522     # and it's a "constant" function
       
  2523     my $name = $self->{Name};
       
  2524     my $cf = $self->query->{ConstFunc};
       
  2525     my $const = exists ($cf->{$name}) ? 
       
  2526 	$cf->{name} : $XML::XQL::ConstFunc{$name};
       
  2527     return 0 unless $const;
       
  2528 
       
  2529     for my $par (@{$self->{Args}})
       
  2530     {
       
  2531 	return 0 unless $par->isConstant;
       
  2532     }
       
  2533     1;
       
  2534 }
       
  2535 
       
  2536 sub xql_check
       
  2537 {
       
  2538     my ($self, $inSubQuery, $inParam) = @_;
       
  2539 
       
  2540     # Syntactic Constraint 7:
       
  2541     # In a node query this function or method is only valid inside an instance 
       
  2542     # of Subquery, unless it appears within an instance of Param.
       
  2543     # Functions and methods are valid anywhere in a full query.
       
  2544 
       
  2545     my $query;
       
  2546     if (not ($inSubQuery or $inParam) and ($query = $self->query)->isNodeQuery)
       
  2547     {
       
  2548 	unless ($query->isAllowedOutsideSubquery ($self->{Name}))
       
  2549 	{
       
  2550 	  XML::XQL::parseError $self->{Type} . " " . $self->{Name} . 
       
  2551 	    " is only allowed inside a Subquery or Param for 'Node Queries'." . 
       
  2552 	    " Context: " . $self->toContextString;
       
  2553 	}
       
  2554     }
       
  2555     for my $par (@{$self->{Args}})
       
  2556     {
       
  2557 	$par->xql_check ($inSubQuery, 1);	# these are Params
       
  2558     }
       
  2559     # once() should only be evaluated once per query
       
  2560     # "constant" functions should only be evaluated once *ever*
       
  2561     $self->{Once} = $self->isOnce || $self->isConstant;
       
  2562 }
       
  2563 
       
  2564 sub xql_prepCache
       
  2565 {
       
  2566     my ($self) = @_;
       
  2567     # once() should only be evaluated once per query
       
  2568     # "constant" functions should only be evaluated once *ever*
       
  2569     delete $self->{ConstVal} if $self->isOnce;
       
  2570 
       
  2571     for my $par (@{$self->{Args}})
       
  2572     {
       
  2573 	$par->xql_prepCache;
       
  2574     }
       
  2575 }
       
  2576 
       
  2577 sub isOnce
       
  2578 {
       
  2579     $_[0]->{Name} eq "once";
       
  2580 }
       
  2581 
       
  2582 sub isMethod
       
  2583 {
       
  2584     $_[0]->{Type} eq "method";
       
  2585 }
       
  2586 
       
  2587 sub solve
       
  2588 {
       
  2589     my ($self, $context, $list) = @_;
       
  2590 
       
  2591     # Use the cached value if it's a "constant" function
       
  2592     return $self->{ConstVal} if (exists $self->{ConstVal});
       
  2593 
       
  2594     my $func = $self->{Func};
       
  2595 
       
  2596     my $result;
       
  2597     eval {
       
  2598 	$result = &$func ($context, $list, @{$self->{Args}});
       
  2599 	$self->{ConstVal} = $result if $self->{Once};
       
  2600     };
       
  2601     if ($@)
       
  2602     {
       
  2603 #?? or croak
       
  2604 	$self->warning ("invocation of '" . $self->{Name} . "' failed:\n\t$@");
       
  2605 	$self->{ConstVal} = [] if $self->{Once};
       
  2606 	return [];
       
  2607     }
       
  2608     $result;
       
  2609 }
       
  2610 
       
  2611 sub xql_contextString
       
  2612 {
       
  2613     my $self = shift;
       
  2614     
       
  2615     my $str = XML::XQL::bold ($self->{Name}) . "(";
       
  2616     for (my $i = 0; $i < @{$self->{Args}}; $i++)
       
  2617     {
       
  2618 	$str .= ", " if $i > 0;
       
  2619 	$str .= $self->{Args}->[$i]->xql_contextString (@_);
       
  2620     }
       
  2621     $str .= ")";
       
  2622 
       
  2623     XML::XQL::delim ($str, $self, @_);
       
  2624 }
       
  2625 
       
  2626 # Base class shared by Node and PrimitiveType
       
  2627 package XML::XQL::PrimitiveTypeBase;
       
  2628 
       
  2629 sub dispose
       
  2630 {
       
  2631 }
       
  2632 
       
  2633 sub xql_check
       
  2634 {
       
  2635 }
       
  2636 
       
  2637 sub xql_prepCache
       
  2638 {
       
  2639 }
       
  2640 
       
  2641 sub xql_prevSibling
       
  2642 {
       
  2643     undef;
       
  2644 }
       
  2645 
       
  2646 # This method returns an integer that determines how values should be casted
       
  2647 # for comparisons. If the left value (LHS) has a higher xql_primType, the
       
  2648 # right value (RHS) is cast to the type of the LHS (otherwise, the LHS is casted
       
  2649 # to the type of the LHS)
       
  2650 #
       
  2651 # Values for certain types:
       
  2652 #	Node	0	(always cast a node to a Text string first)
       
  2653 #	Text	1
       
  2654 #	Number  2
       
  2655 #	Boolean 3
       
  2656 #	Date	4	(other classes automatically use 4 by default)
       
  2657 
       
  2658 sub xql_primType
       
  2659 {
       
  2660     4;	# default for all classes other then Node, Text, Number, Boolean
       
  2661 }
       
  2662 
       
  2663 sub xql_toBoolean
       
  2664 {
       
  2665     1;	# it is true if it exists
       
  2666 }
       
  2667 
       
  2668 sub xql_namespace
       
  2669 {
       
  2670     undef;
       
  2671 }
       
  2672 
       
  2673 sub xql_baseName
       
  2674 {
       
  2675     undef;
       
  2676 }
       
  2677 
       
  2678 sub xql_prefix
       
  2679 {
       
  2680     undef;
       
  2681 }
       
  2682 
       
  2683 sub xql_sortKey
       
  2684 {
       
  2685     my $src = $_[0]->xql_sourceNode;
       
  2686     $src ? $src->xql_sortKey : $XML::XQL::LAST_SORT_KEY;
       
  2687 }
       
  2688 
       
  2689 sub xql_toDOM
       
  2690 {
       
  2691     my ($self, $doc) = @_;
       
  2692     my $name = ref $self;
       
  2693     $name =~ s/.*:://;
       
  2694     my $elem = $doc->createElement ($name);
       
  2695     $elem->setAttribute ("value", $self->xql_toString);
       
  2696     $elem;
       
  2697 }
       
  2698 
       
  2699 package XML::XQL::PrimitiveType;
       
  2700 use vars qw( @ISA );
       
  2701 @ISA = qw( XML::XQL::PrimitiveTypeBase );
       
  2702 
       
  2703 sub new
       
  2704 {
       
  2705     my ($class, $val, $srcNode) = @_;
       
  2706     bless [$val, $srcNode], $class;
       
  2707 }
       
  2708 
       
  2709 sub isConstant
       
  2710 {
       
  2711     1;
       
  2712 }
       
  2713 
       
  2714 sub setParent
       
  2715 {
       
  2716     # not defined
       
  2717 }
       
  2718 
       
  2719 sub solve
       
  2720 {
       
  2721     $_[0];	# evaluates to itself
       
  2722 }
       
  2723 
       
  2724 #
       
  2725 # Derived classes should not override this method.
       
  2726 # Override xql_toString instead.
       
  2727 #
       
  2728 sub xql_contextString
       
  2729 {
       
  2730     my $self = shift;
       
  2731     
       
  2732     XML::XQL::delim ($self->xql_toString, $self, @_);
       
  2733 }
       
  2734 
       
  2735 #
       
  2736 # Return the value of the Object as a primitive Perl value, i.e. an integer,
       
  2737 # a float, or a string.
       
  2738 #
       
  2739 sub xql_toString
       
  2740 {
       
  2741     $_[0]->[0];
       
  2742 }
       
  2743 
       
  2744 sub xql_sourceNode
       
  2745 {
       
  2746     $_[0]->[1];
       
  2747 }
       
  2748 
       
  2749 sub xql_setSourceNode
       
  2750 {
       
  2751     $_[0]->[1] = $_[1];
       
  2752 }
       
  2753 
       
  2754 sub xql_setValue
       
  2755 {
       
  2756     # This could potentially change the value of a constant in the XQL 
       
  2757     # query expression.
       
  2758     $_[0]->[0] = $_[1];
       
  2759 }
       
  2760 
       
  2761 sub xql_nodeType
       
  2762 {
       
  2763     0;	# it's not a Node
       
  2764 }
       
  2765 
       
  2766 sub xql_compare
       
  2767 {
       
  2768     # Temporarily switch off $WARNING flag, to disable messages a la:
       
  2769     #  Argument "1993-02-14" isn't numeric in ncmp
       
  2770     local $^W = 0;
       
  2771     $_[0]->[0] <=> $_[1]->xql_toString;
       
  2772 }
       
  2773 
       
  2774 sub xql_eq { my $self = shift; $self->xql_compare (@_) == 0; }
       
  2775 sub xql_ne { my $self = shift; $self->xql_compare (@_) != 0; }
       
  2776 sub xql_lt { my $self = shift; $self->xql_compare (@_) < 0; }
       
  2777 sub xql_le { my $self = shift; $self->xql_compare (@_) <= 0; }
       
  2778 sub xql_gt { my $self = shift; $self->xql_compare (@_) > 0; }
       
  2779 sub xql_ge { my $self = shift; $self->xql_compare (@_) >= 0; }
       
  2780 
       
  2781 package XML::XQL::Boolean;
       
  2782 use vars qw( @ISA @EXPORT $TRUE $FALSE );
       
  2783 
       
  2784 use Carp;
       
  2785 
       
  2786 @ISA = qw( XML::XQL::PrimitiveType );
       
  2787 @EXPORT = qw( $TRUE $FALSE );
       
  2788 
       
  2789 $TRUE = new XML::XQL::Boolean (1);
       
  2790 $FALSE = new XML::XQL::Boolean (0);
       
  2791 
       
  2792 sub xql_primType
       
  2793 {
       
  2794     3;
       
  2795 }
       
  2796 
       
  2797 sub xql_toBoolean
       
  2798 {
       
  2799     $_[0]->[0];	# evaluate it to its value
       
  2800 }
       
  2801 
       
  2802 sub xql_negate
       
  2803 {
       
  2804 #?? do we need to keep track of a source node here?
       
  2805     $_[0]->[0] ? $FALSE : $TRUE;
       
  2806 }
       
  2807 
       
  2808 sub xql_compare
       
  2809 {
       
  2810 #?? how do we convert string to boolean value
       
  2811     $_[0]->[0] <=> ($_[1]->xql_toString ? 1 : 0);
       
  2812 }
       
  2813 
       
  2814 sub xql_lt { badComparisonError (@_); }
       
  2815 sub xql_gt { badComparisonError (@_); }
       
  2816 sub xql_le { badComparisonError (@_); }
       
  2817 sub xql_ge { badComparisonError (@_); }
       
  2818 
       
  2819 sub badComparisonError
       
  2820 {
       
  2821     croak 'comparison operator (other than =, !=, $ieq$, $ine$) not defined for type Boolean';
       
  2822 }
       
  2823 
       
  2824 package XML::XQL::Number;
       
  2825 use vars qw( @ISA );
       
  2826 @ISA = qw( XML::XQL::PrimitiveType );
       
  2827 
       
  2828 #use overload 
       
  2829 #    'fallback' => 1,		# use default operators, if not specified
       
  2830 #    '""' => \&debug;
       
  2831 
       
  2832 sub debug
       
  2833 {
       
  2834     "Number[" . $_[0]->[0] . "]";
       
  2835 }
       
  2836 
       
  2837 sub xql_primType
       
  2838 {
       
  2839     2;
       
  2840 }
       
  2841 
       
  2842 package XML::XQL::Text;
       
  2843 use vars qw( @ISA );
       
  2844 @ISA = qw( XML::XQL::PrimitiveType );
       
  2845 
       
  2846 #use overload 
       
  2847 #    'fallback' => 1,		# use default operators, if not specified
       
  2848 #    '""' => \&debug;
       
  2849 
       
  2850 sub debug
       
  2851 {
       
  2852     "Text[" . $_[0]->[0] . "]";
       
  2853 }
       
  2854 
       
  2855 sub xql_primType
       
  2856 {
       
  2857     1;
       
  2858 }
       
  2859 
       
  2860 sub xql_compare
       
  2861 {
       
  2862     my ($self, $other, $ignoreCase) = @_;
       
  2863     if ($ignoreCase)
       
  2864     {
       
  2865 	my $lhs = $self->[0];
       
  2866 	my $rhs = $other->xql_toString;
       
  2867 	"\U$lhs" cmp "\U$rhs";
       
  2868     }
       
  2869     else
       
  2870     {
       
  2871 	$self->[0] cmp $other->xql_toString;
       
  2872     }
       
  2873 }
       
  2874 
       
  2875 # Declare package XML::XQL::Node so that XML implementations can say
       
  2876 # that their nodes derive from it:
       
  2877 #
       
  2878 # This worked for me when I added XQL support for XML::DOM:
       
  2879 #
       
  2880 # BEGIN
       
  2881 # {
       
  2882 #    push @XML::DOM::Node::ISA, 'XML::XQL::Node';
       
  2883 # }
       
  2884 #
       
  2885 
       
  2886 package XML::XQL::Node;
       
  2887 
       
  2888 use vars qw( @ISA );
       
  2889 @ISA = qw( XML::XQL::PrimitiveTypeBase );
       
  2890 
       
  2891 use Carp;
       
  2892 
       
  2893 sub xql_primType
       
  2894 {
       
  2895     0;
       
  2896 }
       
  2897 
       
  2898 sub xql_toBoolean
       
  2899 {
       
  2900     1;	# it is true if it exists
       
  2901 }
       
  2902 
       
  2903 sub xql_attribute
       
  2904 {
       
  2905     [];
       
  2906 }
       
  2907 
       
  2908 sub xql_sourceNode
       
  2909 {
       
  2910     $_[0];
       
  2911 }
       
  2912 
       
  2913 # Default implementation - override this for speed
       
  2914 sub xql_element
       
  2915 {
       
  2916     my ($node, $elem) = @_;
       
  2917 
       
  2918     my @list = ();
       
  2919     if (defined $elem)
       
  2920     {
       
  2921 	for my $kid (@{$_[0]->xql_node})
       
  2922 	{
       
  2923 	    # 1: element
       
  2924 	    push @list, $kid 
       
  2925 		if $kid->xql_nodeType == 1 && $kid->xql_nodeName eq $elem;
       
  2926 	}
       
  2927     }
       
  2928     else
       
  2929     {
       
  2930 	for my $kid (@{$_[0]->xql_node})
       
  2931 	{
       
  2932 	    push @list, $kid if $kid->xql_nodeType == 1;	# 1: element
       
  2933 	}
       
  2934     }
       
  2935     \@list;
       
  2936 }
       
  2937 
       
  2938 sub xql_text
       
  2939 {
       
  2940     undef;
       
  2941 }
       
  2942 
       
  2943 sub xql_rawText
       
  2944 {
       
  2945     undef;
       
  2946 }
       
  2947 
       
  2948 sub xql_rawTextBlocks
       
  2949 {
       
  2950     undef;
       
  2951 }
       
  2952 
       
  2953 sub xql_value
       
  2954 {
       
  2955     new XML::XQL::Text ($_[0]->xql_text ($_[1]), $_[0]);
       
  2956 }
       
  2957 
       
  2958 # Convert xql_value to Perl string (or undef if xql_value is undefined)
       
  2959 sub xql_toString
       
  2960 {
       
  2961     my $val = $_[0]->xql_value;
       
  2962     return undef if XML::XQL::isEmptyList ($val);
       
  2963 
       
  2964     $val->xql_toString;
       
  2965 }
       
  2966 
       
  2967 sub xql_setValue
       
  2968 {
       
  2969     # Not implemented for most node types
       
  2970 }
       
  2971 
       
  2972 sub xql_data
       
  2973 {
       
  2974     "";
       
  2975 }
       
  2976 
       
  2977 sub xql_nodeType
       
  2978 {
       
  2979     0;
       
  2980 }
       
  2981 
       
  2982 sub xql_nodeName
       
  2983 {
       
  2984     [];
       
  2985 }
       
  2986 
       
  2987 # Java code from "XML:: Namespaces in 20 lines" by James Clark:
       
  2988 # see: http://www.oasis-open.org/cover/clarkNS-980804.html
       
  2989 #
       
  2990 # String expandName(String name, Element element, boolean isAttribute) {
       
  2991 #   // The index of the colon character in the name.
       
  2992 #   int colonIndex = name.indexOf(':');
       
  2993 #   // The name of the attribute that declares the namespace prefix.
       
  2994 #   String declAttName;
       
  2995 #   if (colonIndex == -1) {
       
  2996 #     // Default namespace applies only to element type names.
       
  2997 #     if (isAttribute)
       
  2998 #       return name;
       
  2999 #     declAttName = "xmlns";
       
  3000 #   }
       
  3001 #   else {
       
  3002 #     String prefix = name.substring(0, colonIndex);
       
  3003 #     // "xml:" is special
       
  3004 #     if (prefix.equals("xml"))
       
  3005 #       return name;
       
  3006 #     declAttName = "xmlns:" + prefix;
       
  3007 #   }
       
  3008 #   for (; element != null; element = element.getParent()) {
       
  3009 #     String ns = element.getAttributeValue(declAttName);
       
  3010 #     if (ns != null) {
       
  3011 #       // Handle special meaning of xmlns=""
       
  3012 #       if (ns.length() == 0 && colonIndex == -1)
       
  3013 #         return name;
       
  3014 #       return ns + '+' + name.substring(colonIndex + 1);
       
  3015 #     }
       
  3016 #   }
       
  3017 #   return null;
       
  3018 # }
       
  3019 
       
  3020 # From "Namespaces in XML"
       
  3021 # at http://www.w3.org/TR/1998/WD-xml-names-19980916
       
  3022 #
       
  3023 # The prefix xml is by definition bound to the namespace name
       
  3024 # urn:Connolly:input:required. The prefix xmlns is used only for 
       
  3025 # namespace bindings and is not itself bound to any namespace name. 
       
  3026 
       
  3027 my $DEFAULT_NAMESPACE = undef;
       
  3028 my $XML_NAMESPACE = "urn:Connolly:input:required";
       
  3029 #?? default namespace
       
  3030 
       
  3031 sub xql_namespace
       
  3032 {
       
  3033     my ($self) = @_;
       
  3034     my $nodeType = $self->xql_nodeType;
       
  3035     my $element = $self;
       
  3036 
       
  3037     if ($nodeType == 2)		# 2: Attr
       
  3038     {
       
  3039 	$element = $self->xql_parent;
       
  3040     }
       
  3041     elsif ($nodeType != 1)	# 1: Element
       
  3042     {
       
  3043 	return undef;
       
  3044     }
       
  3045     my $name = $self->xql_nodeName;
       
  3046     my $declAttName;
       
  3047 
       
  3048     if ($name =~ /([^:]+):([^:]+)/)
       
  3049     {
       
  3050 	my ($prefix, $basename) = ($1, $2);
       
  3051 
       
  3052 	# "xml:" is special
       
  3053 	return $XML_NAMESPACE if $prefix eq "xml";
       
  3054 
       
  3055 	$declAttName = "xmlns:$prefix";
       
  3056     }
       
  3057     else
       
  3058     {
       
  3059 	# Default namespace applies only to element type names.
       
  3060 	return $DEFAULT_NAMESPACE if $nodeType == 2;	# 2: Attr
       
  3061 #?? default namespace?
       
  3062 	$declAttName = "xmlns";
       
  3063     }
       
  3064 
       
  3065     do
       
  3066     {
       
  3067 	my $ns = $element->xql_attribute ($declAttName);
       
  3068 	next unless defined $ns;
       
  3069 	return $ns->xql_rawText;
       
  3070 
       
  3071 	$element = $element->xql_parent;
       
  3072     }
       
  3073     while (defined ($element) and $element->xql_nodeType == 1);
       
  3074 
       
  3075     # namespace not found
       
  3076     undef;
       
  3077 }
       
  3078 
       
  3079 sub xql_basename
       
  3080 {
       
  3081     my ($self) = @_;
       
  3082     my $nodeType = $self->xql_nodeType;
       
  3083     return undef unless $nodeType == 1 || $nodeType == 2;
       
  3084 
       
  3085     my $name = $self->xql_nodeName;
       
  3086     $name =~ s/^[^:]://;	    # strip prefix
       
  3087     $name;
       
  3088 }
       
  3089 
       
  3090 sub xql_prefix
       
  3091 {
       
  3092     my ($self) = @_;
       
  3093     my $nodeType = $self->xql_nodeType;
       
  3094     return undef unless $nodeType == 1 || $nodeType == 2;
       
  3095 
       
  3096     $self->xql_nodeName =~ /^([^:]+):/;
       
  3097     $1;
       
  3098 }
       
  3099 
       
  3100 # Used by ancestor()
       
  3101 sub xql_parent
       
  3102 {
       
  3103     undef;
       
  3104 }
       
  3105 
       
  3106 my @NodeTypeString =
       
  3107 (
       
  3108  "", "element", "attribute", "text", "", "", "", "processing_instruction", 
       
  3109  "comment", "document"
       
  3110 );
       
  3111 
       
  3112 sub xql_nodeTypeString
       
  3113 {
       
  3114     my $i = $_[0]->xql_nodeType;
       
  3115     return $NodeTypeString[$i] if ($i >= 1 && $i <= 3 || $i >= 7 && $i <= 9);
       
  3116 
       
  3117 #?? what should this return?
       
  3118     "<unknown xql_nodeType $i>";
       
  3119 }
       
  3120 
       
  3121 if (not $XML::XQL::Restricted)
       
  3122 {
       
  3123     require XML::XQL::Plus;
       
  3124 }
       
  3125 
       
  3126 # All nodes should implement:
       
  3127 
       
  3128 #?? this section must be updated!!
       
  3129 
       
  3130 # - xql_document
       
  3131 # - xql_node: return an unblessed list reference with childNodes (not 
       
  3132 #	attributes)
       
  3133 # - xql_nodeType (default implementation for XML::XQL::Node returns 0):
       
  3134 #   Element:			1
       
  3135 #   Element Attribute:		2
       
  3136 #   Markup-Delimited Region of Text (Text and CDATASection): 3
       
  3137 #   Processing Instruction:	7
       
  3138 #   Comment:			8
       
  3139 #   Document (Entity):		9
       
  3140 # - xql_text
       
  3141 # - xql_value (default implementation is xql_text)
       
  3142 # - xql_parent: return parent node or undef (Document, DocumentFragment)
       
  3143 #
       
  3144 # Element should define/override the following:
       
  3145 # - xql_nodeName: return the element name
       
  3146 # - xql_attribute("attributeName"): return an unblessed reference to a list
       
  3147 #	with the attribute, or [] if no such attribute
       
  3148 # - xql_attribute(): return an unblessed reference to a list with 
       
  3149 #	all attribute nodes
       
  3150 # - xql_baseName, xql_prefix
       
  3151 #
       
  3152 # Attribute:
       
  3153 # - xql_nodeName: return the attribute name
       
  3154 # - xql_baseName, xql_prefix
       
  3155 #
       
  3156 # EntityReference:
       
  3157 # - xql_data: return expanded text value
       
  3158 #
       
  3159 # Text, CDATASection:
       
  3160 # - xql_data: return expanded text value
       
  3161 #
       
  3162 # -xql_element could be overriden to speed up performance
       
  3163 #
       
  3164 
       
  3165 1;
       
  3166 
       
  3167 __END__
       
  3168 
       
  3169 =head1 NAME
       
  3170 
       
  3171 XML::XQL - A perl module for querying XML tree structures with XQL
       
  3172 
       
  3173 =head1 SYNOPSIS
       
  3174 
       
  3175  use XML::XQL;
       
  3176  use XML::XQL::DOM;
       
  3177 
       
  3178  $parser = new XML::DOM::Parser;
       
  3179  $doc = $parser->parsefile ("file.xml");
       
  3180 
       
  3181  # Return all elements with tagName='title' under the root element 'book'
       
  3182  $query = new XML::XQL::Query (Expr => "book/title");
       
  3183  @result = $query->solve ($doc);
       
  3184  $query->dispose; # Avoid memory leaks - Remove circular references
       
  3185 
       
  3186  # Or (to save some typing)
       
  3187  @result = XML::XQL::solve ("book/title", $doc);
       
  3188 
       
  3189  # Or (to save even more typing)
       
  3190  @result = $doc->xql ("book/title");
       
  3191 
       
  3192 =head1 DESCRIPTION
       
  3193 
       
  3194 The XML::XQL module implements the XQL (XML Query Language) proposal
       
  3195 submitted to the XSL Working Group in September 1998.
       
  3196 The spec can be found at: L<http://www.w3.org/TandS/QL/QL98/pp/xql.html>
       
  3197 Most of the contents related to the XQL syntax can also be found in the
       
  3198 L<XML::XQL::Tutorial> that comes with this distribution. 
       
  3199 Note that XQL is not the same as XML-QL!
       
  3200 
       
  3201 The current implementation only works with the L<XML::DOM> module, but once the
       
  3202 design is stable and the major bugs are flushed out, other extensions might
       
  3203 follow, e.g. for XML::Grove.
       
  3204 
       
  3205 XQL was designed to be extensible and this implementation tries to stick to that.
       
  3206 Users can add their own functions, methods, comparison operators and data types.
       
  3207 Plugging in a new XML tree structure (like XML::Grove) should be a piece of cake.
       
  3208 
       
  3209 To use the XQL module, either
       
  3210 
       
  3211   use XML::XQL;
       
  3212 
       
  3213 or
       
  3214 
       
  3215   use XML::XQL::Strict;
       
  3216 
       
  3217 The Strict module only provides the core XQL functionality as found in the
       
  3218 XQL spec. By default (i.e. by using XML::XQL) you get 'XQL+', which has
       
  3219 some additional features.
       
  3220 
       
  3221 See the section L<Additional Features in XQL+> for the differences.
       
  3222 
       
  3223 This module is still in development. See the To-do list in XQL.pm for what
       
  3224 still needs to be done. Any suggestions are welcome, the sooner these 
       
  3225 implementation issues are resolved, the faster we can all use this module.
       
  3226 
       
  3227 If you find a bug, you would do me great favor by sending it to me in the
       
  3228 form of a test case. See the file t/xql_template.t that comes with this distribution.
       
  3229 
       
  3230 If you have written a cool comparison operator, function, method or XQL data 
       
  3231 type that you would like to share, send it to enno@att.com and I will
       
  3232 add it to this module.
       
  3233 
       
  3234 =head1 XML::XQL global functions
       
  3235 
       
  3236 =over 4
       
  3237 
       
  3238 =item solve (QUERY_STRING, INPUT_LIST...)
       
  3239 
       
  3240  @result = XML::XQL::solve ("doc//book", $doc);
       
  3241 
       
  3242 This is provided as a shortcut for:
       
  3243 
       
  3244  $query = new XML::XQL::Query (Expr => "doc//book");
       
  3245  @result = $query->solve ($doc);
       
  3246  $query->dispose;
       
  3247 
       
  3248 Note that with L<XML::XQL::DOM>, you can also write (see L<XML::DOM::Node>
       
  3249 for details):
       
  3250 
       
  3251  @result = $doc->xql ("doc//book");
       
  3252 
       
  3253 =item setDocParser (PARSER)
       
  3254 
       
  3255 Sets the XML::DOM::Parser that is used by the new XQL+ document() method.
       
  3256 By default it uses an XML::DOM::Parser that was created without any arguments,
       
  3257 i.e.
       
  3258 
       
  3259   $PARSER = new XML::DOM::Parser;
       
  3260 
       
  3261 =item defineFunction (NAME, FUNCREF, ARGCOUNT [, ALLOWED_OUTSIDE [, CONST, [QUERY_ARG]]])
       
  3262 
       
  3263 Defines the XQL function (at the global level, i.e. for all newly created 
       
  3264 queries) with the specified NAME. The ARGCOUNT parameter can either be a single
       
  3265 number or a reference to a list with numbers. 
       
  3266 A single number expands to [ARGCOUNT, ARGCOUNT]. The list contains pairs of 
       
  3267 numbers, indicating the number of arguments that the function allows. The value
       
  3268 -1 means infinity. E.g. [2, 5, 7, 9, 12, -1] means that the function can have
       
  3269 2, 3, 4, 5, 7, 8, 9, 12 or more arguments.
       
  3270 The number of arguments is checked when parsing the XQL query string.
       
  3271 
       
  3272 The second parameter must be a reference to a Perl function or an anonymous
       
  3273 sub. E.g. '\&my_func' or 'sub { ... code ... }'
       
  3274 
       
  3275 If ALLOWED_OUTSIDE (default is 0) is set to 1, the function or method may 
       
  3276 also be used outside subqueries in I<node queries>.
       
  3277 (See NodeQuery parameter in Query constructor)
       
  3278 
       
  3279 If CONST (default is 0) is set to 1, the function is considered to be 
       
  3280 "constant". See L<Constant Function Invocations> for details.
       
  3281 
       
  3282 If QUERY_ARG (default is 0) is not -1, the argument with that index is
       
  3283 considered to be a 'query parameter'. If the query parameter is a subquery, 
       
  3284 that returns multiple values, the result list of the function invocation will
       
  3285 contain one result value for each value of the subquery. 
       
  3286 E.g. 'length(book/author)' will return a list of Numbers, denoting the string 
       
  3287 lengths of all the author elements returned by 'book/author'.
       
  3288 
       
  3289 Note that only methods (not functions) may appear after a Bang "!" operator.
       
  3290 This is checked when parsing the XQL query string.
       
  3291 
       
  3292 See also: defineMethod
       
  3293 
       
  3294 =item generateFunction (NAME, FUNCNAME, RETURN_TYPE [, ARGCOUNT [, ALLOWED_OUTSIDE [, CONST [, QUERY_ARG]]]])
       
  3295 
       
  3296 Generates and defines an XQL function wrapper for the Perl function with the
       
  3297 name FUNCNAME. The function name will be NAME in XQL query expressions.
       
  3298 The return type should be one of the builtin XQL Data Types or a class derived
       
  3299 from XML::XQL::PrimitiveType (see L<Adding Data Types>.)
       
  3300 See defineFunction for the meaning of ARGCOUNT, ALLOWED_OUTSIDE, CONST and
       
  3301 QUERY_ARG.
       
  3302 
       
  3303 Function values are always converted to Perl strings with xql_toString before
       
  3304 they are passed to the Perl function implementation. The function return value
       
  3305 is cast to an object of type RETURN_TYPE, or to the empty list [] if the
       
  3306 result is undef. It uses expandType to expand XQL primitive type names.
       
  3307 If RETURN_TYPE is "*", it returns the function 
       
  3308 result as is, unless the function result is undef, in which case it returns [].
       
  3309 
       
  3310 =item defineMethod (NAME, FUNCREF, ARGCOUNT [, ALLOWED_OUTSIDE])
       
  3311 
       
  3312 Defines the XQL method (at the global level, i.e. for all newly created 
       
  3313 queries) with the specified NAME. The ARGCOUNT parameter can either be a single
       
  3314 number or a reference to a list with numbers. 
       
  3315 A single number expands to [ARGCOUNT, ARGCOUNT]. The list contains pairs of 
       
  3316 numbers, indicating the number of arguments that the method allows. The value
       
  3317 -1 means infinity. E.g. [2, 5, 7, 9, 12, -1] means that the method can have
       
  3318 2, 3, 4, 5, 7, 8, 9, 12 or more arguments.
       
  3319 The number of arguments is checked when parsing the XQL query string.
       
  3320 
       
  3321 The second parameter must be a reference to a Perl function or an anonymous
       
  3322 sub. E.g. '\&my_func' or 'sub { ... code ... }'
       
  3323 
       
  3324 If ALLOWED_OUTSIDE (default is 0) is set to 1, the function or method may 
       
  3325 also be used outside subqueries in I<node queries>.
       
  3326 (See NodeQuery parameter in Query constructor)
       
  3327 
       
  3328 Note that only methods (not functions) may appear after a Bang "!" operator.
       
  3329 This is checked when parsing the XQL query string.
       
  3330 
       
  3331 See also: defineFunction
       
  3332 
       
  3333 =item defineComparisonOperators (NAME => FUNCREF [, NAME => FUNCREF]*)
       
  3334 
       
  3335 Defines XQL comparison operators at the global level.
       
  3336 The FUNCREF parameters must be a references to a Perl function or an anonymous
       
  3337 sub. E.g. '\&my_func' or 'sub { ... code ... }'
       
  3338 
       
  3339 E.g. define the operators $my_op$ and $my_op2$:
       
  3340 
       
  3341  defineComparisonOperators ('my_op' => \&my_op,
       
  3342                             'my_op2' => sub { ... insert code here ... });
       
  3343 
       
  3344 =item defineElementValueConvertor (TAG_NAME, FUNCREF)
       
  3345 
       
  3346 Defines that the result of the value() call for Elements with the specified
       
  3347 TAG_NAME uses the specified function. The function will receive
       
  3348 two parameters. The second one is the TAG_NAME of the Element node 
       
  3349 and the first parameter is the Element node itself.
       
  3350 FUNCREF should be a reference to a Perl function, e.g. \&my_sub, or
       
  3351 an anonymous sub.
       
  3352 
       
  3353 E.g. to define that all Elements with tag name 'date-of-birth' should return
       
  3354 XML::XQL::Date objects:
       
  3355 
       
  3356 	defineElementValueConvertor ('date-of-birth', sub {
       
  3357 		my $elem = shift;
       
  3358 		# Always pass in the node as the second parameter. This is
       
  3359 		# the reference node for the object, which is used when
       
  3360 		# sorting values in document order.
       
  3361 		new XML::XQL::Date ($elem->xql_text, $elem); 
       
  3362 	});
       
  3363 
       
  3364 These convertors can only be specified at a global level, not on a per query
       
  3365 basis. To undefine a convertor, simply pass a FUNCREF of undef.
       
  3366 
       
  3367 =item defineAttrValueConvertor (ELEM_TAG_NAME, ATTR_NAME, FUNCREF)
       
  3368 
       
  3369 Defines that the result of the value() call for Attributes with the specified
       
  3370 ATTR_NAME and a parent Element with the specified ELEM_TAG_NAME 
       
  3371 uses the specified function. An ELEM_TAG_NAME of "*" will match regardless of
       
  3372 the tag name of the parent Element. The function will receive
       
  3373 3 parameters. The third one is the tag name of the parent Element (even if 
       
  3374 ELEM_TAG_NAME was "*"), the second is the ATTR_NAME and the first is the 
       
  3375 Attribute node itself.
       
  3376 FUNCREF should be a reference to a Perl function, e.g. \&my_sub, or
       
  3377 an anonymous sub.
       
  3378 
       
  3379 These convertors can only be specified at a global level, not on a per query
       
  3380 basis. To undefine a convertor, simply pass a FUNCREF of undef.
       
  3381 
       
  3382 =item defineTokenQ (Q)
       
  3383 
       
  3384 Defines the token for the q// string delimiters at a global level.
       
  3385 The default value for XQL+ is 'q', for XML::XQL::Strict it is undef.
       
  3386 A value of undef will deactivate this feature.
       
  3387 
       
  3388 =item defineTokenQQ (QQ)
       
  3389 
       
  3390 Defines the token for the qq// string delimiters at a global level.
       
  3391 The default value for XQL+ is 'qq', for XML::XQL::Strict it is undef.
       
  3392 A value of undef will deactivate this feature.
       
  3393 
       
  3394 =item expandType (TYPE)
       
  3395 
       
  3396 Used internally to expand type names of XQL primitive types.
       
  3397 E.g. it expands "Number" to "XML::XQL::Number" and is not case-sensitive, so
       
  3398 "number" and "NuMbEr" will both expand correctly.
       
  3399 
       
  3400 =item defineExpandedTypes (ALIAS, FULL_NAME [, ...])
       
  3401 
       
  3402 For each pair of arguments it allows the class name FULL_NAME to be abbreviated
       
  3403 with ALIAS. The definitions are used by expandType(). 
       
  3404 (ALIAS is always converted to lowercase internally, because expandType 
       
  3405 is case-insensitive.)
       
  3406 
       
  3407 Overriding the ALIAS for "date", also affects the object type returned by the
       
  3408 date() function.
       
  3409 
       
  3410 =item setErrorContextDelimiters (START, END, BOLD_ON, BOLD_OFF)
       
  3411 
       
  3412 Sets the delimiters used when printing error messages during query evaluation.
       
  3413 The default delimiters on Unix are `tput smul` (underline on) and `tput rmal`
       
  3414 (underline off). On other systems (that don't have tput), the delimiters are
       
  3415 ">>" and "<<" resp. 
       
  3416 
       
  3417 When printing the error message, the subexpression that caused the error will
       
  3418 be enclosed by the delimiters, i.e. underlined on Unix.
       
  3419 
       
  3420 For certain subexpressions the significant keyword, e.g. "$and$" is enclosed in 
       
  3421 the bold delimiters BOLD_ON (default: `tput bold` on Unix, "" elsewhere) and 
       
  3422 BOLD_OFF (default: (`tput rmul` . `tput smul`) on Unix, "" elsewhere, 
       
  3423 see $BoldOff in XML::XQL::XQL.pm for details.)
       
  3424 
       
  3425 =item isEmptyList (VAR)
       
  3426 
       
  3427 Returns 1 if VAR is [], else 0. Can be used in user defined functions.
       
  3428 
       
  3429 =back
       
  3430 
       
  3431 =head1 Additional Features in XQL+
       
  3432 
       
  3433 =over 4
       
  3434 
       
  3435 =item Parent operator '..'
       
  3436 
       
  3437 The '..' operator returns the parent of the current node, where '.' would
       
  3438 return the current node. This is not part of any XQL standard, because you
       
  3439 would normally use return operators, which are not implemented here.
       
  3440 
       
  3441 =item Sequence operators ';' and ';;'
       
  3442 
       
  3443 The sequence operators ';' (precedes) and ';;' (immediately precedes) are
       
  3444 not in the XQL spec, but are described in 'The Design of XQL' by Jonathan Robie
       
  3445 who is one of the designers of XQL. It can be found at
       
  3446 L<http://www.texcel.no/whitepapers/xql-design.html>
       
  3447 See also the XQL Tutorial for a description of what they mean.
       
  3448 
       
  3449 =item q// and qq// String Tokens
       
  3450 
       
  3451 String tokens a la q// and qq// are allowed. q// evaluates like Perl's single 
       
  3452 quotes and qq// like Perl's double quotes. Note that the default XQL strings do
       
  3453 not allow escaping etc., so it's not possible to define a string with both
       
  3454 single and double quotes. If 'q' and 'qq' are not to your liking, you may
       
  3455 redefine them to something else or undefine them altogether, by assigning undef
       
  3456 to them. E.g:
       
  3457 
       
  3458  # at a global level - shared by all queries (that don't (re)define 'q')
       
  3459  XML::XQL::defineTokenQ ('k');
       
  3460  XML::XQL::defineTokenQQ (undef);
       
  3461 
       
  3462  # at a query level - only defined for this query
       
  3463  $query = new XML::XQL::Query (Expr => "book/title", q => 'k', qq => undef);
       
  3464  
       
  3465 From now on k// works like q// did and qq// doesn't work at all anymore.
       
  3466 
       
  3467 =item Query strings can have embedded Comments
       
  3468 
       
  3469 For example:
       
  3470 
       
  3471  $queryExpr = "book/title          # this comment is inside the query string
       
  3472 	       [. = 'Moby Dick']"; # this comment is outside 
       
  3473 
       
  3474 =item Optional dollar delimiters and case-insensitive XQL keywords
       
  3475 
       
  3476 The following XQL keywords are case-insensitive and the dollar sign delimiters 
       
  3477 may be omitted: $and$, $or$, $not$, $union$, $intersect$, $to$, $any$, $all$,
       
  3478 $eq$, $ne$, $lt$, $gt$, $ge$, $le$, $ieq$, $ine$, $ilt$, $igt$, $ige$, $ile$.
       
  3479 
       
  3480 E.g. $AND$, $And$, $aNd$, and, And, aNd are all valid replacements for $and$.
       
  3481 
       
  3482 Note that XQL+ comparison operators ($match$, $no_match$, $isa$, $can$) still
       
  3483 require dollar delimiters and are case-sensitive.
       
  3484 
       
  3485 =item Comparison operator: $match$ or '=~'
       
  3486 
       
  3487 E.g. "book/title =~ '/(Moby|Dick)/']" will return all book titles containing
       
  3488 Moby or Dick. Note that the match expression needs to be quoted and should
       
  3489 contain the // or m// delimiters for Perl.
       
  3490 
       
  3491 When casting the values to be matched, both are converted to Text.
       
  3492 
       
  3493 =item Comparison operator: $no_match$ or '!~'
       
  3494 
       
  3495 E.g. "book/title !~ '/(Moby|Dick)/']" will return all book titles that don't 
       
  3496 contain Moby or Dick. Note that the match expression needs to be quoted and 
       
  3497 should contain the // or m// delimiters for Perl.
       
  3498 
       
  3499 When casting the values to be matched, both are converted to Text.
       
  3500 
       
  3501 =item Comparison operator: $isa$
       
  3502 
       
  3503 E.g. '//. $isa$ "XML::XQL::Date"' returns all elements for which the value() 
       
  3504 function returns an XML::XQL::Date object. (Note that the value() function can
       
  3505 be overridden to return a specific object type for certain elements and 
       
  3506 attributes.) It uses expandType to expand XQL primitive type names.
       
  3507 
       
  3508 =item Comparison operator: $can$
       
  3509 
       
  3510 E.g. '//. $can$ "swim"' returns all elements for which the value() 
       
  3511 function returns an object that implements the (Perl) swim() method. 
       
  3512 (Note that the value() function can be overridden to return a specific object 
       
  3513 type for certain elements and attributes.)
       
  3514 
       
  3515 =item Function: once (QUERY)
       
  3516 
       
  3517 E.g. 'once(id("foo"))' will evaluate the QUERY expression only once per query.
       
  3518 Certain query results (like the above example) will always return the same
       
  3519 value within a query. Using once() will cache the QUERY result for the
       
  3520 rest of the query. 
       
  3521 
       
  3522 Note that "constant" function invocations are always cached.
       
  3523 See also L<Constant Function Invocations>
       
  3524 
       
  3525 =item Function: subst (QUERY, EXPR, EXPR [,MODIFIERS, [MODE]])
       
  3526 
       
  3527 E.g. 'subst(book/title, "[M|m]oby", "Dick", "g")' will replace Moby or moby
       
  3528 with Dick globally ("g") in all book title elements. Underneath it uses Perl's
       
  3529 substitute operator s///. Don't worry about which delimiters are used underneath.
       
  3530 The function returns all the book/titles for which a substitution occurred.
       
  3531 The default MODIFIERS string is "" (empty.) The function name may be abbreviated 
       
  3532 to "s".
       
  3533 
       
  3534 For most Node types, it converts the value() to a string (with xql_toString)
       
  3535 to match the string and xql_setValue to set the new value in case it matched.
       
  3536 For XQL primitives (Boolean, Number, Text) and other data types (e.g. Date) it 
       
  3537 uses xql_toString to match the String and xql_setValue to set the result. 
       
  3538 Beware that performing a substitution on a primitive that was found in the 
       
  3539 original XQL query expression, changes the value of that constant.
       
  3540 
       
  3541 If MODE is 0 (default), it treats Element nodes differently by matching and
       
  3542 replacing I<text blocks> occurring in the Element node. A text block is defined
       
  3543 as the concatenation of the raw text of subsequent Text, CDATASection and 
       
  3544 EntityReference nodes. In this mode it skips embedded Element nodes.
       
  3545 If a text block matches, it is replaced by a single Text node, regardless
       
  3546 of the original node type(s).
       
  3547 
       
  3548 If MODE is 1, it treats Element nodes like the other nodes, i.e. it converts
       
  3549 the value() to a string etc. Note that the default implementation of value()
       
  3550 calls text(), which normalizes whitespace and includes embedded Element
       
  3551 descendants (recursively.) This is probably not what you want to use in most
       
  3552 cases, but since I'm not a professional psychic... :-)
       
  3553 
       
  3554 =item Function: map (QUERY, CODE)
       
  3555 
       
  3556 E.g. 'map(book/title, "s/[M|m]oby/Dick/g; $_")' will replace Moby or moby
       
  3557 with Dick globally ("g") in all book title elements. Underneath it uses Perl's
       
  3558 map operator. The function returns all the book/titles for which a 
       
  3559 change occurred.
       
  3560 
       
  3561 ??? add more specifics
       
  3562 
       
  3563 =item Function: eval (EXPR [,TYPE])
       
  3564 
       
  3565 Evaluates the Perl expression EXPR and returns an object of the specified TYPE.
       
  3566 It uses expandType to expand XQL primitive type names.
       
  3567 If the result of the eval was undef, the empty list [] is returned.
       
  3568 
       
  3569 E.g. 'eval("2 + 5", "Number")' returns a Number object with the value 7, and
       
  3570      'eval("%ENV{USER}")' returns a Text object with the user name.
       
  3571 
       
  3572 Consider using once() to cache the return value, when the invocation will 
       
  3573 return the same result for each invocation within a query.
       
  3574 
       
  3575 ??? add more specifics
       
  3576 
       
  3577 =item Function: new (TYPE [, QUERY [, PAR] *])
       
  3578 
       
  3579 Creates a new object of the specified object TYPE. The constructor may have any
       
  3580 number of arguments. The first argument of the constructor (the 2nd argument 
       
  3581 of the new() function) is considered to be a 'query parameter'.
       
  3582 See defineFunction for a definition of I<query parameter>.
       
  3583 It uses expandType to expand XQL primitive type names.
       
  3584 
       
  3585 =item Function: document (QUERY) or doc (QUERY)
       
  3586 
       
  3587 The document() function creates a new L<XML::XML::Document> for each result 
       
  3588 of QUERY (QUERY may be a simple string expression, like "/usr/enno/file.xml". 
       
  3589 See t/xql_document.t or below for an example with a more complex QUERY.)
       
  3590 
       
  3591 document() may be abbreviated to doc().
       
  3592 
       
  3593 document() uses an XML::DOM::Parser underneath, which can be set with
       
  3594 XML::XQL::setDocParser(). By default it uses a parser that was created without
       
  3595 any arguments, i.e.
       
  3596 
       
  3597   $PARSER = new XML::DOM::Parser;
       
  3598 
       
  3599 Let's try a more complex example, assuming $doc contains:
       
  3600 
       
  3601  <doc>
       
  3602   <file name="file1.xml"/>
       
  3603   <file name="file2.xml"/>
       
  3604  </doc>
       
  3605 
       
  3606 Then the following query will return two L<XML::XML::Document>s, 
       
  3607 one for file1.xml and one for file2.xml:
       
  3608 
       
  3609  @result = XML::XQL::solve ("document(doc/file/@name)", $doc);
       
  3610 
       
  3611 The resulting documents can be used as input for following queries, e.g.
       
  3612 
       
  3613  @result = XML::XQL::solve ("document(doc/file/@name)/root/bla", $doc);
       
  3614 
       
  3615 will return all /root/bla elements from the documents returned by document().
       
  3616 
       
  3617 =item Method: DOM_nodeType ()
       
  3618 
       
  3619 Returns the DOM node type. Note that these are mostly the same as nodeType(),
       
  3620 except for CDATASection and EntityReference nodes. DOM_nodeType() returns
       
  3621 4 and 5 respectively, whereas nodeType() returns 3, because they are 
       
  3622 considered text nodes.
       
  3623 
       
  3624 =item Function wrappers for Perl builtin functions
       
  3625 
       
  3626 XQL function wrappers have been provided for most Perl builtin functions.
       
  3627 When using a Perl builtin function like "substr" in an XQL+ querry, an
       
  3628 XQL function wrapper will be generated on the fly. The arguments to these
       
  3629 functions may be regular XQL+ subqueries (that return one or more values) for
       
  3630 a I<query parameter> (see generateFunction for a definition.)
       
  3631 Most wrappers of Perl builtin functions have argument 0 for a query parameter,
       
  3632 except for: chmod (parameter 1 is the query parameter), chown (2) and utime (2).
       
  3633 The following functions have no query parameter, which means that all parameters
       
  3634 should be a single value: atan2, rand, srand, sprintf, rename, unlink, system.
       
  3635 
       
  3636 The function result is casted to the appropriate XQL primitive type (Number, 
       
  3637 Text or Boolean), or to an empty list if the result was undef.
       
  3638 
       
  3639 =back
       
  3640 
       
  3641 =head2 XPath functions and methods
       
  3642 
       
  3643 The following functions were found in the XPath specification:
       
  3644 
       
  3645 =over 4
       
  3646 
       
  3647 =item Function: concat (STRING, STRING, STRING*) 
       
  3648 
       
  3649 The concat function returns the concatenation of its arguments.
       
  3650 
       
  3651 =item Function: starts-with (STRING, STRING) 
       
  3652 
       
  3653 The starts-with function returns true if the first argument string starts with 
       
  3654 the second argument string, and otherwise returns false.
       
  3655 
       
  3656 =item Function: contains (STRING, STRING) 
       
  3657 
       
  3658 The contains function returns true if the first argument string contains the 
       
  3659 second argument string, and otherwise returns false.
       
  3660 
       
  3661 =item Function: substring-before (STRING, STRING) 
       
  3662 
       
  3663 The substring-before function returns the substring of the first argument 
       
  3664 string that precedes the first occurrence of the second argument string
       
  3665 in the first argument string, or the empty string if the first argument 
       
  3666 string does not contain the second argument string. For example,
       
  3667 
       
  3668  substring-before("1999/04/01","/") returns 1999.
       
  3669 
       
  3670 =item Function: substring-after (STRING, STRING) 
       
  3671 
       
  3672 The substring-after function returns the substring of the first argument string 
       
  3673 that follows the first occurrence of the second argument string in
       
  3674 the first argument string, or the empty string if the first argument string does
       
  3675 not contain the second argument string. For example,
       
  3676 
       
  3677  substring-after("1999/04/01","/") returns 04/01, 
       
  3678 
       
  3679 and 
       
  3680 
       
  3681  substring-after("1999/04/01","19") returns 99/04/01.
       
  3682 
       
  3683 =item Function: substring (STRING, NUMBER [, NUMBER] ) 
       
  3684 
       
  3685 The substring function returns the substring of the first argument starting at 
       
  3686 the position specified in the second argument with length specified in
       
  3687 the third argument. For example, 
       
  3688 
       
  3689  substring("12345",2,3) returns "234". 
       
  3690 
       
  3691 If the third argument is not specified, it returns the substring 
       
  3692 starting at the position specified in the second argument and continuing to 
       
  3693 the end of the string. For example, 
       
  3694 
       
  3695  substring("12345",2) returns "2345".
       
  3696 
       
  3697 More precisely, each character in the string is considered 
       
  3698 to have a numeric position: the position of the first character is 1,
       
  3699 the position of the second character is 2 and so on.
       
  3700 
       
  3701 NOTE: This differs from the B<substr> method , in which the
       
  3702 method treats the position of the first character as 0.
       
  3703 
       
  3704 The XPath spec says this about rounding, but that is not true in this 
       
  3705 implementation: 
       
  3706 I<The returned substring contains those characters for which the position of the 
       
  3707 character is greater than or equal to the rounded value of the
       
  3708 second argument and, if the third argument is specified, less than the 
       
  3709 sum of the rounded value of the second argument and the rounded value of
       
  3710 the third argument; the comparisons and addition used for the above 
       
  3711 follow the standard IEEE 754 rules; rounding is done as if by a call to the
       
  3712 round function.>
       
  3713 
       
  3714 =item Method: string-length ( [ QUERY ] )
       
  3715 
       
  3716 The string-length returns the number of characters in the string. 
       
  3717 If the argument is omitted, it defaults to the context node
       
  3718 converted to a string, in other words the string-value of the context node.
       
  3719 
       
  3720 Note that the generated XQL wrapper for the Perl built-in B<substr> does not
       
  3721 allow the argument to be omitted.
       
  3722 
       
  3723 =item Method: normalize-space ( [ QUERY ] )
       
  3724 
       
  3725 The normalize-space function returns the argument string with whitespace 
       
  3726 normalized by stripping leading and trailing whitespace and replacing
       
  3727 sequences of whitespace characters by a single space. Whitespace characters are 
       
  3728 the same as those allowed by the S production in XML. If the
       
  3729 argument is omitted, it defaults to the context node converted to a string, in 
       
  3730 other words the string-value of the context node.
       
  3731 
       
  3732 =item Function: translate (STRING, STRING, STRING) 
       
  3733 
       
  3734 The translate function returns the first argument string with occurrences of 
       
  3735 characters in the second argument string replaced by the character at
       
  3736 the corresponding position in the third argument string. For example, 
       
  3737 
       
  3738  translate("bar","abc","ABC") returns the string BAr. 
       
  3739 
       
  3740 If there is a
       
  3741 character in the second argument string with no character at a corresponding
       
  3742 position in the third argument string (because the second argument
       
  3743 string is longer than the third argument string), then occurrences of that 
       
  3744 character in the first argument string are removed. For example,
       
  3745 
       
  3746  translate("--aaa--","abc-","ABC") returns "AAA". 
       
  3747 
       
  3748 If a character occurs more than once in the second argument string, then the 
       
  3749 first occurrence determines the replacement character. If the third argument 
       
  3750 string is longer than the second argument string, then excess characters
       
  3751 are ignored.
       
  3752 
       
  3753 NOTE: The translate function is not a sufficient solution for case conversion 
       
  3754 in all languages. A future version may
       
  3755 provide additional functions for case conversion.
       
  3756 
       
  3757 This function was implemented using tr///d.
       
  3758 
       
  3759 =item Function: sum ( QUERY ) 
       
  3760 
       
  3761 The sum function returns the sum of the QUERY results, by
       
  3762 converting the string values of each result to a number.
       
  3763 
       
  3764 =item Function: floor (NUMBER) 
       
  3765 
       
  3766 The floor function returns the largest (closest to positive infinity) number 
       
  3767 that is not greater than the argument and that is an integer.
       
  3768 
       
  3769 =item Function: ceiling (NUMBER) 
       
  3770 
       
  3771 The ceiling function returns the smallest (closest to negative infinity) number 
       
  3772 that is not less than the argument and that is an integer.
       
  3773 
       
  3774 =item Function: round (NUMBER) 
       
  3775 
       
  3776 The round function returns the number that is closest to the argument 
       
  3777 and that is an integer. If there are two such numbers, then the one that is
       
  3778 closest to positive infinity is returned.
       
  3779 
       
  3780 =back
       
  3781 
       
  3782 =head1 Implementation Details
       
  3783 
       
  3784 =over 4
       
  3785 
       
  3786 =item XQL Builtin Data Types
       
  3787 
       
  3788 The XQL engine uses the following object classes internally. Only Number, 
       
  3789 Boolean and Text are considered I<primitive XQL types>:
       
  3790 
       
  3791 =over 4
       
  3792 
       
  3793 =item * XML::XQL::Number
       
  3794 
       
  3795 For integers and floating point numbers.
       
  3796 
       
  3797 =item * XML::XQL::Boolean
       
  3798 
       
  3799 For booleans, e.g returned by true() and false().
       
  3800 
       
  3801 =item * XML::XQL::Text
       
  3802 
       
  3803 For string values.
       
  3804 
       
  3805 =item * XML::XQL::Date
       
  3806 
       
  3807 For date, time and date/time values. E.g. returned by the date() function.
       
  3808 
       
  3809 =item * XML::XQL::Node
       
  3810 
       
  3811 Superclass of all XML node types. E.g. all subclasses of XML::DOM::Node subclass
       
  3812 from this.
       
  3813 
       
  3814 =item * Perl list reference
       
  3815 
       
  3816 Lists of values are passed by reference (i.e. using [] delimiters).
       
  3817 The empty list [] has a double meaning. It also means 'undef' in certain 
       
  3818 situations, e.g. when a function invocation or comparison failed.
       
  3819 
       
  3820 =back
       
  3821 
       
  3822 =item Type casting in comparisons
       
  3823 
       
  3824 When two values are compared in an XML comparison (e.g. $eq$) the values are
       
  3825 first casted to the same data type. Node values are first replaced by their
       
  3826 value() (i.e. the XQL value() function is used, which returns a Text value by 
       
  3827 default, but may return any data type if the user so chooses.)
       
  3828 The resulting values are then casted to the type of the object with the highest
       
  3829 xql_primType() value. They are as follows: Node (0), Text (1), Number (2),
       
  3830 Boolean (3), Date (4), other data types (4 by default, but this may be
       
  3831 overriden by the user.)
       
  3832 
       
  3833 E.g. if one value is a Text value and the other is a Number, the Text value is 
       
  3834 cast to a Number and the resulting low-level (Perl) comparison is (for $eq$):
       
  3835 
       
  3836  $number->xql_toString == $text->xql_toString
       
  3837 
       
  3838 If both were Text values, it would have been
       
  3839 
       
  3840  $text1->xql_toString eq $text2->xql_toString
       
  3841 
       
  3842 Note that the XQL spec is vague and even conflicting where it concerns type
       
  3843 casting. This implementation resulted after talking to Joe Lapp, one of the
       
  3844 spec writers.
       
  3845 
       
  3846 =item Adding Data Types
       
  3847 
       
  3848 If you want to add your own data type, make sure it derives from 
       
  3849 XML::XQL::PrimitiveType and implements the necessary methods.
       
  3850 
       
  3851 I will add more stuff here to explain it all, but for now, look at the code
       
  3852 for the primitive XQL types or the Date class (L<XML::XQL::Date> in Date.pm.)
       
  3853 
       
  3854 =item Document Order
       
  3855 
       
  3856 The XQL spec states that query results always return their values in 
       
  3857 I<document order>, which means the order in which they appeared in the original
       
  3858 XML document. Values extracted from Nodes (e.g. with value(), text(), rawText(),
       
  3859 nodeName(), etc.) always have a pointer to the reference node (i.e. the Node
       
  3860 from which the value was extracted.) These pointers are acknowledged when
       
  3861 (intermediate) result lists are sorted. Currently, the only place where a
       
  3862 result list is sorted is in a $union$ expression, which is the only place
       
  3863 where the result list can be unordered.
       
  3864 (If you find that this is not true, let me know.)
       
  3865 
       
  3866 Non-node values that have no associated reference node, always end up at the end
       
  3867 of the result list in the order that they were added.
       
  3868 The XQL spec states that the reference node for an XML Attribute is the Element
       
  3869 to which it belongs, and that the order of values with the same reference node
       
  3870 is undefined. This means that the order of an Element and its attributes would 
       
  3871 be undefined.
       
  3872 But since the XML::DOM module keeps track of the order of the attributes, the
       
  3873 XQL engine does the same, and therefore, the attributes of an Element are
       
  3874 sorted and appear after their parent Element in a sorted result list.
       
  3875 
       
  3876 =item Constant Function Invocations
       
  3877 
       
  3878 If a function always returns the same value when given "constant" arguments,
       
  3879 the function is considered to be "constant". A "constant" argument can be
       
  3880 either an XQL primitive (Number, Boolean, Text) or a "constant" function
       
  3881 invocation. E.g. 
       
  3882 
       
  3883  date("12-03-1998")
       
  3884  true()
       
  3885  sin(0.3)
       
  3886  length("abc")
       
  3887  date(substr("12-03-1998 is the date", 0, 10))
       
  3888 
       
  3889 are constant, but not:
       
  3890 
       
  3891  length(book[2])
       
  3892 
       
  3893 Results of constant function invocations are cached and calculated only once
       
  3894 for each query. See also the CONST parameter in defineFunction.
       
  3895 It is not necessary to wrap constant function invocations in a once() call.
       
  3896 
       
  3897 Constant XQL functions are: date, true, false and a lot of the XQL+
       
  3898 wrappers for Perl builtin functions. Function wrappers for certain builtins
       
  3899 are not made constant on purpose to force the invocation to be evaluated
       
  3900 every time, e.g. 'mkdir("/user/enno/my_dir", "0644")' (although constant
       
  3901 in appearance) may return different results for multiple invocations. 
       
  3902 See %PerlFunc in Plus.pm for details.
       
  3903 
       
  3904 =item Function: count ([QUERY])
       
  3905 
       
  3906 The count() function has no parameters in the XQL spec. In this implementation
       
  3907 it will return the number of QUERY results when passed a QUERY parameter.
       
  3908 
       
  3909 =item Method: text ([RECURSE])
       
  3910 
       
  3911 When expanding an Element node, the text() method adds the expanded text() value
       
  3912 of sub-Elements. When RECURSE is set to 0 (default is 1), it will not include
       
  3913 sub-elements. This is useful e.g. when using the $match$ operator in a recursive
       
  3914 context (using the // operator), so it won't return parent Elements when one of
       
  3915 the children matches.
       
  3916 
       
  3917 =item Method: rawText ([RECURSE])
       
  3918 
       
  3919 See text().
       
  3920 
       
  3921 =back
       
  3922 
       
  3923 =head1 SEE ALSO
       
  3924 
       
  3925 L<XML::XQL::Query>, L<XML::XQL::DOM>, L<XML::XQL::Date>
       
  3926 
       
  3927 The Japanese version of this document can be found on-line at
       
  3928 L<http://member.nifty.ne.jp/hippo2000/perltips/xml/xql.htm>
       
  3929 
       
  3930 The L<XML::XQL::Tutorial> manual page. The Japanese version can be found at 
       
  3931 L<http://member.nifty.ne.jp/hippo2000/perltips/xml/xql/tutorial.htm>
       
  3932 
       
  3933 The XQL spec at L<http://www.w3.org/TandS/QL/QL98/pp/xql.html>
       
  3934 
       
  3935 The Design of XQL at L<http://www.texcel.no/whitepapers/xql-design.html>
       
  3936 
       
  3937 The DOM Level 1 specification at L<http://www.w3.org/TR/REC-DOM-Level-1>
       
  3938 
       
  3939 The XML spec (Extensible Markup Language 1.0) at L<http://www.w3.org/TR/REC-xml>
       
  3940 
       
  3941 The L<XML::Parser> and L<XML::Parser::Expat> manual pages.
       
  3942 
       
  3943 =head1 AUTHOR
       
  3944 
       
  3945 Please send bugs, comments and suggestions to Enno Derksen <F<enno@att.com>>
       
  3946 
       
  3947 =cut