use strict;

use XML::SAX::ParserFactory;
use W3C::SPDL::WSDL;
use W3C::XML::HandlerStack;
use W3C::Rdf::SPAT;


# <VarNode>
#   Overload BNodes to express variables.
package W3C::Rdf::VarNode;
@W3C::Rdf::VarNode::ISA = qw(W3C::Rdf::BNode);
sub new {
    my ($proto, $name, $attribution) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($attribution);
    $self->{ID} .= ".var.$name";
    return $self;
}
package W3C::Rdf::AlgaeCompileTree::VarNode;
@W3C::Rdf::AlgaeCompileTree::VarNode::ISA = qw(W3C::Rdf::AlgaeCompileTree::StaticPOS);
sub new {
    my ($proto, $name, @exprParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@exprParms);
    $self->{INTERNED} = new W3C::Rdf::VarNode($name->symbol(), $self->{ALGAE2}->getSourceAttribution);
    return $self;
}
sub toString {
    my ($self, %flags) = &main::_defaultPrec(@_);
    return $self->{INTERNED}->toString(%flags);
}
# </VarNode>


# <XPathNode>
#   Overload BNodes to express XPath variables.
package W3C::Rdf::XPathNode;
@W3C::Rdf::XPathNode::ISA = qw(W3C::Rdf::BNode);
sub new {
    my ($proto, $name, $context, $attribution) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($attribution);
    $self->{ID} .= ".XPath($name, $context)";
    return $self;
}

package W3C::Rdf::AlgaeCompileTree::XPathNode;
@W3C::Rdf::AlgaeCompileTree::XPathNode::ISA = qw(W3C::Rdf::AlgaeCompileTree::StaticPOS);
sub new {
    my ($proto, $name, @exprParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@exprParms);
    $self->{INTERNED} = new W3C::Rdf::XPathNode($name->{STRING}, $name->{ContextStr}, $self->{ALGAE2}->getSourceAttribution);
    return $self;
}
sub toString {
    my ($self, %flags) = &main::_defaultPrec(@_);
    return $self->{INTERNED}->toString(%flags);
}

package W3C::Rdf::AlgaeCompileTree::Conjunction;
sub XPathsToBNodes {
    my ($self, $attrib) = @_; my $class = ref $self;
    my $newLR = [map {$_->XPathsToBNodes($attrib)} $self->{LEFT}, $self->{RIGHT}];
    return $class->new(@$newLR, $self->{PARSER});
}

package W3C::Rdf::AlgaeCompileTree::Decl;
sub XPathsToBNodes {
    my ($self, $attrib) = @_; my $class = ref $self;
    my $newParts = [map {$_->isa('W3C::Rdf::AlgaeCompileTree::XPath') ? 
			     new W3C::Rdf::AlgaeCompileTree::XPathNode($_, $self->{PARSER}) : 
			     $_} @{$self->{PARTS}}];
    return $class->new($newParts, $self->{CONSTRAINTS}, $self->{PARSER});
}
# </XPathNode>


# <ServiceRule>
package W3C::SPDL::ServiceRule;
@W3C::SPDL::ServiceRule::ISA = qw(W3C::Rdf::AlgaeCompileTree::FwRule);
sub new {
    my ($proto, $body, $head, @exprParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($body, $head, @exprParms);
    $self->{Invoker} = undef;
    return $self;
}
sub setInvoker {
    my ($self, $invoker) = @_;
    $self->{Invoker} = $invoker;
}
sub getInvoker {
    my ($self) = @_;
    return $self->{Invoker};
}
# </ServiceRule>


# <RdfDB>
#   Overload of W3C::Rdf::RdfDB to match VarNodes and XPathNodes
package W3C::SPDL::RdfDB;
use W3C::Rdf::RdfDB;
@W3C::SPDL::RdfDB::ISA = qw(W3C::Rdf::RdfDB);

sub triplesMatching {
    my ($self, $view, $lookFors, %flags) = @_;
    my $ret = {};

  TRIPLE:
    foreach my $triple (@{$self->{TRIPLES}}) {
	foreach my $lookFor (@$lookFors) {
	    if ($self->matches($triple->getPredicate, $lookFor->[0]) &&
		$self->matches($triple->getSubject, $lookFor->[1]) &&
		$self->matches($triple->getObject, $lookFor->[2]) && 
		(!$flags{-attributions} || 
		 scalar grep {$triple->getAttribution->derivedFrom($_)} @{$flags{-attributions}})) {
		$ret->{$triple} = $triple;
		next TRIPLE; # don't bother checking the remaining lookFors, we've already added the triple
	    }
	}
    }
    return values %$ret; # sort {$b->getSubject->toString cmp $a->getSubject->toString} values %$ret;
}
sub matches {
    my ($self, $ob, $obs) = @_;
    if ($self->{-MatchNoVars} && UNIVERSAL::isa($ob, 'W3C::Rdf::VarNode')) {
	return 0;
    } elsif (!defined $obs) {
	return 1;
    } elsif (UNIVERSAL::isa($ob, 'W3C::Rdf::Uri') && 
	     $ob->getUri =~ m/^var:/) {
	return 1;
    } elsif (UNIVERSAL::isa($ob, 'W3C::Rdf::String') && 
	     $ob->getDatatype && 
	     $ob->getDatatype->getUri eq 
	     'http://dev.w3.org/cvsweb/perl/modules/W3C/Rdf/AlgaeCompileTree.pm#XPath') {
	&throw();
	return 1;
    } elsif (ref $obs eq 'ARRAY') {
	for (my $i = 0; $i < @$obs; $i++) {
	    if ($obs->[$i] == $ob) {
		return 1;
	    }
	}
	return 0;
    } else {
	return ($ob == $obs); # || ($ob->toString) eq ($obs->toString)); # !!!
    }
}
# </RdfDB>


# <ResultSet>
package W3C::Rdf::ResultSet;
sub invokeServices {
    my ($self) = @_;
    for (my $e = $self->elements; $e->hasMoreElements;) {
	my $row = $e->nextElement;
	my $fired = {}; # Which rules have been fired for this row and data.
	$self->_expandRules($row, $row->getProofDB, $fired);
    }
}
sub _expandRules {
    my ($self, $row, $db, $fired) = @_;
    my $expandedRuleWasCrucial = 0;

    foreach my $triple (sort {$a->getPredicate->getUri cmp $b->getPredicate->getUri} $db->getTriples) {
#	print $triple->toString, "\n";
	my @attribs = @{$triple->getAttributionList};
	for (my $iAttrib = 0; $iAttrib < @attribs; $iAttrib++) {
	    my $attrib = $attribs[$iAttrib];
	    next if (!UNIVERSAL::isa($attrib, 'W3C::Rdf::Attribution::Inference'));
	    next if (!UNIVERSAL::isa($attrib->{RULE}, 'W3C::SPDL::ServiceRule'));

	    # Expanding this attribution/rule; no longer proof of $triple.
	    splice (@attribs, $iAttrib, 1);
	    $iAttrib--;

	    my $invoker = $attrib->{RULE}->getInvoker();

	    # Sequester results of recursive calls to _expandRules so we can invoke each one.
	    my $miniResultSet = $row->makeResultSet; $main::miniResultSet = $miniResultSet;
	    $self->_expandRules($miniResultSet->elements->nextElement, $attrib->{FACTS}, $fired);
	    for (my $miniE = $miniResultSet->elements; $miniE->hasMoreElements;) {
		my $miniRow = $miniE->nextElement;
		my $newRow = $row->duplicate;
		$newRow->assumeNewBindings($miniRow);

		# Make sure we don't re-call the services prooving the same
		# proof chain for the same row with the same data. If a rule
		# produces several proofs for a row, only expand it once.
		my %b = $newRow->getBindings;
		my $key = join('|', map {$b{$_}} sort keys %b);
		if ($fired->{$invoker}{$key}) {
		    $newRow->eliminate;
		} else {
		    $invoker->execute($newRow, $attrib->{FACTS});
		    $fired->{$invoker}{$key} = 1;
		}
	    }
	}
	# Should re-write attribution and revoke triple if !@attribs.
	# For now, revoke solutions with such a revoked triple.
	if (!@attribs) {
	    $expandedRuleWasCrucial = 1;
	}
    }

    my $subRules = 0;
    if ($expandedRuleWasCrucial) {
	$row->eliminate;
    }
}
sub gatherCollect {
    my ($self) = @_;
    my @variables;
    my $statements = $self->_makeDB;
    if (defined $self->{TestTrue}) {
	return ([$self->{TestTrue}], []);
    }
    my $rows = $self->{Sorted} || [0..@{$self->{Results}}-1];
    for (my $rowNo = 0; $rowNo < @$rows; $rowNo++) {
	my $row = new W3C::Rdf::Result($self, $rows->[$rowNo], undef);
	my @resultRow;
	foreach my $select (@{$self->{SELECTS}}) {
	    if (defined $select) {
		if (UNIVERSAL::can($select, 'val')) {
		    my $atomValue = $select->val(undef, undef, $row);
		    if (UNIVERSAL::isa($atomValue, 'W3C::Rdf::XPathNode') && # FACTOR(SYMLINK)
			$atomValue->getId =~ m/^(\d+)\.(.*)$/ && 
			(my $val = $self->{VAR_INDEX}{$2})) {
			$atomValue = $row->get($val);
			my $str = $atomValue ? $atomValue->getString() : 'NULL';
		    }
		    # FACTOR(SYMLINK)
		    push (@resultRow, $atomValue);
		} else {
		    push (@resultRow, $row->get($select));
		}
	    } else {
		push (@resultRow, undef);	# leave column unbound
	    }
	}
	if (@{$self->{Caveats}[$rowNo]}) {
	    push (@resultRow, $self->{-atomDictionary}->getString(join(' AND ', map {$_->getMessage()} @{$self->{Caveats}[$rowNo]}), undef, 'PLAIN', undef));
	}
	push (@variables, \@resultRow);
	$statements->copyTriples($self->{STATEMENTS}[$rowNo]);
    }
    return (\@variables, [@{$self->{STATEMENTS}}]);
}
# </ResultSet>


# <toAssertion>
#   AlgaeCompileTree augmentation for expressing query patterns as assertions.
package W3C::Rdf::AlgaeCompileTree::TriplesAction;
sub toAssertion {
    my ($self, $nodeMap) = @_;
    return new W3C::Rdf::AlgaeCompileTree::Assert($self->{DECLS}->toAssertion($nodeMap), $self->getDB(), $self->getDB(), $self->{ALGAE2});
}
package W3C::Rdf::AlgaeCompileTree::GraphPattern;
sub toAssertion {
    my ($self, $nodeMap) = @_;
    return $self->{ELEMENTS}->toAssertion($nodeMap);
}
package W3C::Rdf::AlgaeCompileTree::Conjunction;
sub toAssertion {
    my ($self, $nodeMap) = @_;
    return new W3C::Rdf::AlgaeCompileTree::Conjunction($self->{LEFT}->toAssertion($nodeMap), $self->{RIGHT}->toAssertion($nodeMap), $self->{PARSER});
}
package W3C::Rdf::AlgaeCompileTree::Decl;
# Pattern support -- set result set indexes
sub toAssertion {
    my ($self, $nodeMap) = @_;
    my $parts = [];
    for (my $i = 0; $i < 3; $i++) {
	my $part = $self->{PARTS}[$i];
	if (UNIVERSAL::isa($part, 'W3C::Rdf::AlgaeCompileTree::Var')) {
	    if (exists $nodeMap->{$part->toString()}) {
		$part = $nodeMap->{$part->toString()};
	    } else {
		$part = $nodeMap->{$part->toString()} = 
		    UNIVERSAL::isa($part, 'W3C::Rdf::AlgaeCompileTree::NovelVar') ? 
		    new W3C::Rdf::AlgaeCompileTree::BNode($self->{PARSER}) : 
		    new W3C::Rdf::AlgaeCompileTree::VarNode($part, $self->{PARSER});
		    # new W3C::Rdf::AlgaeCompileTree::Url('var:'.$part->toString(), undef, $self->{PARSER});
	    }
	}
	push (@$parts, $part);
    }
    return new W3C::Rdf::AlgaeCompileTree::Decl($parts, undef, $self->{PARSER});
}
# </toAssertion>


# <Validator::Schema>
package XML::Validator::Schema::ElementNode;
use W3C::Util::Exception;
# serialize an instance
sub solve {
    my ($self, $handlers, $path, $ruleRow, $userRow, $substitutions, $nsHelper, $scopedPrefixes) = @_;
    my @ret;
    $self->name() =~ m/\{([^\}]+)\}(.+)/;
    my ($namespace, $localName) = ($1, $2);
    my $prefix = $nsHelper->getPrefix($namespace);
    my $nameStr = $prefix ? "$prefix:$localName" : $localName;
    my $newPrefixes = $scopedPrefixes->{$prefix} ? {} : {$prefix => 1}; # may get attribute namespaces added
    my $prefixesStr = %$newPrefixes ? join (' ', '', map {my $ns = $nsHelper->getURI($_); $_ ? "xmlns:$_=\"$ns\"" : "xmlns=\"$ns\""} keys %$newPrefixes) : '';

    $self->addSubstitutions($substitutions, $handlers);

    if ($substitutions->{'.'}) {
	$substitutions = $substitutions->{'.'};
    }
    foreach my $daughter ($self->daughters) {
	my $dname = $daughter->name();
	eval {
	    push (@ret, $daughter->solve($handlers, "$path/$dname", $ruleRow, $userRow, $substitutions->{$dname} ? $substitutions->{$dname} : {}, $nsHelper, {%$scopedPrefixes, %$newPrefixes}));
	}; if ($@) {if (my $ex = &catch('W3C::SPDL::RequiredPath')) {
	    if ($daughter->{min} > 0) {
		my $msg = $ex->getMessage();
		&throw(new W3C::SPDL::RequiredPath(-message => "$msg\n$dname required at $path"));
	    }
	} else {
	    &throw();
	}}
    }
    if (UNIVERSAL::isa($substitutions, 'W3C::Rdf::AlgaeCompileTree::XPath')) { # pcdata
	if (@ret) {
	    &throw(new W3C::Util::Exception(-message => "does XML Schema allow mixed content in <$nameStr>?"));
	}
	my $atomValue = $ruleRow->get($substitutions->varIndex);
	my $str;
	if (UNIVERSAL::isa($atomValue, 'W3C::Rdf::String')) {
	    $str = $atomValue->getString();
	} elsif (UNIVERSAL::isa($atomValue, 'W3C::Rdf::XPathNode') && # FACTOR(SYMLINK)
		 $atomValue->getId =~ m/^(\d+)\.(.*)$/ && 
		 (my $val = $userRow->{RESULT_SET}{VAR_INDEX}{$2})) {
	    $atomValue = $userRow->get($val);
	    $str = $atomValue->getString();
	} else {
	    print STDERR "<$nameStr$prefixesStr />";
	    print STDERR $ruleRow->toString()."\n";
	    print STDERR $userRow->toString()."\n";
	    &throw(new W3C::Util::ProgramFlowException());
	}
	my $datatypeStr = $atomValue->getDatatype ? ' xsd:datatype="'.$atomValue->getDatatype->getUri.'"' : '';
	return "<$nameStr$datatypeStr$prefixesStr>$str</$nameStr>";
    } elsif (!@ret) {
    } else {
	unshift (@ret, "<$nameStr$prefixesStr>");
	push (@ret, "</$nameStr>");
	return join(' ', @ret);
    }
}
sub addSubstitutions {
    my ($self, $substitutions, $handlers) = @_;
    if (my $handles = $self->attributes->{handles}) {
	foreach my $handle (values %$handles) {
	    if (my $xPathList = $handlers->{$handle}) {
		foreach my $xpath (@$xPathList) {
		    # print $xpath->toString, "\n";
		    $xpath->addSubstitution($substitutions);
		}
	    }
	}
    }
}

package XML::Validator::Schema;
use constant ROW => 0;
use constant COLUMNS => 1;
sub characters1 {
    my ($self, $data) = @_;
    my $element = $self->{node_stack}[-1];
    my $substitutions = $self->{substitutions_stack}->[-1];
    $element->check_contents($data->{Data}, $self->{locator});
    $element->{checked_content} = 1;

    if (UNIVERSAL::isa($substitutions, 'W3C::Rdf::AlgaeCompileTree::XPath')) { # pcdata
	my $newAtom = $substitutions->{ALGAE2}{-atomDictionary}->getString($data->{Data}, undef, 'PLAIN', undef);
	my $index = $substitutions->varIndex;
	my $currentRow = $self->{CurrentRow};
	if (!$self->{VisitedByColumn}[$index]) {
	    foreach my $row (keys %{$self->{VisitedByRow}}) {
		my $retroRow = $self->{VisitedByRow}{$row}[ROW];
		next if ($retroRow == $currentRow);
		$self->{VisitedByRow}{$row}[COLUMNS][$index] = 1;
		$retroRow->set($index, $newAtom);
	    }
	    $self->{VisitedByColumn}[$index] = 1;
	}
	if (!$self->{VisitedByRow}{$currentRow} || 
	    $self->{VisitedByRow}{$currentRow}[COLUMNS][$index]) {
	    my $nextRow = $currentRow->duplicate();
	    $nextRow->assumeNewBindings($self->{UserQueryRow});

	    # Default to the last row's values in case it's a less-repeated elt.
	    for (my $columnNo = 0; $currentRow && $columnNo < @{$self->{VisitedByColumn}}; $columnNo++) {
		if ($self->{VisitedByColumn}[$columnNo]) {
		    $nextRow->set($columnNo, $currentRow->get($columnNo));
		}
	    }

	    $self->{CurrentRow} = $currentRow = $nextRow;
	    $self->{VisitedByRow}{$currentRow} = [$currentRow, []]; # ROW, COLUMNS
	}
	$self->{VisitedByRow}{$currentRow}[COLUMNS][$index] = 1;
	$currentRow->set($index, $newAtom); $currentRow->toString();
    }

    $self->SUPER::characters($data);
}
# </Validator::Schema>


# <SPDL>
package W3C::Rdf::UnclearableResultSet;
@W3C::Rdf::UnclearableResultSet::ISA = qw(W3C::Rdf::ResultSet);
sub clearResults {}

package W3C::SPDL::Invoker;
use W3C::Util::Exception;
use W3C::Rdf::RdfApp;
use W3C::Util::ArrayUtils qw(&DecorateArray);
use Digest::MD5;

sub new {
    my ($proto, $name, $context, $nsHelper, $contextToXPaths, $contextToAction, $ins, $outs, $desc, $operationDB, $userQueryDB, $schemaValidator) = @_;
    my $class = ref($proto) || $proto;
    my $atoms = $operationDB->{-atomDictionary};
    my $resultSet = new W3C::Rdf::ResultSet(-atomDictionary => $atoms);
    my $uri = $atoms->getAbsoluteUri("qname:$name");
    my $attrib = $atoms->getGroundFactAttribution($uri, undef, undef, undef);
    my $fakeParser = new W3C::Rdf::AlgaeCompileTree::FakeParser($resultSet, 
				-atomDictionary => $atoms, 
				-sourceAttribution => $attrib);
    my $head = $outs->[0]->{DECLS}->XPathsToBNodes($attrib);
    for (my $ruleNo = 1; $ruleNo < @$outs; $ruleNo++) {
	$head = new W3C::Rdf::AlgaeCompileTree::Conjunction($head, $outs->[$ruleNo]->{DECLS}->XPathsToBNodes($attrib), $fakeParser);
    }
    $head = new W3C::Rdf::AlgaeCompileTree::Assert($head, $userQueryDB, $userQueryDB, $fakeParser);
    my $body = $ins->[0]->{DECLS};
    for (my $ruleNo = 1; $ruleNo < @$ins; $ruleNo++) {
	$body = new W3C::Rdf::AlgaeCompileTree::Conjunction($body, $ins->[$ruleNo]->{DECLS}, $fakeParser);
    }
    $body = new W3C::Rdf::AlgaeCompileTree::Ask($body, $userQueryDB, $userQueryDB, $fakeParser);
    my $rule = new W3C::SPDL::ServiceRule($body, $head, $fakeParser);
    print "┌ op $name: \n", &DecorateArray('│     ', '│     ', "\n", "\n", $rule->toString);
    my $self = {Context => $context, NSHelper => $nsHelper, 
		ContextToXPaths => $contextToXPaths, 
		ContextToAction => $contextToAction, 
		Ins => $ins, Outs => $outs, Description => $desc, 
		RdfDB => $operationDB, SchemaValidator => $schemaValidator, 
		Attribution => $attrib, ResultSet => $resultSet, 
		FakeParser => $fakeParser, Rule => $rule, 
    };
    bless ($self, $class);
    $rule->setInvoker($self);
    return $self;
}
sub addRulesToDB {
    my ($self, $userQueryDB) = @_;
    $userQueryDB->addForwardChainingRule($self->{Rule}, $self->{RdfDB}, $self->{Rule}{RULE_RESULT_SET}, $self->{Attribution});#$self->{Rule}->delayedEvaluate(undef);
}
sub execute {
    my ($self, $bindingRow, $proof) = @_;
    if ($self->{Description}{-transport} eq 'http://schemas.xmlsoap.org/soap/http') {
#		print "executing \"$query\"
#against:
#$str\n--------------------\ncollecting $collectStr\n";

	    # Construct a request with constants from componentResultSet and
	    # fill userQueryResultSet with values from the SOAP results.
	my $oldDB = $self->{Rule}{BODY}{DB_SPEC};
	$self->{Rule}{BODY}{DB_SPEC} = $proof;
	my $oldRS = $self->{Rule}{RULE_RESULT_SET};
	$self->{Rule}{RULE_RESULT_SET} = new W3C::Rdf::UnclearableResultSet(-atomDictionary => $self->{Context}{-atomDictionary});
	$self->{Rule}->delayedEvaluate(undef, {}, undef, $self->{Attribution});
	$self->{Rule}{BODY}{DB_SPEC} = $oldDB;
	my $ruleRow = $self->{Rule}{RULE_RESULT_SET}->elements()->nextElement(); # Expect only one per proof.
	$self->executeSoapQuery($ruleRow, $bindingRow);
	$self->{Rule}{RULE_RESULT_SET} = $oldRS;
    } else {
	&throw(new W3C::Util::NotImplementedException());
    }
}
sub executeSoapQuery {
    my ($self, $ruleRow, $bindingRow) = @_; # $componentResultSet, $userQueryResultSet) = @_;

    my $bodyStr = $self->{Description}{-in}->solve($self->{ContextToXPaths}, '.', $ruleRow, $bindingRow, {}, $self->{NSHelper}, {'xsi'=>1, 'SOAP-ENC'=>1, 'SOAP-ENV'=>1, 'xsd'=>1});print "$bodyStr\n";
    my $respBody = $self->getCachedResponse($bodyStr);
    my $handlerStack = new W3C::XML::HandlerStack();
    my $soapHandler = new W3C::SPDL::SOAP::Parser($self, $handlerStack, $self->{SchemaValidator});
    $self->{SchemaValidator}{ContextToXPaths} = $self->{ContextToXPaths};
    $self->{SchemaValidator}{ComponentRow} = $ruleRow;
    $self->{SchemaValidator}{UserQueryRow} = $bindingRow;
    $self->{SchemaValidator}{VisitedByRow} = {$bindingRow => [$bindingRow, []]}; # = {};
    $self->{SchemaValidator}{VisitedByColumn} = [];
    $self->{SchemaValidator}{CurrentRow} = $bindingRow;
    $handlerStack->set_handler($soapHandler);
    my $bf = XML::Filter::BufferText->new(Handler => $handlerStack);
    my $docParser = XML::SAX::ParserFactory->parser(Handler => $bf);
    $docParser->parse_string($respBody);
}
sub getCachedResponse {
    my ($self, $bodyStr) = @_;
    my $respBody;
    my $cacheName = 'cache/'.Digest::MD5::md5_hex($bodyStr);
    if (-e $cacheName) {
	if (open (RESP, '<:bytes', $cacheName)) {
	    local $/ = undef;
	    $respBody = <RESP>;
	    close RESP;
	} else {
	    print STDERR "$bodyStr\n";
	    &throw(new W3C::Util::FileOperationException(-filename => $cacheName, -operation => 'open for read'));
	}
    } else {
	use LWP::UserAgent;
	my $ua = LWP::UserAgent->new;
	$ua->agent("SPDL 0.9");

	# Create a request
	my $endpoint = $self->{Description}{-location};
	my $req = HTTP::Request->new(POST => $endpoint);
	$req->content_type('application/x-www-form-urlencoded');
	my $reqBody = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<SOAP-ENV:Envelope
  xmlns:xsi=\"http://www.w3.org/1999/XMLSchema-instance\"
  xmlns:SOAP-ENC=\"http://schemas.xmlsoap.org/soap/encoding/\"
  xmlns:SOAP-ENV=\"http://schemas.xmlsoap.org/soap/envelope/\"
  xmlns:xsd=\"http://www.w3.org/1999/XMLSchema\"
  SOAP-ENV:encodingStyle=\"http://schemas.xmlsoap.org/soap/encoding/\">
    <SOAP-ENV:Body>
        $bodyStr
    </SOAP-ENV:Body>
</SOAP-ENV:Envelope>
";
	$req->content($reqBody);
	my $res = $ua->request($req);
	if (!$res->is_success) {
	    my $status = $res->status_line;
	    &throw(new W3C::Util::Exception(-message => "error calling $endpoint: Status: $status"));
	}
	$respBody = $res->content;
	if (open (RESP, '>:bytes', $cacheName)) {
	    print RESP $res->content;
	    close RESP;
	} else {
	    &throw(new W3C::Util::FileOperationException(-filename => $cacheName, -operation => 'open for write'));
	}
    }
    return $respBody;
}
sub toString {
    my ($self, %flags) = @_;
    my @ret;
    my $inStr = $self->{Description}{-in}->toString(%flags);
    my $outStr = $self->{Description}{-out}->toString(%flags);
    push (@ret, "$self->{Description}{-operation}($inStr) => $outStr");
    foreach my $pattern (@{$self->{Ins}}) {
	push (@ret, "  IN: ", $pattern->toString());
    }
    foreach my $pattern (@{$self->{Outs}}) {
	push (@ret, "  OUT: ", $pattern->toString());
    }
    return wantarray ? @ret : join("\n", @ret);
}


package W3C::SPDL::Engine;
@W3C::SPDL::Engine::ISA = qw(XML::SAX::Base);
use W3C::Util::Exception;
use W3C::Rdf::RdfApp;
use W3C::Util::NamespaceHandler qw($NS_IGNORE);

sub new {
    my ($proto) = @_;
    my $class = ref($proto) || $proto;
    my $nsHandler = new W3C::Util::NamespaceHandler(-passUnknownNamespaces => 1, 
						    -useSAX2 => 1, 
						    -collide => $NS_IGNORE, 
						    -namespaceCreativity => 1);
    my $subHandler = new W3C::Util::NamespaceHandler(-relay => $nsHandler, 
						     -copyHandler => $nsHandler); my $atoms = new W3C::Rdf::Atoms();
    my $context = new W3C::Rdf::RdfApp(-forceHost => undef, 
				       -forceDir => undef, -atomDictionary => $atoms, 
				       -rdfDB => new W3C::SPDL::RdfDB(-atomDictionary => $atoms, -lazyReification => 1), 
				       NAMESPACE_HANDLER => $subHandler);
    my $self = {Context => $context, 
		UserQueryDB => $context->{-rdfDB}, #new W3C::SPDL::RdfDB(-atomDictionary => $context->{-atomDictionary}, 
						   # -lazyReification => 1), 
		NamespaceHandler => $nsHandler, 
		ByContext => {}, 
		ContextToXPaths => {}, 
		ContextToAction => {}, 
		MessagesByName => {}, 
		PorttypesByName => {}, 
		BindingsByName => {}, 
		ServicesByName => {}, 
		Invokes => [], 
		ContextToIgnore => {}, 
		CharData => '', # accumulate entire character data for parsing
    };
    bless ($self, $class);
    $self->{QueryHandler} = $context->getQueryHandler($self, -uniqueResults => 1, 
						      -namespaceHandler => $nsHandler);
    return $self;
}

sub addMessage {
    my ($self, $name, $element) = @_;
    $self->{MessagesByName}{$name} = $element;
}

sub addPorttypeOperation {
    my ($self, $porttype, $operation, $input, $output) = @_;
    $self->{PortypesByName}{$porttype}{$operation} = {-input => $input, -output => $output};
}

sub setBindingTransport {
    my ($self, $binding, $type, $transport) = @_;
    $self->{BindingsToTransport}{$binding}{$type} = $transport;
}

sub addBindingOperation {
    my ($self, $binding, $type, $operation) = @_;
    $self->{BindingsByName}{$binding}{$type} = $operation;
}

sub addServicePort {
    my ($self, $name, $port, $binding, $location) = @_;
    $self->{ServicesByName}{$name}{$port}{$binding} = $location;
}

sub executeQuery {
    my ($self, $query, $userQueryDB) = @_;

    my ($collect, $userQueryDB, $userQueryResultSet, $selects) = $self->getRecipeResultSet($query);
     binmode (STDOUT, ':utf8');
     print "$_\n" for ($self->dumpResultSet($userQueryResultSet));
    $userQueryResultSet->invokeServices;
    # Sort per the user query.
    $collect->delayedEvaluate($userQueryResultSet);
    my ($nodes, $statements) = $userQueryResultSet->gatherCollect;
    return ($nodes, $selects, [], $statements);
}
sub getRecipeResultSet {
    my ($self, $query) = @_;
    $self->{UserQueryDB}{-MatchNoVars} = 1;

    my $userQueryDB = $self->{UserQueryDB};
    foreach my $invoker (@{$self->{Invokes}}) {
	$invoker->addRulesToDB($userQueryDB);
    }

    # Hack to make the the query pattern into assertions.

    my $userQueryHandler = $self->{QueryHandler}; # $self->{Context}->getQueryHandler($self, -rdfDB => $userQueryDB);
    my $actions = [];
    $userQueryHandler->interpret($query, '--user query--', $QL_SPARQL, 
								      -actions => $actions);
    my ($ask, $collect) = ($actions->[-2], $actions->[-1]);
    UNIVERSAL::isa($ask, 'W3C::Rdf::AlgaeCompileTree::Ask') || &throw();
    UNIVERSAL::isa($collect, 'W3C::Rdf::AlgaeCompileTree::Collect') || &throw();
    my $userQueryResultSet = $userQueryHandler->getResultSet();
    $userQueryResultSet->clearResults();
    my $firstSelects = [@{$userQueryResultSet->{SELECTS}}];

    # The assertions from the query come from the actions gathered above.
    # Exectute them so that the rules fire.

    my $bnodeMap = {};
    my $userQueryAsAssertion = $ask->toAssertion($bnodeMap);
    $userQueryAsAssertion->delayedEvaluate($userQueryResultSet, {}, undef, $userQueryHandler->getSourceAttribution);

    # Execute the users query against the DB with the rule closure in it, but
    # don't let the parts of the asserted query with variables answer the query.

    $userQueryHandler->interpret($query, '--base--', $QL_SPARQL);
    $userQueryResultSet->{SELECTS} = $firstSelects;

    $self->{UserQueryDB}{-MatchNoVars} = 0;
    return ($collect, $userQueryDB, $userQueryHandler->getResultSet, $firstSelects);
}
sub dumpResultSet {
    my ($self, $recipeResultSet) = @_;
    $recipeResultSet ||= $self->{QueryHandler};
    use utf8;
    my $inputUri = $self->{Context}{INPUT_ATTRIBUTION}->getSource->getUri; # !!! invasive
    my $inventor = new W3C::Util::NamespaceInventor(-importMap => $self->{NamespaceHandler}, -namespaceCreativity => 1);
    my $refdNsHandler = new W3C::Util::NamespaceReducer(-relay => $inventor);
    use CGI;
    my $txt = $recipeResultSet->toString(-proofs => 1, -html1 => 'escaped', 
					 -htmlClassMap1 => {#'W3C::Rdf::Uri' => 'uri', 
							   'W3C::Rdf::XPathNode' => 'xpath', 
							   'W3C::Rdf::RdfDB' => 'db', 
							   'W3C::Rdf::Statement' => 'statement', 
							   #'W3C::Rdf::AttributionList' => 'attribList', 
							   'W3C::Rdf::Attribution::Inference' => 'inference', 
							   'W3C::SPDL::ServiceRule' => 'rule', 
							   'data' => 'data', 
							   'attribution' => 'attribution', 
							   '' => ''}, 
					 -unicode => 1, -box => ['┌─┬┐', 
								 '│ ││', 
								 '║ ║║', 
								 '├─┼┤', 
								 '└─┴┘'], 
					 -namespaceHandler => $refdNsHandler, 
					 -uriMap => {$inputUri => ''});
    return ("xml:base=\"$inputUri\"", $refdNsHandler->toString, $txt);
}

sub start_element {
    my ($self, $data, $context, $nsHelper) = @_;
    my $name = $data->{LocalName};
    my $namespace = $data->{NamespaceURI};
    my $qualname = "{$namespace}$name";
    # print "W3C::SPDL::Engine::start_element($qualname)\n";
}

sub end_element {
    my ($self, $data, $context, $nsHelper) = @_;
    my $name = $data->{LocalName};
    my $namespace = $data->{NamespaceURI};
    my $qualname = "{$namespace}$name";
    # print "W3C::SPDL::Engine::end_element($qualname)\n";
    $self->parseAnnotation($self->{CharData}, $context, $nsHelper);
    $self->{CharData} = '';
}

sub attribute {
    my ($self, $attribute, $context, $nsHelper) = @_;
    my $value = $attribute->{Value};
    if ($attribute->{LocalName} eq 'ignore') {
	my $bool;
	if ($value eq 'true') {
	    $self->{ContextToIgnore}{$context} = $context;
	} else {
	    &throw(new W3C::Util::Exception(-message => "ignore value \"$value\" unrecognized -- must be \"true\""));
	}
    } else {
	$self->parseAnnotation("PATHPATTERN{$value}", $context, $nsHelper);
    }
}
sub characters {
    my ($self, $characters, $context, $nsHelper) = @_;
    $self->{CharData} .= $characters->{Data};
}
sub parseAnnotation {
    my ($self, $algae, $context, $nsHelper) = @_;
    # my $contextStr = $context->toString();
    my $nss = join("\n", map {"$_ => ".$nsHelper->getURI($_)} $nsHelper->getPrefixes);
    # print "W3C::SPDL::Engine::charaters($algae, $contextStr, $nss)\n";
    my $queryNamespaceHandler = new W3C::Util::NamespaceHandler(-relay => $self->{NamespaceHandler}, 
								-copyHandler => $self->{NamespaceHandler});
    foreach my $prefix ($nsHelper->getPrefixes()) {
	my $namespace = $nsHelper->getURI($prefix);
	$queryNamespaceHandler->addNamespace($prefix, $namespace, undef);
    }
    my $queryHandler = $self->{QueryHandler};
    my $actions = [];
    my $xPathList = [];
    my ($entries, undef, undef, undef) = $queryHandler->interpret($algae, '--base--', $QL_SPARQL, 
								  -namespaceHandler => $queryNamespaceHandler, 
								  -debug => 0x00, 
								  -actions => $actions, 
								  -XPathContext => $context, 
								  -XPathList => $xPathList);
    if ($self->{ContextToAction}{$context}) {
	warn "redefinition of SPAT for $context\n"
    }
    # print "$context: ", $context->mother, ": ", $context->mother->toString(), "$actions->[-1]: ", $actions->[-1]->toString();
    push (@{$self->{Contexts}}, $context);
    $self->{ContextToXPaths}{$context} = $xPathList;	# All XPaths found in this context.
    $self->{ContextToAction}{$context} = $actions->[-1];# The SPARQL PATTERN associated with this context.
#    $self->{NamespaceHandler}->clear();
}

sub parseDescription {
    my ($self, $xsd) = @_;
    my $handlerStack = new W3C::XML::HandlerStack(-relay => $self->{NamespaceHandler});
    $self->{NSHelper} = $handlerStack->get_namespace_helper();
    my $schemaValidator = XML::Validator::Schema->new(systemID => $xsd, NShelper => $self->{NSHelper});
    $schemaValidator->registerAppinfoHandler('{http://dev.w3.org/cvsweb/perl/modules/W3C/SPDL/}SPAT', $self);
    $schemaValidator->registerAppinfoHandler('{http://dev.w3.org/cvsweb/perl/modules/W3C/SPDL/}ignore', $self);
    my $wsdlHandler = new W3C::SPDL::WSDL::Parser($self, $handlerStack, $schemaValidator);
    $handlerStack->set_handler($wsdlHandler);
    my $wsdlParser = XML::SAX::ParserFactory->parser(Handler => $handlerStack);
    $wsdlParser->parse_uri($xsd);

    # Walk the ddddereferenced WSDL structure.
    foreach my $serviceName (keys %{$self->{ServicesByName}}) {
	my $services = $self->{ServicesByName}{$serviceName};
	foreach my $service (keys %$services) {
	    my $bindings = $services->{$service};
	    foreach my $binding (keys %$bindings) {
		my $location = $bindings->{$binding};
		foreach my $bindingType (keys %{$self->{BindingsByName}{$binding}}) {
		    my $operation = $self->{BindingsByName}{$binding}{$bindingType};
		    my $transport = $self->{BindingsToTransport}{$binding}{$bindingType};
		    foreach my $portType (keys %{$self->{PortypesByName}}) {
			my $operations = $self->{PortypesByName}{$portType};
			foreach my $operation (keys %$operations) {
			    my $inMsg = $operations->{$operation}{-input};
			    my $outMsg = $operations->{$operation}{-output};
			    # Look in schema defns for in and out.
			    if (! exists $self->{MessagesByName}{$inMsg} || 
				! exists $self->{MessagesByName}{$outMsg}) {
				warn "no element for $inMsg/$outMsg\n";
				next;
			    }
			    my $in = $schemaValidator->getElement($self->{MessagesByName}{$inMsg});
			    my $out = $schemaValidator->getElement($self->{MessagesByName}{$outMsg});
			    $out->toString(NShelper => $self->{NSHelper});
			    # print "match $in/$out: ", $in->toString(), " -- ", $out->toString(), "\n--------------------\n";

			    # Write down service parameters.
			    my $desc = {-serviceName => $serviceName, 
					-service => $service, 
					-binding => $binding, 
					-bindingType => $bindingType, 
					-transport => $transport, 
					-portType => $portType, 
					-operation => $operation, 
					-location => $location, 
					-in => $in, 
					-out => $out};

			    # See if this desc serves at least one In and one Out.

			    # Ins get priority over Outs 'cause some services echo their args.
			    # Considering those args Outs would leave the service unstartable.
			    # It is less chancy to specifically disable such nestings with spat:ignore="true".
			    my (@ins, @outs);
			    foreach my $context (@{$self->{Contexts}}) {
				my $action = $self->{ContextToAction}{$context};
				if ($self->hasUnignoredEntries($in->includes($context))) {
				    push (@ins, $action);
				    # print "\n IN ===> ", $ins[-1]->{-action}->toString(), "\n";
				} elsif ($self->hasUnignoredEntries($out->includes($context))) {
				    push (@outs, $action);
				    # print "\n OUT ===> ", $outs[-1]->{-action}->toString(), "\n";
				}
			    }
			    if (@ins && @outs) {
				my $operationDB = new W3C::SPDL::RdfDB(-atomDictionary => $self->{Context}{-atomDictionary}, 
								       -lazyReification => 1);
				my $rs = new W3C::Rdf::ResultSet(-atomDictionary => $self->{Context}{-atomDictionary});
				my $bnodeMap = {};
				foreach my $pattern (@ins, @outs) {
				    my $q = $pattern->toAsk();
				    my $a = $q->toAssertion($bnodeMap);
				    $a->delayedEvaluate($rs, {}, undef, $self->{INPUT_ATTRIBUTION});
				    $operationDB->copyTriples($a->getDB());
				}
#				my $invoker = [[@ins], [@outs], $desc, $operationDB];
				my $invoker = new W3C::SPDL::Invoker($operation, $self->{Context}, $self->{NSHelper}, $self->{ContextToXPaths}, $self->{ContextToAction}, [@ins], [@outs], $desc, $operationDB, $self->{UserQueryDB}, $schemaValidator);
				push (@{$self->{Invokes}}, $invoker);
				# print &invokerToString($invoker, NShelper => $self->{NSHelper}), "\n";
			    }
			}
		    }
		}
	    }
	}
    }
}

sub hasUnignoredEntries {
    my ($self, @entries) = @_;
    if (!@entries) {
	return 0;
    }
    foreach my $entry (@entries) {
	if (my $handles = $entry->attributes->{'handles'}) {
	    foreach my $handle (keys %$handles) {
		if ($self->{ContextToIgnore}{$handle}) {
		    return 0;
		}
	    }
	}
    }
    return 1;
}
# </SPDL>


1;

__END__

=head1 NAME

W3C::SPDL::Engine - a SPDL parser and WSDL dispatcher

=head1 SYNOPSIS

  use XML::SAX::ParserFactory;
  use W3C::SPDL::Engine;

  $spat = new W3C::SPDL::Engine();
  $xsd = '../descriptions/AWSECommerceService-SPDL.wsdl'; # 'test.xsd';
  $wsdlHandler = $spat->getHandler($xsd);
  $bf = XML::Filter::BufferText->new(Handler => $wsdlHandler->{SchemaValidator});
  $docParser = XML::SAX::ParserFactory->parser(Handler => $bf);
  $docParser->parse_uri('test.xml');

=head1 AUTHOR

Eric Prud'hommeaux <eric@w3.org>

=head1 SEE ALSO

L<W3C::SPDL::WSDL>
L<W3C::Rdf::RdfApp>

=cut