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

# $Id: XmlParser.pm,v 1.98 2007-08-16 04:01:48 eric Exp $

use strict;
#use Exporter ();
require Exporter;
#require AutoLoader;

use W3C::XML::HandlerBase;
use W3C::XML::SAXParseException;

$W3C::Rdf::XmlParser::REVISION = '$Id: XmlParser.pm,v 1.98 2007-08-16 04:01:48 eric Exp $ ';

package W3C::Rdf::_Parser;
use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK);
@ISA = qw(W3C::XML::HandlerBase Exporter AutoLoader);
use W3C::Rdf::RdfDB;
@EXPORT = qw ($MODE_WAIT_BOGUS $MODE_WAIT_RDF $MODE_OBJECT $MODE_VALUE $MODE_PROPERTYELT $MODE_LITTERAL 
	      $MODE_ByPredicate $MODE_BySubjectType $MODE_BySubject $MODE_FAKEENTRY);
@EXPORT_OK = qw();
$VERSION = 1.0;
$DSLI = 'adpO';

use vars qw($MODE_WAIT_BOGUS $MODE_WAIT_RDF $MODE_OBJECT $MODE_VALUE $MODE_PROPERTYELT $MODE_LITTERAL 
	    $MODE_ByPredicate $MODE_BySubjectType $MODE_BySubject $MODE_FAKEENTRY);
($MODE_WAIT_BOGUS, $MODE_WAIT_RDF, $MODE_OBJECT, $MODE_VALUE, $MODE_PROPERTYELT, $MODE_LITTERAL, 
 $MODE_ByPredicate, $MODE_BySubjectType, $MODE_BySubject, $MODE_FAKEENTRY) = (0..10);
%W3C::Rdf::_Parser::MODE_STRINGS = ($MODE_WAIT_BOGUS => 'BOGUS', 
				   $MODE_WAIT_RDF => 'RDFWait', 
				   $MODE_OBJECT => 'RDFObject', 
				   $MODE_VALUE => 'RDFProperty', 
				   $MODE_PROPERTYELT => 'PROPERTYELT', 
				   $MODE_LITTERAL => 'LITTERAL', 
				   $MODE_ByPredicate => 'ByPredicate', 
				   $MODE_BySubjectType => 'BySubjectType', 
				   $MODE_BySubject => 'BySubject', 
				   $MODE_FAKEENTRY => 'FAKEENTRY');

use W3C::Rdf::EmitterInterface; # qw(%States);

# Tiny class to implement TripleObserver for W3C::Rdf::_Parser's trust updates. This
# chains to W3C::Rdf::_Parser's notifyTrustTriple. W3C::Rdf::_Parser could be it's own
# TripleObserver, but it would be limited to a single notifyTriple functions
# in W3C::Rdf::_Parser.

package W3C::Rdf::TrustObserver;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
@ISA = qw(Exporter AutoLoader);

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {};
    bless ($self, $class);
    ($self->{RDF_PARSER}) = @_;
    return $self;
}

sub notifyTriple {
    my ($self) = (shift);
    return $self->{RDF_PARSER}->notifyTrustTriple(@_);
}

package W3C::Rdf::_Parser;
use W3C::Util::Exception;
use W3C::Rdf::Atoms qw($ATTRIB_GroundFact $ATTRIB_FactRef $ATTRIB_Reification $ATTRIB_RuleRef $ATTRIB_Inference
		       $RDF_SCHEMA_URI);
use W3C::XML::NamespaceHandler;
#####
# new - prepare a W3C::Rdf::_Parser with a new connection

sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;

    my $self = $class->SUPER::new(@parms);
    bless ($self, $class);
    $self->{NEXT_ASSIGNED_ID} = 1;
    $self->{-nextTrustControlBlock} ||= 1; # defined $parms->{-nextTrustControlBlock} ? $parms->{-nextTrustControlBlock} : 1;
    $self->{-trustedIds} ||= []; # defined $parms->{-trustedIds} ? $parms->{-trustedIds} : [];
    $self->{-untrustedIds} ||= []; # defined $parms->{-untrustedIds} ? $parms->{-untrustedIds} : [];
#    $self->{-rdfDB} = $parms->{-rdfDB};
#    $self->{-namespaceHandler} = $parms->{-namespaceHandler};
#    $self->{-errorHandler} = $parms->{-errorHandler};
#    $self->{-appendAttribution} = $parms->{-appendAttribution};

    # these should probably be passed or set parameters
    $self->{DEFAULT_DOC_TRUST} = undef;
    $self->{DEFAULT_LINK_TRUST} = undef;

    $self->{TRUST_SCHEMA_URI} = 'http://www.w3.org/RDF/schema/Trust/';
    $self->{TRUST_OBSERVER} = new W3C::Rdf::TrustObserver($self); # friend class
    $self->{STACK} = [];
    $self->{SERIALIZER} = undef; # Used for canonicalizing parseType="Literal".
    $self->{STATES} = \ %W3C::Rdf::EmitterInterface::States; 
#     &transformNamespace($self->{STATES}, 'rdf:', $RDF_SCHEMA_URI);
    foreach my $ns (keys %W3C::Rdf::EmitterInterface::Namespaces) {
	&transformNamespace($self->{STATES}, $ns, $W3C::Rdf::EmitterInterface::Namespaces{$ns});
    }
    $self->tweakStates;
    $self->{RDF_DECL} = 0;
    $self->{AUTH} = undef;

    $self->{TRUST_SCHEMA_URI_trust} = 
	$self->{-atomDictionary}->getUriLink($self->{TRUST_SCHEMA_URI}.'trust', undef);
    $self->{TRUST_SCHEMA_URI_disTrust} = 
	$self->{-atomDictionary}->getUriLink($self->{TRUST_SCHEMA_URI}.'disTrust', undef);
    $self->{TRUST_SCHEMA_URI_defaultDocTrust} = 
	$self->{-atomDictionary}->getUriLink($self->{TRUST_SCHEMA_URI}.'defaultDocTrust', undef);
    $self->{TRUST_SCHEMA_URI_defaultLinkTrust} = 
	$self->{-atomDictionary}->getUriLink($self->{TRUST_SCHEMA_URI}.'defaultLinkTrust', undef);
    $self->{TRUST_SCHEMA_URI_sum} = 
	$self->{-atomDictionary}->getUriLink($self->{TRUST_SCHEMA_URI}.'sum', undef);
    $self->{GRAMMER_SCHEMA_STRING_RDFWait} = 
	$self->{-atomDictionary}->getString('RDFWait', undef, 'PLAIN');

    $self->{BNODES_BY_NAME} = {};	# support getBNode
#    $self->{GRAMMAR_STATE} = undef;		# grammer state
    return $self;
}

sub append ($) { # prepare for subsequent XML documents
    $_[0]->{RDF_DECL} = -1;
}

sub setState ($) {
    my ($self, $mode) = @_;
    $self->{MODE} = $mode;
}

sub setAuth ($) {
    my ($self, $auth) = @_;
    $self->{AUTH} = $auth;
}

sub getAuth ($) {
    my ($self) = @_;
    return $self->{AUTH};
}

sub setNamespaceHandler {
    my ($self, $namespaceHandler) = @_;
    $self->{-namespaceHandler} = $namespaceHandler;
}

###############################################################################
# W3C::Util::NamespaceHandler interface -- 
# Mostly just a passthrough to 
###############################################################################
sub addNamespaceNUKE {
    my ($self, $sAs, $sHref) = @_;
    return $self->{-rdfDB}->addNamespace($sAs, $sHref);
}

# support the W3C::Util::NamespaceHandler::unmapNamespace function so we can _be_ a 

sub unmapNamespaceNUKE {
    my ($self, $name) = @_;
    &throw(new W3C::Util::DeprecatedException(-function => 'W3C::Rdf::_Parser::unmapNamespace'));
    $name = $self->{-namespaceHandler}->unmapNamespace($name, $self->{URI_STRING}) if ($self->{-namespaceHandler});
    $name =~ s/\A\Q$self->{URI_STRING}\E/<source>/;
    return $name;
}

###############################################################################
# end W3C::Util::NamespaceHandler interface
###############################################################################
sub newParserContext {
    my ($self) = @_;
    for (my $i = 0; $i < @{$self->{STACK}} -1; $i++) {
	$self->{STACK}[$i]->{-state} = 'RDFWait';
    }
}

sub setRdfSchemaURI {
    my ($self, $schemaURI) = @_;
    &throw(new W3C::Util::DeprecatedException(-function => 'W3C::Rdf::_Parser::setRdfSchemaURI'));
    # actually, I just didn't maintain it. -- needs fixing.
    $self->{PARSER}->{RDF_SCHEMA_URI} = $schemaURI;
}

sub getSystemId {
    my ($self) = @_;
    return $self->{SYSTEM_ID};
}

sub getBaseUri {
    my ($self) = @_;
    if (my $base = $self->{-namespaceHandler}->getXmlBase()) {
	if (my $ret = $self->{CachedUris}{$base}) {
	    return $ret;
	} else {
	    return $self->{CachedUris}{$base} = $self->{-atomDictionary}->getUri($base, $self->{SYSTEM_ID});
	}
    }
    return $self->{SYSTEM_ID};
}

sub getRootAttribution {
    my ($self) = @_;
    return $self->{ROOT_ATTRIBUTION};
}

sub getRdfDB {
    my ($self) = @_;
    return $self->{-rdfDB};
}

sub setRdfDB {
    my ($self, $rdfDB) = @_;
    $self->{-rdfDB} = $rdfDB;
}

# Parsing support functions dealing with the TAG_STATE

# maintain state in a stack - could be a first class object, but I don't see much point

sub notifyTrustTriple {
    my ($self, $triple) = @_;
#    return if (!$triple->trusted); # @@@ maybe that should go into an W3C::Rdf::RdfDB::triplesMatching parameter
    my $object = $triple->getObject;
    if ($triple->getPredicate == $self->{TRUST_SCHEMA_URI_trust}) {
	# figure out what to do if it's a bag...
	if (!exists $self->{-trustedIds}{$object->toString}) {
	    my $auth = undef;
	    &throw(new W3C::Util::Exception());
	    $self->{-trustedIds}{$object->toString} = 
		$self->{-atomDictionary}->getAttribution($ATTRIB_GroundFact, $object, $auth, $self->{ATTRIBUTION}, undef, 1);
	}
	print 'created: '.$self->{-trustedIds}{$object->toString}->toString."\n";
    } elsif ($triple->getPredicate == $self->{TRUST_SCHEMA_URI_disTrust}) {
	my $auth = undef;
	&throw(new W3C::Util::Exception());
	$self->{-trustedIds}{$object->toString} = 
	    $self->{-atomDictionary}->getAttribution($ATTRIB_GroundFact, $object, $auth, $self->{ATTRIBUTION}, undef, 0) 
    } elsif ($triple->getPredicate == $self->{TRUST_SCHEMA_URI_defaultDocTrust}) {
	$self->{DEFAULT_DOC_TRUST} = $object->toString eq 'trust';
    } elsif ($triple->getPredicate == $self->{TRUST_SCHEMA_URI_defaultLinkTrust}) {
	$self->{DEFAULT_LINK_TRUST} = $object->toString eq 'trust';
    } elsif ($triple->getPredicate == $self->{TRUST_SCHEMA_URI_sum}) {
#	print 'sum: '.$object->toString."\n";
	$self->{ATTRIBUTION}->statedSum($object->getString);
    }
#    print $triple->toString('', $self)."\n";
}

# add ordinals to Container if we are in an <li> element

#####
# documentHandler routines

sub setDocumentLocator {
    my ($self, $locator) = @_;
    $self->{DOCUMENT_LOCATOR} = $locator;
    $self->{URI_STRING} = $locator->getPublicId;
    $self->{SYSTEM_ID} = $self->{-atomDictionary}->getUri($self->{URI_STRING}, undef);
    my ($uri, $auth, $trusted, $clear) = 
	($self->{SYSTEM_ID}, $self->{AUTH}, $self->{-nextTrustControlBlock}, !$self->{-appendAttribution});
    $self->{ATTRIBUTION} = $self->{ROOT_ATTRIBUTION} = 
	$self->{-atomDictionary}->getGroundFactAttribution($uri, undef, $auth, undef);
}

sub startDocument {
    my ($self) = @_;
    $self->SUPER::startDocument();
    $self->newParserContext;

    # set up a tag state that defaults to parsing RDF in case it is not in an :RDF element
    if (!defined $self->{MODE}) {
	$self->{MODE} = 'RDFWait';
    }
    if (!@{$self->{STACK}}) {
	my $initState = $self->{-atomDictionary}->getString($self->{MODE}, undef, 'PLAIN');
	$self->{STACK} = [{-state => '???', -variables => {'nestState' => $initState}}];
    }
    $self->{-rdfDB}->registerTripleObserver([[$self->{TRUST_SCHEMA_URI_trust}, undef, undef], 
					     [$self->{TRUST_SCHEMA_URI_disTrust}, undef, undef], 
					     [$self->{TRUST_SCHEMA_URI_defaultDocTrust}, undef, undef], 
					     [$self->{TRUST_SCHEMA_URI_defaultLinkTrust},undef, undef], 
					     [$self->{TRUST_SCHEMA_URI_sum}, undef, undef]],$self->{TRUST_OBSERVER});

#    require W3C::Rdf::RelaxNGParser;
#    my $parser = new W3C::Rdf::RelaxNGParser;
#    $self->{GRAMMAR} = $parser->Run('/home/eric/sources/public/perl/modules/W3C/Rdf/rdfxml-rdal.rnc');
#    $self->{GRAMMAR_STATE} = $parser->getStartState;
    #print $self->{GRAMMAR}->toString(), "\n";
}

sub endDocument {
    my ($self) = @_;
    # flush top attribution 'cause checksum has changed
    $self->{ROOT_ATTRIBUTION}->flush({-discretionaryUpdate => 1, -default => {'parent' => 1}});
    $self->SUPER::endDocument();
}

sub resolveArg { # extra arg to make it usefull in other places - may not work out
    my ($self, $arg) = @_;
    my $result;
    if ($arg =~ m/^ \" ( \w[^\"]* ) \" $/x) {
	$arg = $1;
	my $lang = $self->{-namespaceHandler}->getXmlLang();
	$result = $self->{-atomDictionary}->getString($arg, undef, 'PLAIN', $lang); # !!!
#    } elsif ($arg =~ m/^ \' ( \w[\w\d]* ) \' $/x) {
    } elsif ($arg =~ m/^ \' ( [^\']* ) \' $/x) {
	$arg = $1;
	$result = $arg;
	if ($arg =~ m/^ \# ( \w[\w\d]* ) $/x) {
	    $arg = $1;
	    $result = $self->{-atomDictionary}->getUriName($result, $self->getBaseUri());
	} else {
	    $result = $self->{-atomDictionary}->getUriLink($result, $self->getBaseUri());
	}
    } else {
	$result = $self->getParm($arg, 0, 0);
    }
    return $result;
}

sub _parseCommand {
    my ($self, $action) = @_;
    if (!defined $action) {
	return;
    }

    my @actions = split ('\s*\;\s*', $action);
  COMMAND:
    foreach my $command (@actions) {
	$command =~ m/^ \s* (?:( [^\?]+ ) \s* \? \s*)? (?:( \w[\w\d\[\]\-]* ) \s* \= \s*)? 
	    ( [\'\"]?[\w\d\[\]\-:\/\.]*[\'\"]? ) ( \( ([^\)]+) \) )? \s* $/x || 
	    &throw(new W3C::Util::NotImplementedException(-function => $command));
	my ($constraints, $lvalue, $funcOrVar, $isFunc, $args) = ($1, $2, $3, $4, $5);
	if (defined $constraints) {
	    my @constraints = split ('&&', $constraints);
	    foreach my $constraint (@constraints) {
		if ($constraint =~ m/^\d+$/) {
		    next COMMAND if ($constraint >= @{$self->{STACK}});
#		} elsif ($constraint =~ m/^([\w\d\[\]\-\'\"]*)\s*([\=\!])=\s*([\w\d\[\]\-\'\"]*)$/) {
		} elsif ($constraint =~ m/^([\w\d\[\]\-\'\"]*)\s*([\=\!])=\s*(.*)$/) {
		    my ($l, $eq, $r) = ($self->resolveArg($1), $2, $self->resolveArg($3));
		    next COMMAND if ($l == $r ^ $eq eq '=');
		} elsif ($constraint =~ m/^\!\s*(.*)$/) {
		    next COMMAND if ($self->getParm($1, 0, 0));
		} else {
		    next COMMAND if (!$self->getParm($constraint, 0, 0));
		}
	    }
	}
	my $result;
	if ($isFunc) {
	    my @parmNames = split ('\s*,\s*', $args);
	    $result = $self->dispatch($funcOrVar, @parmNames);
	} elsif ($funcOrVar =~ m/^ GENID $/x) {
	    $result = $self->{-atomDictionary}->createBNode($self->{ATTRIBUTION});
	} elsif ($funcOrVar =~ m/^ NULL $/x) {
	    $result = undef;
	} elsif ($funcOrVar =~ m/^ \" ( \w[\w\d]* ) \" $/x) {
	    $result = $self->{-atomDictionary}->getString($1, undef, 'PLAIN');
	} elsif ($funcOrVar =~ m/^ \' ( \w[\w\d\/\.\:]* ) \' $/x) {
	    $result = $self->{-atomDictionary}->getUriLink($1, $self->getBaseUri());
	} elsif ($funcOrVar =~ m/^ \d+ $/x) {
	    $result = $self->{-atomDictionary}->getString($funcOrVar, undef, 'PLAIN');
	} else {
	    $result = $self->getParm($funcOrVar, 1, 0);
	}
	if ($lvalue) {
	    $self->getParm($lvalue, 0, \$result);
	}
    }
}

sub getParm {
    my ($self, $parmName, $genid, $ref) = @_;
    my $index = -1;
    if ($parmName =~ m/^ (\w[\w\d]*) \s* \[ \s* ([0-9\-]+) \s* \] $/x) {
	($parmName, $index) = ($1, $2);
    }
    if (-$index > @{$self->{STACK}} || $index > @{$self->{STACK}} - 1) {
	&throw(new W3C::Util::OutOfBoundsException(-name => 'variable stack', -index => $index));
    }
    my $parm = \ $self->{STACK}[$index]{-variables}{$parmName};
    if ($ref) {
	# Handle special variable assignments.
	if ($parmName eq 'trace') {
	    $self->{TRACE} = ${$ref}->getString;
	} elsif ($parmName eq 'watch') {
	    $self->{WATCH} = {map {$_ => 1} split(/[ \t\b]+/, ${$ref}->getString)};
	}
	if ($self->{WATCH}{$parmName}) {
	    my $old = $$parm ? ${$parm}->toString() : 'undef';
	    my $new = $$ref ? ${$ref}->toString() : 'undef';
	    print STDERR "$parmName: $old -> $new\n";
	}
	$$parm = $$ref;

	# my $value = $$ref ? $$ref->toString : 'NULL';
	# print "$parmName <- $value\n" if ($parmName eq 'nestState');
    }
    if (!$$parm && $genid) {
	$$parm = $self->{-atomDictionary}->createBNode($self->{ATTRIBUTION});
	$self->{STACK}[$index]{-variables}{$parmName} = $$parm;
    }
    return $$parm;
}

sub stackToString {
    my ($self, $flags) = @_;
    $flags ||= {};
    my @rows;
    for (my $i = 0; $i < @{$self->{STACK}}; $i++) {
	my $entry = $self->{STACK}[$i];
	my $stateStr = $entry->{-state};
	if (ref $stateStr) {$stateStr = $stateStr->toString;}
	if (my $f = $flags->{-state}) {
	    if (ref $f) {
		$stateStr = substr($stateStr, $f->[0], $f->[1]);
	    } else {
		$stateStr = substr($stateStr, $f);
	    }
	}
	my $attribStr = '';
	if (my $f = $flags->{-attrib} && $entry->{-attrib}) {
	    my $str = $entry->{-attrib}->toString;
	    if (ref $f eq 'ARRAY') {
		$attribStr = substr($str, $f->[0], $f->[1]);
	    } else {
		$attribStr = substr($str, $f);
	    }
	}
	my $line = sprintf ("%d: %s %s %s", $i, $stateStr, $entry->{-literalMode} ? 'lit' : '   ', $attribStr);
	push (@rows, $line);
	foreach my $key (sort keys %{$entry->{-variables}}) {
	    my $value = $entry->{-variables}{$key} ? $entry->{-variables}{$key}->toString : 'NULL';
	    if (my $f = $flags->{-variables}) {
		if (ref $f eq 'ARRAY') {
		    $value = substr($value, $f->[0], $f->[1]);
		} else {
		    $value = substr($value, $f);
		}
	    }
	    push (@rows, "        $key:$value");
	}
    }
    return join ("\n", @rows);
}

sub dispatch {
    my ($self, $command, @parmNames) = @_;
    my $result;
    if ($command eq 'literalMode') {
	my $nextCommand = shift @parmNames;
	$result = $self->{STACK}[-1]{-literalMode} = [$nextCommand, @parmNames];
	require W3C::XML::XmlSerializer;
	my $flags = {-publicId => 'file://localhost/dev/tty', 
		     -systemId => 'file://localhost/dev/tty', 
		     -importMap => $self->{-namespaceHandler}};
	$self->{SERIALIZER} = new W3C::XML::XmlSerializer($flags);
	$self->{SERIALIZER}->startDocument;
    } else {
	my @parms;
	foreach my $parmName (@parmNames) {
	    if ($parmName =~ m/^ GENID $/x) {
		$result = $self->{-atomDictionary}->createBNode($self->{ATTRIBUTION});
	    } elsif ($parmName =~ m/^ NULL $/x) {
		$result = undef;
	    } elsif ($parmName =~ m/^ \" ( [^\"]* ) \" $/x) {
		$result = $self->{-atomDictionary}->getString($1, undef, 'PLAIN');
	    } elsif ($parmName =~ m/^ \' ( [^\"]* ) \' $/x) {
		$result = $self->{-atomDictionary}->getUriLink($1, $self->getBaseUri());
	    } elsif ($parmName =~ m/^ \d+ $/x) {
		$result = $self->{-atomDictionary}->getString($parmName, undef, 'PLAIN');
	    } else {
		$result = $self->getParm($parmName, 1, 0);
	    }
	    push (@parms, $result);
	}
	my $parmString = join (', ', map {$_ ? ref $_ ? $_->toString('', $self->{-namespaceHandler}) : '!'.$_.'!' : 'NULL'}@parms);
#	print $funcOrVar.'('.$parmString.")\n";
	if ($command eq 'addStatement') {
	    # $result = $self->{-rdfDB}->addStatement(@parms, $self->{ATTRIBUTION});
	    $result = $self->{-atomDictionary}->getStatement(@parms, $self->{ATTRIBUTION});
	    $result->getAttributionList->ensureDirectAttribution($self->{ATTRIBUTION});
	    $self->{-rdfDB}->addTriple($result);
#	    print "adding ",$result->toString,"\n";
	} elsif ($command eq 'hashedUri') {
	    $parms[0] = $parms[0]->getString();
	    $result = $self->{-atomDictionary}->getUriName(@parms, $self->{ATTRIBUTION});
	} elsif ($command eq 'getBNode') {
	    $parms[0] = $parms[0]->getUri();
	    if (!($result = $self->{BNODES_BY_NAME}{$parms[0]})) {
		$result = $self->{BNODES_BY_NAME}{$parms[0]} = $self->{-atomDictionary}->createBNode($self->{ATTRIBUTION});
	    }
	} elsif ($command eq 'mappedNode') {
	    $result = $self->{-atomDictionary}->getMappedNode(@parms, $self->{ATTRIBUTION});
	} elsif ($command eq 'checkTrust') {
	    if (my $nextAttribution = $self->{-trustedIds}{$parms[0]->toString}) {
		my $currentAttribution = $self->{ATTRIBUTION}->toString;
#		print "switching from $currentAttribution to $parmString\n";
		$result = $self->{ATTRIBUTION} = $nextAttribution;
	    }
	} elsif ($command eq 'echo') {
	    print $parmString."\n";
	} elsif ($command eq 'warning') {
	    $self->{-errorHandler}->warning(new W3C::XML::SAXParseException (-message => $parmString, -locator => $self->{DOCUMENT_LOCATOR}));
	} elsif ($command eq 'error') {
	    $self->{-errorHandler}->error(new W3C::XML::SAXParseException (-message => $parmString, -locator => $self->{DOCUMENT_LOCATOR}));
	} elsif ($command eq 'fatalError') {
	    $self->{-errorHandler}->fatalError(new W3C::XML::SAXParseException (-message => $parmString, -locator => $self->{DOCUMENT_LOCATOR}));
	} else {
	    &throw(new W3C::Util::NotImplementedException(-function => $command));
	}
    }
    return $result;
}

sub calculateSum {
    my ($self, $string, $attributeList) = @_;
    if (!$self->{STACK}[-1]{-notSumming}) {

	my $oldSum = $self->{STACK}[-1]{-sum};
	my $oldTag = $self->{STACK}[-1]{-variables}{'name'}->toString;
	$oldTag = $1 if ($oldTag =~ m/([^\/]+)$/);

	$self->{STACK}[-1]{-sum} ^= unpack ('%16C*', $string);
	if ($attributeList) {
	    for (my $i = 0; $i < $attributeList->getLength; $i++) {
		$self->{STACK}[-1]{-sum} ^= unpack ('%16C*', $attributeList->getQName($i));
		$self->{STACK}[-1]{-sum} ^= unpack ('%16C*', $attributeList->getValue($i));
	    }
	}

	my $newSum = $self->{STACK}[-1]{-sum};
    }
}

sub sumParent {
    my ($self) = @_;
    if ($self->{STACK}[-2]{-notSumming}) {
	my $oldSum = $self->{STACK}[-2]{-sum};
	my $oldTag = $self->{STACK}[-2]{-variables}{'name'}->toString;
	$oldTag = $1 if ($oldTag =~ m/([^\/]+)$/);
	my $newTag = $self->{STACK}[-1]{-variables}{'name'}->toString;
	$newTag = $1 if ($newTag =~ m/([^\/]+)$/);
	$self->{STACK}[-2]{-sum} ^= $self->{STACK}[-1]{-sum};
#	my $newSum = $self->{STACK}[-2]{-sum};
    }
    $self->{ATTRIBUTION}->setSum($self->{STACK}[-1]{-sum});
}

sub getParseState {
    my ($self, $stateDesc) = @_;
    my $parseStateString = $self->{STACK}[-1]{-state};
    my $parseState = $self->{STATES}{$parseStateString};
    # my $str = $parseStateString->toString;
    # print "parseState: $str\n";
    if (!defined $parseState) {
	my $parentStates = join (' -> ', $stateDesc, map {$_->{-variables}{'nestState'}->toString} 
				 @{$self->{STACK}}[0..@{$self->{STACK}}-3]);
	$parentStates .= "\nignoring nested data";
	if (defined $parseStateString) {
	    $self->{-errorHandler}->error(new W3C::Util::Exception(-message => "no parse state for atom ".($parseStateString->toString).
								   " ($parseStateString) = $parentStates"));
	} else {
	    $self->{-errorHandler}->error(new W3C::Util::Exception(-message => "parse state unset - $parentStates"));
	}
	$parseStateString = $self->{STACK}[-1]{-state} = $self->{-atomDictionary}->getString("Error", undef, 'PLAIN');
	$parseState = $self->{STATES}{$parseStateString};
    }
    return $parseState;
}

sub _bindAttributes {
    my ($self, $attributeList, $bindings) = @_;
    my $varToAttr = undef; # build dependencies only if needed

    my $attributesToProcess = [];
    for (my $i = 0; $i < $attributeList->getLength; $i++) {
	push (@$attributesToProcess, [$attributeList->getURI($i), $attributeList->getLocalName($i)]);
    }
    # @$attributesToProcess list may be supplemented later if some attrs need
    # to be interpreted after others are assigned.

    # Assign variables from attributes.
    while (my $attributePair = shift @$attributesToProcess) {
	my $attributeValue = $attributeList->getValue(@$attributePair);
	if (my $varBindings = $bindings->{join ('', @$attributePair)}) {
	    if (!ref $varBindings) {
		$varBindings = [$varBindings];
	    }
	    foreach my $copyMe (@$varBindings) {
		my $varSpec = $copyMe;
		my ($result, $varName) = $self->_buildVar($varSpec, $attributeValue, $varToAttr, $bindings, $attributeList, $attributesToProcess, $attributePair);
		$self->{STACK}[-1]{-variables}{$varName} = $result;
	    }
	}
    }
}

sub _buildVar {
    my ($self, $varName, $attributeValue, $varToAttr, $bindings, $attributeList, $attributesToProcess, $attributePair) = @_;
    my $result;
    if ($varName =~ m/^ \" ( \w[\w\d]* ) \" $/x) {
	$varName = $1;
	$result = $self->{-atomDictionary}->getString($attributeValue, undef, 'PLAIN');
    } else {
	if ($varName =~ m/^ \' ( \w[\w\d]* ) \' $/x) {
	    $varName = $1;
	}
	$result = $attributeValue;
	if ($varName =~ m/^ (?: ( \w[\w\d]* ) (?: \[ (\-?\d+) \] )? )? ([\#\.]) (?:\" ([^\"]*) \")? (\:)? ( \w[\w\d]* ) $/x) {
	    my ($namespace, $index, $joiner, $prefix, $colon, $varNameTail) = ($1, $2, $3, $4, $5, $6);
	    $varName = $varNameTail;
	    if ($colon) {
		if ($prefix) {
		    $result =~ s/:/:$prefix/;
		}
		$result = $self->mapNamespace($result);
	    } elsif ($prefix) {
		$result = $prefix.$result;
	    }
	    if (!defined $index) {
		$index = -1; # convenient to know we have an index
	    }

	    my $baseUri;
	    if (defined $namespace) {
		$baseUri = $self->getParm($namespace."[$index]", 0, 0);

		# Check to see if namesace is a variable that is not
		# yet set at this stack level. Should be uncommon.
		if (!defined $baseUri && 
		    ($index == -1 || $index == scalar @{$self->{STACK}} -1)) {
		    if (!defined $varToAttr) {
			# Associate variables with the attributes
			# they depend on.
			$varToAttr = {};
			my $varDepends = {};
		      WALK_BOUND_ATTRS:
			foreach my $attr (keys %$bindings) {
			    my $expr = $bindings->{$attr};
			    if ($expr =~ 
				m/^ (?: (?: ( \w[\w\d]* ) (?: \[ (\-?\d+) \] )? )? ([\#\.]) )? (?:\" ([^\"]*) \")? (\:)? ( \w[\w\d]* ) $/x) {
				my ($namespace, $index, $joiner, $prefix, $colon, $target) = ($1, $2, $3, $4, $5, $6);
				if ((defined $namespace) && defined $index && 
				    $index != -1 && $index != scalar @{$self->{STACK}} -1) {
				    next;
				}
				$varToAttr->{$target} = $attr;
				$varDepends->{$target} = $namespace;
				for (my $v = $namespace; exists $varDepends->{$v}; $v = $varDepends->{$v}) {
				    if ($v eq $target) {
					&throw(new W3C::Util::Exception(-message => "circular variable dependency for $target"));
				    }
				}
			    }
			}
		    }
		    if (exists $varToAttr->{$namespace}) {
			my $neededAttr = $varToAttr->{$namespace};
			# Ugly hack to deal with the fact that the
			# current lang doesn't preserve the ns and
			# attribute separately.
			for (my $i = 0; $i < $attributeList->getLength; $i++) {
			    my $ns = $attributeList->getURI($i);
			    my $lName = $attributeList->getLocalName($i);
			    if ($neededAttr eq "$ns$lName") {
				# Handle this atribute later.
				push (@$attributesToProcess, $attributePair);
				last; # next WALK_BOUND_ATTRS;
			    }
			}
		    }
		}
	    } else {
		$baseUri = $self->getBaseUri();
	    }
	    if ($joiner eq '#') {
		if (defined $baseUri && $baseUri->getUri() =~ m/\#/) {
		    # Sometimes we need to aggregate the QName. test case: wsdl AbstractOperation
		    $result = $self->{-atomDictionary}->getUriName($baseUri->getUri().$result, undef);
		} else {
		    $result = $self->{-atomDictionary}->getUriName($result, $baseUri);
		}
	    } elsif ($joiner eq '/') {
		$result = $self->{-atomDictionary}->getUriName($result, $baseUri);
	    } elsif ($joiner eq '.') {
		$result = $self->{-atomDictionary}->getUriLink($baseUri->getUri().$result, undef);
	    } else {
		&throw(new W3C::Util::ProgramFlowException());
	    }
	} else {
	    if ($varName =~ m/^ (\:)? (?:\" ([^\"]*) \")? (\w[\w\d]*) $/x) {
		my ($colon, $prefix, $rest) = ($1, $2, $3);
		if ($colon) {
		    $varName = $rest;
		    if ($prefix) {
			$result =~ s/:/:$prefix/;
		    }
		    $result = $self->mapNamespace($result);
		} elsif ($prefix) {
		    $result = $prefix.$result;
		}
#			    if ($colon) {
#				$varName = $rest;
#				$result = $self->mapNamespace($result);
#			    }
		$result = $self->{-atomDictionary}->getUriLink($result, $self->getBaseUri());
	    } else {
		&throw(new W3C::Util::ProgramFlowException());
	    }
	}
    }
    return ($result, $varName);
}

sub _handleAttribute {
    my ($self, $attributeName, $attributeValue, $attrActions) = @_;
    if ($attrActions) {
	my ($type, $action) = @$attrActions;
	# execute actions for specific attributes
	my $attributeValueAtom;
	my $attributeNameAtom = $self->{-atomDictionary}->getUriLink($attributeName, $self->getBaseUri());
	$self->{STACK}[-1]{-variables}{'attribute'} = $attributeNameAtom;
	if ($type eq 'reference') {
	    $attributeValueAtom = $self->{-atomDictionary}->getUriLink($attributeValue, $self->getBaseUri());
	} elsif ($type eq 'literal') {
	    my $lang = $self->{-namespaceHandler}->getXmlLang();
	    $attributeValueAtom = $self->{-atomDictionary}->getString($attributeValue, undef, 'PLAIN', $lang);
	} else {
	    &throw(new W3C::Util::NotImplementedException(-function => $type));
	}
	$self->{STACK}[-1]{-variables}{'value'} = $attributeValueAtom;
	$self->_parseCommand($action);
	delete $self->{STACK}[-1]{-variables}{'attribute'};
	delete $self->{STACK}[-1]{-variables}{'value'};
    }
}

# general use productions not worth listing each place they come up:
# [6.19] Qname          ::= [ NSprefix ':' ] name
# [6.22] name           ::= (any legal XML name symbol)
# [6.20] URI-reference  ::= string, interpreted per [URI]
# [6.21] IDsymbol       ::= (any legal XML name symbol)
# [6.23] NSprefix       ::= (any legal XML namespace prefix)
# [6.24] string         ::= (any XML text, with "<", ">", and "&" escaped)

sub startElement {
    my ($self, $namespace, $localName, $qName, $attributeList) = @_;
    my $name = $namespace.$localName;
    if ($self->{-helpNamespaces} && $self->{-namespaceHandler} && 
	$self->{-namespaceHandler}->can('getUnknownNamespaces') && 
	$self->{-namespaceHandler}->can('setRemapAndRestart') && 
	grep {/^rdf$/} $self->{-namespaceHandler}->getUnknownNamespaces) {
	$self->{-namespaceHandler}->addNamespace('rdf', $RDF_SCHEMA_URI, $self->{DOCUMENT_LOCATOR}->getPublicId);
	$self->{-namespaceHandler}->setRemapAndRestart(1);
	return;
    }
    my $nameAtom = $self->{-atomDictionary}->getUriLink($name, $self->getBaseUri());
    my $initialParseState = $self->{STACK}[-1]{-variables}{'nestState'};
    my $notSumming = $initialParseState == $self->{GRAMMER_SCHEMA_STRING_RDFWait};
    push (@{$self->{STACK}}, {-state => $initialParseState, -variables => {}, 
			      -attribution => $self->{ATTRIBUTION}, -sum => 0, 
			      -notSumming => $notSumming, 
			      -literalMode => $self->{STACK}[-1]{-literalMode}});
    $self->{STACK}[-1]{-variables}{'name'} = $nameAtom;
    $self->{STACK}[-1]{-variables}{'elementNs'} = $self->{-atomDictionary}->getUriLink($namespace, $self->getBaseUri());
    $self->{STACK}[-1]{-variables}{'sp'} = $self->{-atomDictionary}->getString(scalar @{$self->{STACK}}, undef, 'PLAIN');

    $self->calculateSum($name, $attributeList);
    if ($self->{STACK}[-2]{-literalMode}) {
	# Re-serialize according to W3C's Exclusive XML Canonicalization 1.0.
	# http://www.w3.org/TR/2002/REC-xml-exc-c14n-20020718/
	my $attributeStrings = {};
	for (my $i = 0; $i < $attributeList->getLength; $i++) {
	    my ($attributeName, $attributeValue) = ($attributeList->getQName($i), $attributeList->getValue($i));
	    $attributeStrings->{$attributeName} = $attributeValue;
	}
	$self->{SERIALIZER}->startElement($qName, $attributeStrings);
	if ($self->{TRACE} =~ m/\bstack\b/) {
	    print "\"<$qName>\"\n";
	}
    } else {
	if ($nameAtom == $self->{TRUST_SCHEMA_URI_sum}) {
	    $self->{STACK}[-1]{-nextIsSum} = 1;
	}
#	$self->{GRAMMAR_STATE}->startElement($namespace, $localName, $qName, $attributeList);
	my $parseState = $self->getParseState("startElement($name)");
	my $grammer = $parseState->{-onTag}{$name} || $parseState->{-otherElement};

	$self->_bindAttributes($attributeList, $parseState->{-common}{-bind});
	$self->_bindAttributes($attributeList, $grammer->{-bind});

	$self->_parseCommand($parseState->{-common}{-start});
	$self->_parseCommand($grammer->{-start});

	# iterate attributes and execute their actions
	for (my $i = 0; $i < $attributeList->getLength; $i++) {
	    my ($name, $value) = ($attributeList->getURI($i).$attributeList->getLocalName($i), $attributeList->getValue($i));
	    if (exists $parseState->{-common}{-attr}{$name}) {
		$self->_handleAttribute($name, $value, $parseState->{-common}{-attr}{$name});
	    } else {
		$self->_handleAttribute($name, $value, $parseState->{-common}{-otherAttr});
	    }

	    if (exists $grammer->{-attr}{$name}) {
		$self->_handleAttribute($name, $value, $grammer->{-attr}{$name});
	    } else {
		$self->_handleAttribute($name, $value, $grammer->{-otherAttr});
	    }
	}
	if ($self->{TRACE} =~ m/\bstack\b/) {
	    my $old = $initialParseState ? $initialParseState->getString : 'undef';
	    my $nestState = $self->getParm('nestState', 0, 0);
	    my $new = $nestState ? $nestState->getString : 'undef';
	    print "<$name> $old -> $new\n";
	}
    }
}
	    
sub endElement {
    my ($self, $namespace, $localName, $qName) = @_;
    my $name = $namespace.$localName;
    $self->sumParent;

    if (my $literalArgs = $self->{STACK}[-1]{-literalMode}) {
	if ($self->{STACK}[-2]{-literalMode}) {
	    if ($self->{TRACE} =~ m/\bstack\b/) {
		print "\"<$name>\"\n";
	    }
	    $self->{SERIALIZER}->endElement($qName);
	} else {
	    # Find namespaces needed for nesting.
	    $self->{SERIALIZER}->endDocument;
	    my $lang = $self->{-namespaceHandler}->getXmlLang();
	    my $literalAtom = $self->{-atomDictionary}->getString($self->{SERIALIZER}->getText, undef, 'XML', $lang);
	    $self->{SERIALIZER} = undef;

	    $self->{STACK}[-1]{-variables}{'literal'} = $literalAtom;
	    $self->dispatch(@$literalArgs);
	    my $initialParseState = $self->{STACK}[-1]{-state};
	    if ($self->{TRACE} =~ m/\bstack\b/) {
		my $nextParseState = $self->{STACK}[-2]{-state};
		my $old = $initialParseState ? $initialParseState->getString : 'undef';
		my $new = ref $nextParseState ? $nextParseState->getString : "!!!$nextParseState!!!";
		print "</$name> $old -> $new\n";
	    }
	}
    } else {
	my $initialParseState = $self->{STACK}[-1]{-state};
#	$self->{GRAMMAR_STATE}->endElement($namespace, $localName, $qName);
	my $parseState = $self->getParseState("endElement($name)");
	my $grammer = $parseState->{-onTag}{$name} || $parseState->{-otherElement};

	$self->_parseCommand($parseState->{-common}{-end});
	$self->_parseCommand($grammer->{-end});

	$self->{ATTRIBUTION} = $self->{STACK}[-1]{-attribution};
	if ($self->{TRACE} =~ m/\bstack\b/) {
	    my $nextParseState = $self->{STACK}[-2]{-state};
	    my $old = $initialParseState ? $initialParseState->getString : 'undef';
	    my $new = ref $nextParseState ? $nextParseState->getString : "!!!$nextParseState!!!";
	    print "</$name> $old -> $new\n";
	}
    }
    pop (@{$self->{STACK}});
}

sub characters {
    my ($self, $ch, $start, $length) = @_;
    if ($self->{STACK}[-1]{-nextIsSum}) {
	$self->{STACK}[-1]{-nextIsSum} = 0;
    } else {
	my $nameAtom = $self->{-atomDictionary}->getString($ch, $self->{STACK}[-1]{-variables}{'datatype'}, 'PLAIN');# !!! need a real solution rather than
	my $nameTmp = $self->{STACK}[-1]{-variables}{'name'};
	$self->{STACK}[-1]{-variables}{'name'} = $nameAtom;	#     treating the characters as a tag
	$self->calculateSum($ch, undef);
	$self->{STACK}[-1]{-variables}{'name'} = $nameTmp;
    }
    if ($self->{STACK}[-1]{-literalMode}) {
	$self->{SERIALIZER}->characters($ch);
    } else {
	my $shrunk = $ch;
	$shrunk =~ s/\A(\s*)//;
	$shrunk =~ s/(\s*)\Z//;
	if ($shrunk ne '') {
	    my $parseState = $self->getParseState("characters($ch)");
	    my $nameAtom = $self->{STACK}[-1]{-variables}{'name'};
	    my $grammer = $parseState->{-onTag}{$nameAtom->getUri()} || $parseState->{-otherElement};
	    if ($parseState->{-common}{-char} || $grammer->{-char}) {
		my $lang = $self->{-namespaceHandler}->getXmlLang();
		$self->{STACK}[-1]{-variables}{'characters'} = $self->{-atomDictionary}->getString($shrunk, $self->{STACK}[-1]{-variables}{'datatype'}, 'PLAIN', $lang);
		$self->_parseCommand($parseState->{-common}{-char});
		$self->_parseCommand($grammer->{-char});
		delete $self->{STACK}[-1]{-variables}{'characters'};
	    }
	}
    }
    $self->SUPER::characters($ch, $start, $length);
}

sub mapNamespace {
    my ($self, $toMap) = @_;
    my ($nameNs, $nameTag) = $self->{-namespaceHandler}->mapNamespace($toMap);
    return $nameNs.$nameTag;
}

sub ignorableWhitespace {
    my ($self, $ch, $start, $length) = @_;
    $self->calculateSum($ch, undef);
    if ($self->{STACK}[-1]{-literalMode}) {
	$self->{SERIALIZER}->characters($ch);
    }
}

sub toString {
    my ($self, %flags) = @_;
    my $ret;
    $ret .= "$self\n";
    $ret .= "CONTAINER_ID: $self->{CONTAINER_ID}\n";
    $ret .= "-trustedIds:\n";
    map {$ret .= '  '.$_.': '.$self->{-trustedIds}{$_}->toString(%flags)."\n"} keys %{$self->{-trustedIds}};
    $ret .= "DEFAULT_DOC_TRUST:\n";
    map {$ret .= '  '.$_.': '.$self->{DEFAULT_DOC_TRUST}{$_}."\n"} keys %{$self->{DEFAULT_DOC_TRUST}};
    $ret .= "DEFAULT_LINK_TRUST:\n";
    map {$ret .= '  '.$_.': '.$self->{DEFAULT_LINK_TRUST}{$_}."\n"} keys %{$self->{DEFAULT_LINK_TRUST}};
    $ret .= $self->{-rdfDB}->toString(%flags)."\n";
    return $ret;
}

sub tweakStates {
    my ($self) = @_;
    my @keys = keys %{$self->{STATES}};
    foreach my $key (@keys) {
	if ($key !~ m/^W3C::/) { # !!!
	    my $newKey = $self->{-atomDictionary}->getString($key, undef, 'PLAIN');
	    $self->{STATES}{$newKey} = $self->{STATES}{$key};
	    delete $self->{STATES}{$key};
	}
    }
}

sub transformNamespace {
    my ($what, $from, $to) = @_;
    if (my $ref = ref $what) {
	if ($ref eq 'HASH') {
	    my @keys = keys %$what;
	    foreach my $key (@keys) {
		my $obj = $what->{$key};
		my $oldKey = $key;
		if ($key =~ s/$from/$to/g) {
		    delete $what->{$oldKey};
		    $what->{$key} = $obj;
		}
		if (ref $obj) {
		    &transformNamespace($obj, $from, $to);
		} elsif ($obj =~ s/$from/$to/g) {
		    $what->{$key} = $obj;
		}
	    }
	} elsif ($ref eq 'ARRAY') {
	    for (my $i = 0; $i < @$what; $i++) {
		my $obj = $what->[$i];
		if (ref $obj) {
		    &transformNamespace($obj, $from, $to);
		} elsif ($obj =~ s/$from/$to/g) {
		    splice (@$what, $i, 1, $obj);
		}
	    }
	} else {
	}
    } else {
    }
}

package W3C::Rdf::XmlParser;
use W3C::Rdf::Atoms qw($RDF_SCHEMA_URI);
use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK);
@ISA = qw(W3C::Util::NamedParmObject);
$VERSION = 1.0;

sub new {
    my ($proto, $rdfString, $algae2, $location, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    bless ($self, $class);
    $self->{RDF_STRING} = $rdfString;
    $self->{ALGAE2} = $algae2;
    $self->{LOCATION} = $location;
    $self->prepareParser();
    return $self;
}

sub prepareParser () {
    my ($self) = @_;
    if ($self->{ARGS}{-parser} eq 'W3C::XML::ExpatXmlParser') {
	require XML::Parser;
	$self->{XML_PARSER} = W3C::XML::ExpatXmlParser::new('W3C::XML::ExpatXmlParser');
    } else {
	use W3C::XML::XmlParser;
	$self->{XML_PARSER} = new W3C::XML::PerlXmlParser;
    }
#    $self->{XML_PARSER} = new W3C::XML::PerlXmlParser;
#    $self->{XML_PARSER} = new W3C::XML::ExpatXmlParser;
    my $errorHandler = new W3C::Rdf::RdfDbErrorHandler(-documentLocator => $self->{XML_PARSER});

    $self->{RDF_PARSER} = new W3C::Rdf::_Parser(-atomDictionary => $self->{ALGAE2}{-atomDictionary}, 
					       -nextTrustControlBlock=>1, -trustedIds=>{}, -untrustedIds=>{}, 
					       -rdfDB=>$self->{ALGAE2}->getDefaultDB(), 
					       -namespaceHandler=>undef, 
					       -errorHandler=>$errorHandler, -appendAttribution=>0);

    # use a W3C::XML::NamespaceAndStringHandler stream to map from prefix:tag - pass to rdfParser
    # so it translate back for pretty-printing
    $self->{NAMESPACE_HANDLER} = new W3C::XML::NamespaceHandler(-documentHandler => $self->{RDF_PARSER}, 
								-errorHandler => $errorHandler, 
								-passUnknownNamespaces => 1, -useSAX2 => 1, 
								-failAttrNStoEltNs => $self->{ARGS}{-props}{-failAttrNStoEltNs}, 
								$self->{-relay} ? (-relay => $self->{-relay}) : ());
    $self->{RDF_PARSER}->setNamespaceHandler($self->{NAMESPACE_HANDLER});

    # point the XML Parser at the top of the DocumentHandler stack.
    $self->{XML_PARSER}->setDocumentHandler($self->{NAMESPACE_HANDLER});
    $self->{XML_PARSER}->setErrorHandler($errorHandler);
    $self->{RDF_PARSER}->setAuth($self->{ALGAE2}->getSourceAttribution->getAuth);
}

sub parse {
    my ($self, $debug) = @_;
	# $self->{NAMESPACE_HANDLER}->addResourceMap($pubId);
	$self->{RDF_PARSER}->setState($self->{ARGS}{'-startState'}) if (defined $self->{ARGS}{'-startState'});
    my $inputSource = new W3C::XML::InputSource(\ $self->{RDF_STRING});
    $inputSource->setPublicId($self->{LOCATION});

    my $oldEH = $self->{ALGAE2}->getDefaultDB()->{-errorHandler};
    $self->{ALGAE2}->getDefaultDB()->{-errorHandler} = $self->{RDF_PARSER}{-errorHandler};
    $self->{XML_PARSER}->parse($inputSource);
    $self->{ALGAE2}->getDefaultDB()->{-errorHandler} = $oldEH;

	$self->{ATTRIBUTIONS}{$self->{LOCATION}} = $self->{RDF_PARSER}->getRootAttribution;
	# print join (' | ', ($self->{NAMESPACE_HANDLER}->getUnknownNamespaces))."\n";
	if (defined $self->{NAMESPACE_HANDLER}->getUnknownNamespaceDeclaration('rdf')) {
	    my $rdfNs = $RDF_SCHEMA_URI;
	    my $unknown = $self->{NAMESPACE_HANDLER}->getUnknownNamespaceDeclaration('rdf');
	    warn "rdf: namespace undeclared: assuming $rdfNs
-- fix this by adding 'xmlns:rdf=\"$rdfNs\"' to rdf:$unknown\n";
	    $self->{NAMESPACE_HANDLER}->addNamespace('rdf', $rdfNs, $self->{LOCATION});
	}
	$self->{RDF_PARSER}->append;
    return []; # $self->{RDF_PARSER}->getActions()
}

1;

# some imple notes that need to be gathered and well-presented
#			reification	reificationBag
# 0	D1		I-1		B-2
# 1	D0.attr-value	gen		B0
# 2	P0.resource	I0		B-1
# 3	P0.attr-value	gen+/I0*	B0+/B1*
#			+ - nested description node
#			* - attribute-value triples

__END__

=head1 NAME

W3C::Rdf::XmlParser - parse RDF/XML and fill an RdfDB

=head1 SYNOPSIS

  use W3C::Rdf::XmlParser;
  use W3C::XML::XmlParser;
  use W3C::XML::InputSource;
  use W3C::XML::XmlElement;
  use W3C::XML::NamespaceHandler;
  
  &main(\@ARGV);
  
  sub main {
      my ($args) = @_;
      my ($source, @lookFors) = @$args; # ($args->[0], @$args[1..$#$args]);
  
      my $t0 = time; print "start\n";
  
      my $xmlParser = new W3C::XML::PerlXmlParser;
  #    my $xmlParser = new W3C::XML::ExpatXmlParser;
      my $errorHandler = new SAXErrorHandler($xmlParser);
      my $rdfDB = new W3C::Rdf::RdfDB($errorHandler, 1); # easier to read with lazy reification
      my $rdfParser = new W3C::Rdf::XmlParser(1, {}, {}, $rdfDB, undef, $errorHandler);
  
      # it's easiest to stick all your document handlers in a W3C::XML::HandlerList
  #    my $handlerList = new W3C::XML::HandlerList([new W3C::XML::XmlElementTree, $rdfParser], [$errorHandler]);
      my $handlerList = new W3C::XML::HandlerList([$rdfParser], [$errorHandler]);
  #    my $handlerList = new W3C::XML::HandlerList([], [$errorHandler]);
  
      # use a W3C::XML::NamespaceHandler stream to map from prefix:tag - pass to rdfParser
      # so it translate back for pretty-printing
      my $namespaceHandler = new W3C::XML::NamespaceHandler($handlerList);
      $rdfParser->setNamespaceHandler($namespaceHandler);
  
      # and have the W3C::XML::HandlerList be the document handler and the error handler
      $xmlParser->setDocumentHandler($namespaceHandler);
      $xmlParser->setErrorHandler($handlerList);
  
      # assign a URI to the XML in InputSorce and parse it
      my $inputSource = new W3C::XML::FileInputSource($source);
      eval {$xmlParser->parse($inputSource);};
      if ($@) {
      	die $@.' at line '.$xmlParser->getLineNumber.' column '.$xmlParser->getColumnNumber;
      }
      my $t2 = time; print $t2-$t0,"\n";
  
      # some ways to toString the result
  #    print $xmlParser->toString('');
      print $rdfDB->showTriples('  ', $rdfParser); # give $rdfParser as a W3C::XML::NamespaceHandler to unmap names.
      print "--------end of triples--------\n";
  
      # exercise some query functions in the W3C::Rdf::RdfDB
      @lookFors = ('http://www.w3.org/schema/certHTMLv1/access', 
  		 'http://www.w3.org/schema/certHTMLv1/accessor', 
  		 'http://www.w3.org/schema/certHTMLv1/hasAccessTo') if (!@lookFors);
      my @nodes = $rdfDB->nodesWithType(undef, 'http://www.w3.org/schema/certHTMLv1/resourceAccessRule');
  #    my @nodes = $rdfDB->nodesWithAllPredicates(undef, \@lookFors);
  
      # find all defined recombinations of the objects of the nodes
      my @join = $rdfDB->join(undef, \@nodes, \@lookFors);
  
      # show the onces we got
      foreach my $element (@join) {
  	for (my $i = $0; $i <= $#lookFors; $i++) {
  	    print $lookFors[$i].': '.$element->[$i].'  ';
  	}
  	print "\n";
      }
  
      # demonstrate the anySubjects function
      my @supplied = $rdfDB->supplied;
      my @theirStatements = $rdfDB->anySubjects(\@supplied, [$inputSource->getPublicId]);
      foreach my $triple (@theirStatements) {
  	print $triple->toString."\n";
      }
  
      # test the anyContainerNodes function to make sure the acl stuff keeps working
      foreach my $node (@nodes) {
  	my @resourceList = $rdfDB->triplesMatching(undef, [['http://www.w3.org/schema/certHTMLv1/hasAccessTo', $node, undef]]);
  	my @resources;
  	map {push (@resources, $_->object)} @resourceList;
  	my @t = $rdfDB->anyContainerNodes(undef, [$node]);
  #	my @u = $rdfDB->hasAboutEach($node);
  	map {print "\$aclDB->addResourceAttribute(['".join('\',\'', @resources)."'], {'aclBinBag', ".$_->subject."})\n"} @t;
      }
  
      return;
  }
  
  package SAXErrorHandler;
  
  # this error handler is general enough to handle SAXExceptions and RdfDBExceptions
  
  sub new {
      my $class = shift;
      my $proto = ref $class || $class;
      my $self = {};
      bless($self, $proto);
      $self->{XML_PARSER} = shift;
      return $self;
  }
  
  sub makeString {
      my ($self, $exception) = @_;
      my $ret = $exception->toString;
      if ($exception->isa('W3C::Rdf::RdfDBException')) {
  	$ret .= ' at line '.$self->{XML_PARSER}->getLineNumber.' column '.$self->{XML_PARSER}->getColumnNumber;
      }
      return $ret;
  }
  
  sub warning {
      my ($self, $exception) = @_;
      print 'warning: '.$self->makeString($exception)."\n";
  }
  
  sub error {
      my ($self, $exception) = @_;
      warn 'error: '.$self->makeString($exception)."\n";
  }
  
  sub fatalError {
      my ($self, $exception) = @_;
      die 'fatalError: '.$self->makeString($exception)."\n";
  }

=head1 DESCRIPTION

W3C::XML::XmlHandler to store RDF information in an RdfDB for later manipulation.

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

=head1 AUTHOR

Eric Prud\'hommeaux <eric@w3.org>

=head1 SEE ALSO

W3C::Rdf::RdfDB(3) W3C::XML::XmlParser(3) perl(1).

=cut
