#Copyright Massachusetts Institute of technology, 2003.
#Written by Eric Prud'hommeaux for the World Wide Web Consortium

# W3C::Rdf::Algae2 -- a parser/evaluator for the algae2 language
# 
# $Id: Algae2.pm,v 1.102 2007-11-13 03:04:39 eric Exp $
# 
use strict;
require Exporter;

package W3C::Rdf::Algae2;
use W3C::Util::Exception;
use W3C::Util::NamespaceHandler;
use W3C::Rdf::Atoms; # qw($ATTRIB_GroundFact);
use W3C::Rdf::AlgaeCompileTree;
use W3C::Rdf::N3Parser;
use W3C::Rdf::ResultSet;

# Known parsers:
use W3C::Rdf::AlgaeParser;
use W3C::Rdf::SparqlParser;
use W3C::Rdf::RdqlParser;
use W3C::Rdf::SeRQLParser;

use vars qw(@ISA @EXPORT $QL_ALGAE $QL_N3 $QL_RDQL $QL_SPARQL $QL_SeRQL);
@ISA = qw(W3C::Util::NamedParmObject Exporter);
@EXPORT = qw($QL_ALGAE $QL_N3 $QL_RDQL $QL_SPARQL $QL_SeRQL) ; # &getTripleAttribute &setTripleAttribute);
($QL_ALGAE, $QL_N3, $QL_RDQL, $QL_SPARQL, $QL_SeRQL) = ('algae', 'n3', 'RDQL', 'SPARQL', 'SeRQL');

# Profile identifiers -- not currently exported.
use vars qw($PROFILE_core $PROFILE_assert $PROFILE_delete $PROFILE_profQuery $PROFILE_provStuff $PROFILE_pattern);
$PROFILE_core = 'http://www.w3.org/2004/05/06-Algae/#core';
$PROFILE_assert = 'http://www.w3.org/2004/06/20-rules/#assert';
$PROFILE_delete = 'http://www.w3.org/2004/06/20-rules/#delete';
$PROFILE_profQuery = 'http://lists.w3.org/Archives/Public/public-rdf-dawg/2004AprJun/0699.html#profileQuery';
$PROFILE_provStuff = 'http://example.org/provenanceStuff#profile';
$PROFILE_pattern = 'http://www.w3.org/2004/06/20-rules/#pattern';

# Access to special variables
sub getTripleAttribute { # static
    my ($varname, $triple) = @_;
    if ($varname eq 'ENCODING') {
	my $o = $triple->getObject;
	return $o->isa('W3C::Rdf::String') ? $o->getEncoding : undef;
    } elsif ($varname eq 'DATATYPE') {
	my $o = $triple->getObject;
	return $o->isa('W3C::Rdf::String') ? $o->getDatatype : undef;
    } elsif ($varname eq 'LANG') {
	my $o = $triple->getObject;
	return $o->isa('W3C::Rdf::String') ? $o->getLang : undef;
    } elsif ($varname eq 'ATTRIB') {
	return $triple->getAttribution->getUri;
    } else {
	&throw(new W3C::Util::Exception(-message =>"unknown key word \"$varname\""));
    }
}
sub setTripleAttribute { # static
    my ($varname, $triple, $value, $atomDictionary) = @_;
    if ($varname eq 'ENCODING') {
	$triple->getObject->setEncoding($value);
    } elsif ($varname eq 'DATATYPE') {
	$triple->getObject->setDatatype($value);
    } elsif ($varname eq 'LANG') {
	$triple->getObject->setLang($value);
    } elsif ($varname eq 'ATTRIB') {
	my $auth = undef; # !!!
	$triple->setAttribution($atomDictionary->getAttribution($ATTRIB_GroundFact, 
									 $value, $auth, 
									 undef, 1, undef, 0));
    } else {
	&throw(new W3C::Util::Exception(-message =>"unknown key word \"$varname\""));
    }
    return $value;
}

# <ACCESSORS>
my $XSD = 'http://www.w3.org/2001/XMLSchema#';
use vars qw($NativeTypes);
sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    bless ($self, $class);

    if (!$self->{-atomDictionary}) {
	&throw(new W3C::Util::Exception(-message => "$class must have an -atomDictionary"));
    }
    if (!UNIVERSAL::can($self->{-atomDictionary}, 'getUriLink')) {
	&throw(new W3C::Util::Exception(-message => "$class must have an -atomDictionary (not $self->{-atomDictionary})"));
    }
    $self->{-sources} ||= {};
    $self->{-name2source} ||= {};
    $self->{-rdfDB} ||= $self->{-rdfApp}->getRdfDB();

    $self->{DEFAULT_PARMS} = {};
    $self->{-errorHandler} = undef; # $errorHandler;
    $self->{RESULT_SET} = new W3C::Rdf::ResultSet(-atomDictionary => $self->{-atomDictionary});

    # Report storage
    $self->{LABELS} = [];
#    $self->{COLLECTS} = [];
    $self->{HOST_symbols} = {};
    $self->{HOST_cache} = {};
    $self->{HOST_index} = 0;

    $self->{NOW_LOADING} = {};		# efficiently detect circular dependecny
    $self->{LOADING_STACK} = [];	# display circular dependecny route

    $self->{PROFILES} = {};		# list of required feature sets.
    $self->{-baseTypes} = {};
    $self->{-normalizers} = {};
    $self->{-comparators} = {};
    $self->{-operators} = {};
    $self->{-ebv} = {};
    $self->{-promotions} = {};
    $self->{-logicExtensions} = {};
    $self->{Actions} = undef;
    $self->{ParserMode} = 0;
    $self->addTypes($NativeTypes, keys %$NativeTypes);
    return $self;
}
sub include {
    my ($self, $src, $debug) = @_;
    my $url = $src->getUrl;
    if ($self->{NOW_LOADING}{$url}) {
	&throw(new W3C::Util::Exception(-message => "circular dependency on $url: ".join('->,', @{$self->{LOAD_STACK}})));
    }
    require W3C::XML::InputSource;
    my $inp = new W3C::XML::URIInputSource($url, {}); # No parms yet
    my $algaeString = $inp->getByteStream;
    my $p = new W3C::Rdf::AlgaeParser($algaeString, $self, $url);
    $p->YYData->{-namespaceHandler} = new W3C::Util::NamespaceHandler(-relay => $self->{-namespaceHandler});
    $self->{NOW_LOADING}{$url} = $p;
    push (@{$self->{LOAD_STACK}}, $url);
    my $actions = $p->parse($debug);
    pop (@{$self->{LOAD_STACK}});
    delete $self->{NOW_LOADING}{$url};
    return @$actions;
}
sub interpret {
    my ($self, $algaeString, $location, $lang, %flags) = @_;
    $self->{LANG} = $lang;
    my $p = $lang eq $QL_ALGAE ? new W3C::Rdf::AlgaeParser($algaeString, $self, $location) : 
	$lang eq $QL_N3 ? new W3C::Rdf::N3Parser($algaeString, $self, $location) : 
	$lang eq $QL_RDQL ? new W3C::Rdf::RdqlParser($algaeString, $self, $location) : 
	$lang eq $QL_SeRQL ? new W3C::Rdf::SeRQLParser($algaeString, $self, $location) : 
	$lang eq $QL_SPARQL ? new W3C::Rdf::SparqlParser($algaeString, $self, $location, %flags) : 
	&throw(new W3C::Util::Exception(-message => "unknown query language \"$lang\""));
    $p->YYData->{-namespaceHandler} = $flags{-namespaceHandler} || new W3C::Util::NamespaceHandler(-relay => $self->{-namespaceHandler});
    $self->{Actions} = $p->parse($flags{-debug});
    if ($flags{-actions}) {
	push (@{$flags{-actions}}, @{$self->{Actions}});
    }
    if ($self->getParserMode()) {
	return;
    }

    # print '('.&W3C::Rdf::AlgaeCompileTree::format(join ("\n", map {$_->toString} @{$self->{Actions}}), ' ').")\n";

    # Make sure we aren't required to support semantics we don't understand.
    my $profilesCopy = {%{$self->{PROFILES}}};
    # Remove supported profiles from our list.
    delete $profilesCopy->{$PROFILE_core};
    delete $profilesCopy->{$PROFILE_assert};
    delete $profilesCopy->{$PROFILE_delete};
    delete $profilesCopy->{$PROFILE_pattern};
    delete $profilesCopy->{$PROFILE_profQuery};
    delete $profilesCopy->{$PROFILE_provStuff};

    if (%$profilesCopy) {
	&throw(new W3C::Rdf::ExtensionsNotSupportedException(-uris => [keys %$profilesCopy]));
    }

    # Execute the actions.
    foreach my $action (@{$self->{Actions}}) {
	# print join("\n", $action->toString()),"\n";
	$action->delayedEvaluate($self->{RESULT_SET}, {}, undef, $self->getSourceAttribution(1));
    }
    delete $self->{Actions};

    # $self->getTemplateDB->toString(undef, -brief => 1);
    return $self->getReport();
}
sub getActions {
    my ($self) = @_;
    return $self->{Actions};
}
sub toString {
    my ($self, $precTable, $parentPrec) = @_;
    my $flagsStr = $self->{FLAGS} ? " FLAGS: ".join(' ', @{$self->{FLAGS}}) : '';
    return "$self:$flagsStr resultSet\n".$self->{RESULT_SET}->toString({-firstTitle => "interpretAlgae"})."\n";
}

# Cute whistle to dump the query to a file as toDot or toString format.
sub dumpStuff {
    my ($self, $category, $serializer, @args) = @_;
    if (exists $self->{DEFAULT_PARMS}{"dump${category}Mode"}) {
	my $outUrlStr = '-'; # file:///dev/tty
	if (my $object = $self->{DEFAULT_PARMS}{"dump${category}URL"}) {
	    if ($object->isa('W3C::Rdf::AlgaeCompileTree::StaticPOS')) {
		$object = $object->val;
	    }
	    $outUrlStr = $object->getUri;
	}
	my $outUrl = URI::new('URI', $outUrlStr);
	if ($outUrl->scheme eq 'file' && ! -e $outUrl->path && ! open(TMP, '>', $outUrl->path)) {
	    &throw(new W3C::Util::FileCreationException(-filename => $outUrl->path));
	}
	my $outHandle = &W3C::Rdf::RdfApp::getInputSource($outUrlStr, {});
	if (my $object = $self->{DEFAULT_PARMS}{"dump${category}Mode"}) {
	    if ($object->isa('W3C::Rdf::AlgaeCompileTree::StaticPOS')) {
		$object = $object->val;
	    }
	    if ($object->getUri eq 'http://www.w3.org/1999/02/26-modules/algae#DOT') {
		$outHandle->setByteStream($serializer->serializeDot($category, @args), undef);
	    } else {
		&throw(new W3C::Util::Exception(-message => ""));
	    }
	} else {
	    $outHandle->setByteStream($serializer->serializeString($category, @args)."\n", undef);
	}
    }

}
sub serializeString {
    my ($self, $category, $expr, $precTable, $parentPrec) = @_;
    return $expr->toString($precTable, $parentPrec);
}
sub serializeDot {
    my ($self, $category, $expr, $precTable, $parentPrec) = @_;
    my $dot = $category eq 'Query' ? $expr->toDot : $expr->toGraph;
    return "digraph dotfile{ 
node [fontname=arial,fontsize=10,color=Black,fontcolor=Blue];
edge [fontname=arial,fontsize=10,color=Darkgreen,fontcolor=Red];
rankdir=TB;

$dot
}

";
}
# </ACCESSORS>

# <ACTIONs>
sub ask {
    my ($self, $expr, $optDbSpec) = @_;
    my $db = $optDbSpec ? $optDbSpec : $self->getDefaultDB;
    my $ret = new W3C::Rdf::AlgaeCompileTree::Ask($expr, $db, $self->getDefaultDB(), $self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}

sub askAll {
    my ($self, $expr, $var, $ctorFunc) = @_;
    my $sourceList = [grep {$_ ne ''} keys %{$self->{-sources}}];
    my $ret = new W3C::Rdf::AlgaeCompileTree::AskAll($expr, $sourceList, $var, $ctorFunc, $self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}

sub assert {
    my ($self, $expr, $optDbSpec) = @_; # !!! $expr may be undef
    my $db = $optDbSpec ? $optDbSpec : $self->getDefaultDB;
    my $ret = new W3C::Rdf::AlgaeCompileTree::Assert($expr, $db, $self->getDefaultDB(), $self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    if ($self->{LANG} eq $QL_ALGAE && !exists $self->{PROFILES}{$PROFILE_assert}) {
	&throw(new W3C::Util::UnsafeEvaluationException(-message => "require <$PROFILE_assert> required for assert functionality"));
    }
    return $ret;
}

sub attach {
    my ($self, $type, $name, $bindings) = @_;
    my $ret = new W3C::Rdf::AlgaeCompileTree::Attach($type, $name, $self->_getParms($bindings), $self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}

sub base {
    my ($self, $base) = @_;
    my $ret = new W3C::Rdf::AlgaeCompileTree::Base($base, $self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}

sub bindings {
    my ($self, $vars, $bindings) = @_;
    my $ret = new W3C::Rdf::AlgaeCompileTree::Bindings($vars, $bindings, $self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}

sub clear {
    my ($self) = @_;
    my $ret = new W3C::Rdf::AlgaeCompileTree::Clear($self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}

sub collect {
    my ($self, $nodes, $distinct) = @_;
    my $ret = new W3C::Rdf::AlgaeCompileTree::Collect($nodes, $distinct, $self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}

sub collectStar {
    my ($self, @parms) = @_;
    my $ret = new W3C::Rdf::AlgaeCompileTree::CollectStar(@parms);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}

sub SPARQLask {
    my ($self) = @_;
    my $ret = new W3C::Rdf::AlgaeCompileTree::SPARQLAsk($self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}

sub delete {
    my ($self, $expr, $optDbSpec) = @_; # !!! $expr may be undef
    my $db = $optDbSpec ? $optDbSpec : $self->getDefaultDB;
    my $ret = new W3C::Rdf::AlgaeCompileTree::Delete($expr, $db, $self->getDefaultDB(), $self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    if ($self->{LANG} eq $QL_ALGAE && !exists $self->{PROFILES}{$PROFILE_delete}) {
	&throw(new W3C::Util::UnsafeEvaluationException(-message => "require <$PROFILE_delete> required for delete functionality"));
    }
    return $ret;
}

sub describe {
    my ($self, $nodes) = @_;
    my $ret = new W3C::Rdf::AlgaeCompileTree::Describe($nodes, $self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}

sub describeStar {
    my ($self) = @_;
    my $ret = new W3C::Rdf::AlgaeCompileTree::DescribeStar($self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}

sub defaultGraph {
    my ($self, $sourceSelector, @exprParms) = @_;
    return $self->_graph(0, $sourceSelector, @exprParms);
}

sub namedGraph {
    my ($self, $sourceSelector, @exprParms) = @_;
    return $self->_graph(1, $sourceSelector, @exprParms);
}

our $SqlDB = qw(http://www.w3.org/2003/01/21-RDF-RDB-access/ns#SqlDB);
our $FedDB = qw(http://www.w3.org/1999/02/26-modules/algae#federated);

sub _graph {
    my ($self, $named, $sourceSelector, @exprParms) = @_;
    my @bindings;
    my $type = new W3C::Rdf::AlgaeCompileTree::Url('http://www.w3.org/1999/02/26-modules/algae#ephemeral', undef, @exprParms);
    my $read = 0;
    if ($sourceSelector->getUrl =~ m/^(\Q$SqlDB\E|\Q$FedDB\E)\??(.*)$/) {
	$type = new W3C::Rdf::AlgaeCompileTree::Url($1, undef, @exprParms);
	my @parms = split('&', $2);
	require CGI;
	foreach my $parm (@parms) {
	    my ($name, $value) = map {&CGI::unescape($_)} (split('=', $parm));
	    my $literal = new W3C::Rdf::AlgaeCompileTree::Literal($value, undef, undef, @exprParms);
	    push (@bindings, new W3C::Rdf::AlgaeCompileTree::Binding($name, $literal, @exprParms));
	}
    } else {
	$read = 1;
    }
    my $simpleUrl = new W3C::Rdf::AlgaeCompileTree::Url($sourceSelector->getUrl, undef, @exprParms);
    my $parms = $self->_getParms(\ @bindings);
    my $ret = undef;
    if ($named || !$read) {
	$ret = new W3C::Rdf::AlgaeCompileTree::Attach($type, $simpleUrl, $parms, $self);
    }
    if ($read) {
	my $db = $named ? 
	    $self->getSourceByName($sourceSelector->getUrl) : # default graph
	    $self->getDefaultDB; # graph newly created by Attach constructor.
	my $read = new W3C::Rdf::AlgaeCompileTree::Slurp($sourceSelector, $parms, $db, $self->{-rdfApp}, $self);
	$read->immediateEvaluate($self->{RESULT_SET});
    }
    return $ret;
}

sub host {
    my ($self, $nodes) = @_;
    my $ret = new W3C::Rdf::AlgaeCompileTree::Host($nodes, $self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}

sub flags {
    my ($self, $bindings, $setOp) = @_;
    my $ret = new W3C::Rdf::AlgaeCompileTree::Flags($bindings, $setOp, $self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}

sub fwrule {
    my ($self, $body, $head) = @_;
    my $ret = new W3C::Rdf::AlgaeCompileTree::FwRule($body, $head, $self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}

sub namespace {
    my ($self, $prefix, $ns) = @_;
    my $ret = new W3C::Rdf::AlgaeCompileTree::NamespaceDecl($prefix, $ns->getUrl, $self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}

sub pattern {
    my ($self, $expr, $optDbSpec) = @_; # !!! $expr may be undef
    my $db = $optDbSpec ? $optDbSpec : $self->getDefaultDB;
    my $ret = new W3C::Rdf::AlgaeCompileTree::Pattern($expr, $db, $self->getDefaultDB(), $self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    if ($self->{LANG} eq $QL_ALGAE && !exists $self->{PROFILES}{$PROFILE_pattern}) {
	&throw(new W3C::Util::UnsafeEvaluationException(-message => "require <$PROFILE_pattern> required for assert functionality"));
    }
    return $ret;
}

sub slurp {
    my ($self, $src, $bindings, $optDbSpec) = @_;
    my $db = $optDbSpec ? $optDbSpec : $self->getDefaultDB;
    my $ret = new W3C::Rdf::AlgaeCompileTree::Slurp($src, $self->_getParms($bindings), $db, $self->{-rdfApp}, $self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}

sub require {
    my ($self, $url) = @_;
    my $ret = new W3C::Rdf::AlgaeCompileTree::Require($url, $self);
    $ret->immediateEvaluate($self->{RESULT_SET}); # @@@ for consistency
    $self->{PROFILES}{$url->getUrl} = $ret;
    return $ret;
}

sub _getParms {
    my ($self, $bindings) = @_;
    my $parms = {-atomDictionary => $self->{-atomDictionary}, 
		 -errorHandler => $self->{-errorHandler}, 
		 -lazyReification => 1, # some defaults
		 %{$self->{DEFAULT_PARMS}}};

    foreach my $binding (@$bindings) {
	my ($attr, $value) = ($binding->{NAME}, $binding->{VALUE});
	$parms->{'-'.$attr} = $value->val;
    }
    return $parms;
}
# </ACTIONs>

# <supported profiles>
# profileQuery
sub profileQuery {
    my ($self, $class, $variable) = @_;
    my $ret = new W3C::Rdf::AlgaeCompileTree::ProfileQuery($class, $variable, $self);
    $ret->immediateEvaluate($self->{RESULT_SET});
    return $ret;
}
# </supported profiles>

# <ACTION Acessors>
sub getResultSet {$_[0]->{RESULT_SET}}

#sub getCollects {$_[0]->{COLLECTS}}
sub getHostSymbols {$_[0]->{HOST_symbols}}
sub getDefaultParms {$_[0]->{DEFAULT_PARMS}}
sub getLabels {$_[0]->{LABELS}}
sub addLabel {
    my ($self, $label, $value) = @_;
    push (@{$self->{LABELS}}, $label);
    $self->{RESULT_SET}->addSelect($value);
}
sub maybeHost {
    my ($self, $atom, $qp) = @_;
    if (exists $self->{HOST_symbols}{$qp->toString}) {
	my $ret = $self->{HOST_symbols}{$atom};
	if (!$ret) {
	    $ret = $self->{-atomDictionary}->getUriName("host_$self->{HOST_index}", $self->{-sourceAttribution}->getSource());
	    $self->{HOST_index}++;
	    # print "changed ".$atom->toString." to ".$ret->toString."\n";
	    $self->{HOST_symbols}{$atom} = $ret;
	    $atom = $ret;
	}
    }
    return $atom;
}
# </ACTION Acessors>

# <Database sources-related stuff>
sub getDefaultDB {$_[0]->{-rdfDB}}

sub addSource {
    my ($self, $name, $source) = @_;
    if (UNIVERSAL::can($name, 'getUrl')) {&throw(new W3C::Util::ProgramFlowException())}
    $self->{-sources}{$name} = $source;
    $self->{-source2name}{$source} = $name;
}
sub getSourceNames {
    my ($self) = @_;
    return keys %{$self->{-sources}};
}
sub getSourceByName {
    my ($self, $name) = @_;
    if (UNIVERSAL::can($name, 'getUrl')) {&throw(new W3C::Util::ProgramFlowException())}
    if (exists $self->{-sources}{$name}) {
	return $self->{-sources}{$name};
    } elsif ($self->getParserMode()) {
	return undef;
    } else {
	&throw(new W3C::Util::Exception(-message => "database \"$name\" not known"));
    }
}
sub getNameBySource {
    my ($self, $db) = @_;
    if (exists $self->{-source2name}{$db}) {
	return $self->{-source2name}{$db};
    } else {
	&throw(new W3C::Util::Exception(-message => "database \"$db\" not known"));
    }
}
sub dropSource {
    my ($self, $name) = @_;
    my $delme = $self->{-sources}{$name ? $name : ''} || 
	&throw(new W3C::Util::Exception(-message => (ref $name).' '.$name.' database not known'));
    delete $self->{-sources}{$name};
    delete $self->{-source2name}{$name};
}
sub getSourceAttribution {
    my ($self, $nullOK) = @_;
    $self->{-sourceAttribution} ? 
	$self->{-sourceAttribution} : 
	$nullOK ? undef : 
	&throw(new W3C::Util::Exception(-message => "need an attribution -- hint: where are the statements coming from?"));
}
sub setSourceAttribution {
    my ($self, $attrib) = @_;
    $self->{-sourceAttribution} = $attrib;
}
sub getTemplateDB {
    my ($self) = @_;
    if (!$self->{-templateDB}) {
	$self->{-templateDB} = new W3C::Rdf::RdfDB(-atomDictionary => $self->{-atomDictionary});
    }
    return $self->{-templateDB};
}
sub clearTemplateDB {
    my ($self) = @_;
    $self->{-templateDB} = undef;
}
# </Database sources-related stuff>

sub getParserMode {
    my ($self) = @_;
    return $self->{ParserMode};
}

sub setParserMode {
    my ($self, $parserMode) = @_;
    return $self->{ParserMode} = $parserMode;
}

# <QUERY>
sub getReport {
    my ($self) = @_;
    my ($nodes, $statements) = $self->{RESULT_SET}->gatherCollect;
    return ($nodes, $self->{LABELS}, $self->{RESULT_SET}->getMessages(), $statements);
}

sub bNodeClosure {
    my ($self, $resultSet, $lookfor) = @_;
    my $db = $self->getDefaultDB();
    for (my $e = $resultSet->elements; $e->hasMoreElements;) {
	my $row = $e->nextElement;
	my $atom = ref $lookfor eq 'SCALAR'? $row->get($$lookfor) : $lookfor;
	my $proofs = $db->bNodeClosure($atom, {});
	$row->addProofs($proofs);
	foreach my $proof (@$proofs) {
	    $self->getTemplateDB()->addTriple($proof);
	}
    }
}

# </QUERY>

# <COMPARE>
my $Str = "${XSD}string";
my $MFX = 'http://jena.hpl.hp.com/2005/05/test-manifest-extra#';
my $RDFS = 'http://www.w3.org/TR/rdf-schema/#';

my $NumericOps = {
    '+'=>sub {$_[0]+$_[1]}, 
    '-'=>sub {$_[0]-$_[1]}, 
    '*'=>sub {$_[0]*$_[1]}, 
    '/'=>sub {$_[0]/$_[1]}, 
};

$NativeTypes = {
    "${XSD}boolean"=> { -baseTypes => "${XSD}boolean", 
			-normalizers => \&Boolean_to_Num, 
			-comparators => \&NumericCmp, 
			-ebv => \&BooleanEBV },

    "${XSD}string"=> { -baseTypes => "${XSD}string", 
		       -normalizers => \&Quote, 
		       -comparators => \&StringCmp, 
		       -ebv => \&StringEBV },

    "${XSD}dateTime"=> { -baseTypes => "${XSD}dateTime",
			 -normalizers => \&DateTime_to_CTime, 
			 -comparators => \&NumericCmp },

    # Numeric:
    "${XSD}double"=> { -baseTypes => "${XSD}double", 
		       -normalizers => \&NumericNorm, 
		       -comparators => \&NumericCmp, 
		       -operators => $NumericOps, 
		       -ebv => \&NumericEBV, 
		       -promotions => 4 },
    "${XSD}float"=> { -baseTypes => "${XSD}float", 
		      -normalizers => \&NumericNorm, 
		      -comparators => \&NumericCmp, 
		      -operators => $NumericOps, 
		      -ebv => \&NumericEBV, 
		      -promotions => 3 },
    "${XSD}decimal"=> { -baseTypes => "${XSD}decimal", 
			-normalizers => \&NumericNorm, 
			-comparators => \&NumericCmp, 
			-operators => $NumericOps, 
			-ebv => \&NumericEBV, 
			-promotions => 2 },

    #   derived from integer:
    "${XSD}integer"=> { -baseTypes => "${XSD}integer", 
			-normalizers => \&NumericNorm, 
			-comparators => \&NumericCmp, 
			-operators => $NumericOps, 
			-ebv => \&NumericEBV, 
			-promotions => 1 },
    "${XSD}nonPositiveInteger"=> { -baseTypes => "${XSD}integer", 
				   -normalizers => \&NumericNorm },
    "${XSD}negativeInteger"=> { -baseTypes => "${XSD}integer", 
				-normalizers => \&NumericNorm },
    "${XSD}long"=> { -baseTypes => "${XSD}integer", 
		     -normalizers => \&NumericNorm },
    "${XSD}int"=> { -baseTypes => "${XSD}integer", 
		    -normalizers => \&NumericNorm },
    "${XSD}short"=> { -baseTypes => "${XSD}integer", 
		      -normalizers => \&NumericNorm },
    "${XSD}byte"=> { -baseTypes => "${XSD}integer", 
		     -normalizers => \&NumericNorm },
    "${XSD}nonNegativeInteger"=> { -baseTypes => "${XSD}integer", 
				   -normalizers => \&NumericNorm },
    "${XSD}unsignedLong"=> { -baseTypes => "${XSD}integer", 
			     -normalizers => \&NumericNorm },
    "${XSD}unsignedInt"=> { -baseTypes => "${XSD}integer", 
			    -normalizers => \&NumericNorm },
    "${XSD}unsignedShort"=> { -baseTypes => "${XSD}integer", 
			      -normalizers => \&NumericNorm },
    "${XSD}unsignedByte"=> { -baseTypes => "${XSD}integer", 
			     -normalizers => \&NumericNorm },
    "${XSD}positiveInteger"=> { -baseTypes => "${XSD}integer",
				-normalizers => \&NumericNorm },
};

use vars qw($TypeExtensions);
$TypeExtensions = {
    "${XSD}date" => { -baseTypes => "${XSD}date", 
		      -normalizers => \&Date_to_CTime, 
		      -comparators => \&NumericCmp }, 
};

my $LogicExtensions = {
    "${MFX}StringSimpleLiteralCmp" => 1, 
    "${MFX}LangCaseInsensitivity" => 1, 
    "${MFX}KnownTypesDefault2Neq" => 1, 
    "${MFX}xsd-date-eq-xsd-dateTime" => { 
	"${XSD}date" => { -baseTypes => "${XSD}dateTime", 
			  -normalizers => \&Date_to_CTime } }, 
    "${MFX}LeGeIncludeEq" => 1, 
    'http://jena.hpl.hp.com/ARQ/list#member' => 1, 
    "${RDFS}ch_member" => 1, 
};

sub addTypes {
    my ($self, $typeHash, @types) = @_;
    my $unmatchedExtensions = [];
    foreach my $type (@types) {
	if (my $typeExtension = $typeHash->{$type}) {
	    foreach my $key (keys %$typeExtension) {
		$self->{$key}{$type} = $typeExtension->{$key};
	    }
	} elsif (my $ext = $LogicExtensions->{$type}) {
	    if (ref $ext) {
		$self->addTypes($ext, keys %$ext);
	    } else {
		$self->{-logicExtensions}{$type} = $ext;
	    }
	} else {
	    push (@$unmatchedExtensions, $type);
	}
    }
    if (@$unmatchedExtensions) {
	&throw(new W3C::Rdf::ExtensionsNotSupportedException(-uris => $unmatchedExtensions));
    }
}

sub delTypes {
    my ($self, @types) = @_;
    foreach my $type (@types) {
	if (my $typeExtension = $TypeExtensions->{$type}) {
	    foreach my $key (keys %$typeExtension) {
		if (exists $NativeTypes->{$type}{$key}) {
		    $self->{$key}{$type} = $NativeTypes->{$type}{$key};
		} else {
		    delete $self->{$key}{$type};
		}
	    }
	} elsif (my $ext = $LogicExtensions->{$type}) {
	    if (ref $ext) {
		$self->delTypes(keys %$ext);
	    } else {
		delete $self->{-logicExtensions}{$type};
	    }
	} else {
	    &throw(new W3C::Util::Exception(-message => "unsupported extension \"$type\""));
	}
    }
}

sub getNumericBaseType {
    my ($self, $atom) = @_;
    my $dtu;
    if (my $dt = $atom->getDatatype) {
	$dtu = $dt->getUri;
    } else {
	&throw(new W3C::Rdf::IncorrectTypeException(-type => 'plain literal', -function => '_val1'));
    }
    if (my $bt = $self->{-baseTypes}{$dtu}) {
	my $normalizer = $self->{-normalizers}{$dtu} || &throw(new W3C::Util::NotImplementedException(-function => "W3C::Rdf::Algae2::normalize($dtu)"));
	return ($bt, &$normalizer($atom->getString));
    } else {
	&throw(new W3C::Rdf::UnknownTypeException(-type => $dtu, -function => '_val1'));
    }
}

sub compare {
    my ($self, $l, $r) = @_;
    if ($l == $r) {
	return 0;
    }
    if (!$l->getLang && !$r->getLang && 
	!$l->getDatatype && !$r->getDatatype) {
	# A = B  	simple literal	simple literal
	return $l->getString cmp $r->getString;
    }
    if ($l->getDatatype && $l->getDatatype->getUri eq "${XSD}string" && 
	$r->getDatatype && $r->getDatatype->getUri eq "${XSD}string") {
	# A = B  	xsd:string	xsd:string
	return $l->getString cmp $r->getString;
    }
    if ($self->{-logicExtensions}{"${MFX}StringSimpleLiteralCmp"} &&
	!$l->getLang && (!$l->getDatatype || $l->getDatatype->getUri eq "${XSD}string") && 
	!$r->getLang && (!$r->getDatatype || $r->getDatatype->getUri eq "${XSD}string")) {
	return $l->getString cmp $r->getString;
    }
    my ($lBt, $lNorm) = $self->getNumericBaseType($l);
    my ($rBt, $rNorm) = $self->getNumericBaseType($r);
    if ($lBt ne $rBt) {
	if ($self->{-promotions}{$lBt} && $self->{-promotions}{$rBt}) {
	    if ($self->{-promotions}{$lBt} > $self->{-promotions}{$rBt}) {
		$rBt = $lBt;
	    } else {
		$lBt = $rBt;
	    }
	} else {
	    &throw(new W3C::Rdf::IncorrectTypeException(-type => "$lBt|$rBt", -function => 'compare'));
	}
    }
    my $comp = $self->{-comparators}{$lBt};
    return &$comp($lNorm, $rNorm);
}

sub binaryArith {
    my ($self, $opStr, $l, $r) = @_;
    my ($lBt, $lNorm) = $self->getNumericBaseType($l);
    my ($rBt, $rNorm) = $self->getNumericBaseType($r);
    if ($lBt ne $rBt) {
	if ($self->{-promotions}{$lBt} && $self->{-promotions}{$rBt}) {
	    if ($self->{-promotions}{$lBt} > $self->{-promotions}{$rBt}) {
		$rBt = $lBt;
	    } else {
		$lBt = $rBt;
	    }
	} else {
	    &throw(new W3C::Rdf::IncorrectTypeException(-type => "$lBt|$rBt", -function => '+-*/'));
	}
    }
    my $op = $self->{-operators}{$lBt}{$opStr};
    if (!$op) {
	&throw(new W3C::Rdf::IncorrectTypeException(-type => $lBt, -function => $opStr));
    }
    my $val = &$op($lNorm, $rNorm);
    my $dt = $self->{-atomDictionary}->getAbsoluteUri($lBt);
    return $self->{-atomDictionary}->getString($val, $dt, 'PLAIN', undef);
}

sub getEBV {
    my ($self, $atom) = @_;
    if (UNIVERSAL::isa($atom, 'W3C::Rdf::String')) {
	# follow <http://www.w3.org/2001/sw/DataAccess/rq23/rq24#ebv>
	my $dt;
	my $dtAtom = $atom->getDatatype;
	my $bt = $self->{-baseTypes}{$dtAtom ? $dtAtom->getUri : $Str};
	if (!$bt) {
	    &throw(new W3C::Rdf::UnknownTypeException(-type => $bt, -function => 'getEBV'));
	}
	my $f = $self->{-ebv}{$bt};
	if (!$f) {
	    &throw(new W3C::Rdf::IncorrectTypeException(-type => $bt, -function => '_val1'));
	}
	return &$f($atom);
    }
    &throw(new W3C::Rdf::IncorrectTypeException(-type => ref $atom, -function => 'EBV')); # return 1;
}

sub Quote {$_[0]}
sub NumericNorm {
    my ($str) = @_;
    if ($str !~ m/^(?:0x[0-9a-f]+)|(?:[0-9\.]+)$/) {
	&throw(new W3C::Util::SafeEvaluationException(-message => "\"$str\" is not a numeric form"));
    }
    return $str;
}
sub NumericCmp {$_[0] <=> $_[1]}
sub StringCmp {$_[0] cmp $_[1]}

sub Boolean_to_Num {
    my ($str) = @_;
    return 1 if ($str eq 'true' || $str eq '1');
    return 0 if ($str eq 'false' || $str eq '0');
    &throw(new W3C::Util::SafeEvaluationException(-message => "\"$str\" is not a boolean form"));    
};
sub DateTime_to_CTime {
    my ($str) = @_;
    if ($str !~ m/\A
	([\-+]?)	# optional sign @@ perhaps not supported by time(2)
	(\d{4,})	# 2004
	-(\d{2})	#     -12
	-(\d{2})	#        -31
	T(\d{2})	#           T19
	:(\d{2})	#              :01
	(?::(\d{2}))?	#                 :00
	(?:Z | 		#                    Z
	 (?:([+\-])	#                    -
	  (\d{2})	#                     05
	  :(\d{2})	#                       :00
	  ))\Z/x) {	# 2004-12-31T19:01:00-05:00
	&throw(new W3C::Util::SafeEvaluationException(-message => "\"$str\" is not an ISO 8601 representation"));
    }
    my ($sign, $y, $mon, $d, $h, $min, $s, $offSign, $offH, $offM) = 
	($1, $2, $3, $4, $5, $6, $7, $8, $9, $10);
    require Time::Local;
    my $time = &Time::Local::timegm($s, $min, $h, $d, $mon-1, $y);
    if (defined $offH) {
	my $off = $offM*60 + $offH*60*60;
	$time = $offSign eq '-' ? $time + $off : $time - $off;
    }
    return $sign eq '-' ? - $time : $time;
}

sub Date_to_CTime {
    my ($str) = @_;
    if ($str !~ m/\A
	([\-+]?)	# optional sign @@ perhaps not supported by time(2)
	(\d{4,})	# 2004
	-(\d{2})	#     -12
	-(\d{2})	#        -31
	(?:Z | 		#                    Z
	 (?:([+\-])	#                    -
	  (\d{2})	#                     05
	  :(\d{2})	#                       :00
	  ))?\Z/x) {	# 2004-12-31         -05:00
	&throw(new W3C::Util::SafeEvaluationException(-message => "\"$str\" is not an ISO 8601 representation"));
    }
    my ($sign, $y, $mon, $d, $h, $min, $s, $offSign, $offH, $offM) = 
	($1,   $2, $3,   $4,  0,  0,    0, $8,       $9,    $10);
    require Time::Local;
    my $time = &Time::Local::timegm($s, $min, $h, $d, $mon-1, $y);
    if (defined $offH) {
	my $off = $offM*60 + $offH*60*60;
	$time = $offSign eq '-' ? $time + $off : $time - $off;
    }
    return $sign eq '-' ? - $time : $time;
}

sub BooleanEBV {
    my ($atom) = @_;
    my $str = $atom->getString;
    if ($str !~ m/^(?:0|1|false|true)$/i) {
	&throw(new W3C::Util::ProgramFlowException(-message => "\"$str\" not boolean-EBV-able"));
    }
    return $str eq 'true' || $str eq '1';
}

sub StringEBV {
    my ($atom) = @_;
    my $strVal = $atom->getString;
    return length $strVal > 0;
}

sub NumericEBV {
    my ($atom) = @_;
    my $strVal = $atom->getString;
    return $strVal != 0;
}

# </COMPARE>

# <ARITH>
# </ARITH>

1;

__END__

=head1 NAME

W3C::Rdf::Algae2 - a parser/evaluator for the algae2 language

=head1 SYNOPSIS

  use W3C::Rdf::Atoms;
  use W3C::Rdf::RdfDB;
  use W3C::Util::NamespaceHandler;
  use W3C::Rdf::Algae2;

  my $atoms = new W3C::Rdf::Atoms();
  my $db = new W3C::Rdf::RdfDB(-atomDictionary => $atoms);
  my $nsh = new W3C::Util::NamespaceHandler();
  my $url = $atoms->getUri(new_abs URI($0, 'file://localhost/some/path'));
  $attrib = $atoms->getGroundFactAttribution($url, undef, undef, undef);
  my $queryHandler = new W3C::Rdf::Algae2($atoms
					  $nsh, 
					  {'' => $self}, $self, 
					  $attrib, 
					  {-uniqueResults => 1}, 
					  -rdfDB => $db);
  my ($nodes, $selects, $messages, $proofs) = 
      $queryHandler->interpret('ask (...)', $self->{-location}, $QL_ALGAE);

=head1 DESCRIPTION

The Algae2 modules uses a parser to generated an AlgaeCompileTree. Algae2
calls the compile tree to perforn queries/assertions/rules.

This module is part of the W3C::Rdf CPAN module.

=head1 METHODS

=head2 new

    $atomDictionary, $namespaceHandler, 
	$sources, $rdfApp, $sourceAttrib, $flags

returns a new Algae2 object

=head2 interpret

    $algaeString, $location, $lang

returns: a list with the following elements

  1 array of tuples of bindings
  2 list of selected variables
  3 list of human-readable messages that occured during processing
  4 array of RdfDBs with the supporting statements for each tuple

=head1 AUTHOR

Eric Prud'hommeaux <eric@w3.org>

=head1 SEE ALSO

L<W3C::Rdf::RdfDB>
L<W3C::Rdf::AlgaeCompileTree>

=cut
