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