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

# $Id: XmlParser.pm,v 1.65 2004/06/06 22:58:17 eric Exp $

use strict;
require Exporter;
require AutoLoader;

use W3C::XML::DtdDB;
use W3C::XML::XmlElementTree;
use W3C::XML::SAXParseException;
use W3C::XML::AttributeListImpl;

$W3C::XML::XmlParser::REVISION = '$Id: XmlParser.pm,v 1.65 2004/06/06 22:58:17 eric Exp $ ';

package W3C::XML::XmlParser;
use W3C::Util::Exception;
use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK @TODO);
@ISA = qw(Exporter AutoLoader);
@EXPORT = qw();
@EXPORT_OK = qw();
$VERSION = 1.00;
$DSLI = 'adpO';
@TODO = ('more DTD support', 
	 'follow SAX2 spec');

#####
# per-class data

my $Debugging = 0;	# whether to show debugging stuff
my $Outstanding = 0;	# count of outstanding connections

#####
# per-object data
# COMPLETE_TAG	- contents of inspected tag
# XML_DECLARED	- XML declaration seen
# PI_COUNT	- count of PI's encountered
# COMMENT_COUNT	- count of comments encountered
# DOCTYPE_COUNT - count of doctypes encountered
# ELEMENT_COUNT - count of plain elements encountered
# ERROR_COUNT	- guess
# LINENUMBER	- current line
# COLUMNNUMBER	-   and column
# TREE		- an W3C::XML::XmlElementTree accumulating all the elements

# ERRSTR	-  error string from last SQL update
# DEBUG		- per-object control of debugging info

#####
# new - prepare a W3C::XML::XmlParser with a new connection

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    $self->{ERRSTR} = 0;
    $self->{DEBUG} = 0;
    # "private" data
    $self->{"_OUTSTANDING"} = \$Outstanding;
    bless ($self, $class);
    ++ ${ $self->{"_OUTSTANDING"} };
    return $self;
}

sub setLocale {
    my ($self, $locale) = @_;
#    $self->{LOCAL} = shift;
    die "setLocal(Locale=$locale) not implemented";
}

sub setEntityResolver {
    my $self = shift;
    $self->{ENT_RESOLVER} = shift;
}

sub setDTDHandler {
    my $self = shift;
    $self->{DTD_HANDLER} = shift;
}

sub setDocumentHandler {
    my $self = shift;
    $self->{DOC_HANDLER} = shift;
}

sub setErrorHandler {
    my $self = shift;
    $self->{ERROR_HANDLER} = shift;
}

sub setDTDDatabase {
    my ($self, $dtdDB) = @_;
    $self->{DTD_DB} = $dtdDB;
}

#####
# errstr - get/set errstr

sub errstr {
    my $self = shift;
    if (@_) { $self->{ERRSTR} = shift }
    return $self->{ERRSTR};
}

#####
# debug - cannonical debugging stuff from
# http://www.perl.com/CPAN-local/doc/manual/html/pod/perltoot/Debuging_Methods.html

sub debug {
    my ($self, $level) = @_;
    warn "usage: thing->debug(level)"    unless @_ == 1;
    if (ref($self))  {
	$self->{"_DEBUG"} = $level;         # just myself
    } else {
	$Debugging        = $level;         # whole class
    }
}

#####
# DESTROY - hook to display debugging info

sub DESTROY {
    my $self = shift;
    if ($Debugging || $self->{"_DEBUG"}) {
	warn "W3C::XML::XmlParser destroying $self " . $self->name;
    }
    -- ${ $self->{"_OUTSTANDING"} };
}

#####
# END - hook to display debugging info

sub END {
    if ($Debugging) {
	print "All XmlParsers are going away now.\n";
    }
}

sub getPublicId {
    my ($self) = @_;
    return $self->{PUBLICID};
}

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

#####
# parse

sub parse {
    my ($self, $input) = @_;
    $self->{PUBLICID} = $input->getPublicId();
    $self->{SYSTEMID} = $input->getSystemId();
    $self->{BASEREADER} = $input->getByteStream();
    $self->{ENCODING} = $input->getEncoding();
    $self->{DTD_DB} = new W3C::XML::DtdDB($self->{ERROR_HANDLER}, $self) if (!defined $self->{DTD_DB});

    # start document
    $self->parseDocument();
}

# a function call wrapper to add a SAXParseException to other exceptions

sub wrap {
    my ($self, $handler, $method, @args) = @_;
    my @a;
    eval {
	@a = $self->{$handler}->$method(@args);
    }; if ($@) {if (my $ex = &catch('W3C::XML::SAXParseException')) {
	&throw($ex);;
    } elsif ($ex = &catch('W3C::Util::Exception')) {
	#my $newEx = new W3C::XML::ChainedSAXParseException($self, {-chainedException => $ex, -locator => $self});
	my $newEx = new W3C::XML::ChainedSAXParseException(-locator => $self, -chainedException => $ex);
	$newEx->assumeStackTrace($ex);
	&throw($newEx);
    } else {
	&throw(new W3C::XML::DieSAXParseException(-locator => $self, -dieException => $@));;
    }}
    return @a;
#    &throw(new W3C::Util::ProgramFlowException(-class => (ref $self), -method => 'wrap', -location => 'end'));
}

# BASEREADER may be HUGE so watch out
sub show {
    my ($self, $prefix) = @_;
    my $ret;
    $ret .= $prefix.$self."\n";
    $ret .= $prefix.'PUBLICID: '.$self->{PUBLICID}."\n";
    $ret .= $prefix.'SYSTEMID: '.$self->{SYSTEMID}."\n";
    $ret .= $prefix.'DOC_HANDLER: '.$self->{DOC_HANDLER}."\n";
    $ret .= $prefix.'ERROR_HANDLER: '.$self->{ERROR_HANDLER}."\n";
    my $baseReaderText = length $self->{BASEREADER} <= 1024 ? 
	$self->{BASEREADER} : 
	    substr ($self->{BASEREADER}, 0, 512)."\n...\n".substr ($self->{BASEREADER}, -512, 512);
    $ret .= $prefix.'BASEREADER: '.$baseReaderText."\n";
    eval {$ret .= $prefix.'TREE: '.$self->{DOC_HANDLER}->show($prefix)."\n";}; # don't assume the function exists
    return $ret;
}

package W3C::XML::PerlXmlParser;
@W3C::XML::PerlXmlParser::ISA = ('W3C::XML::XmlParser');
use W3C::Util::Exception;

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

sub StartDocument {
    my ($self) = @_;
    $self->{COMPLETE_TAG} = undef;
    $self->{DELIM} = undef;
    $self->{XML_DECLARED} = undef;
    $self->{PI_COUNT} = 0;
    $self->{COMMENT_COUNT} = 0;
    $self->{DOCTYPE_COUNT} = 0;
    $self->{ELEMENT_COUNT} = 0;
    $self->{ERROR_COUNT} = 0;
    $self->{TAG_STACK} = [];
}

sub pushContext {
    my ($self, $type, $publicId, $systemId, $stream, $encoding) = @_;
#    my $input = $self->{ENT_RESOLVER}->resolveEntity($publicId,  $systemId) if (defined $systemId);
    push (@{$self->{ENTITYSTACK}}, (defined $systemId) ? $systemId : '[external stream]');
    push (@{$self->{CONTEXT}}, [$self->{TYPE}, $self->{PUBLICID}, $self->{SYSTEMID}, 
				$self->{BASEREADER}, $self->{ENCODING}, pos $self->{BASEREADER}]);
    ($self->{TYPE}, $self->{PUBLICID}, $self->{SYSTEMID}, $self->{BASEREADER}, $self->{ENCODING}, pos $self->{BASEREADER}) = 
	($type, $publicId, $systemId, $stream, $encoding, 0);
    $self->{COLUMNNUMBER} = 0;
    $self->{LINENUMBER} = 1;
    $self->{BYTENUMBER} = 1;
    # @@@ check input and stream - may have to construct URL connection
    # @@@ set encoding
    # <?xml version=["']1.0" [encoding="enc" standalone="asdf"]?>
    # or handle it as a PI
}

sub popContext {
    my ($self) = @_;
    my $pos;
    ($self->{TYPE}, $self->{PUBLICID}, $self->{SYSTEMID}, $self->{BASEREADER}, $self->{ENCODING}, $pos) = 
	@{pop (@{$self->{CONTEXT}})};
    pos $self->{BASEREADER} = $pos;
}

sub getColumnNumber {
    my ($self) = @_;
    return $self->{COLUMNNUMBER};
}

sub getLineNumber {
    my ($self) = @_;
    return $self->{LINENUMBER};
}

sub getByteNumber {
    my ($self) = @_;
    return $self->{BYTENUMBER};
}

sub getContextString {
    my ($self, $prefix1, $prefixn, $maxWidth) = @_;
    if (defined ($prefix1) && !defined ($prefixn)) {
	$prefixn = ' ' x length ($prefix1);
    }
    #my ($head, $lineHead, $ctxString, 
    #	$indicator, $lineTail, $tail, $line, $column) = 
    return W3C::Util::CachedContextException::getContextString($self->{BASEREADER}, $self->getByteNumber, $maxWidth);
    #return "$head$lineHead$lineTail\n$ctxString$indicator";
}

#####
# calcLine - as data is read from BASEREADER, it is passed to calcLine which
#            reviews the extracted text and updates the text point for 
#            XmpParser's Locator capacity.

sub calcLine {
    my $self = shift;
    foreach my $arg (@_) {
	my $copy = $arg;
	$self->{BYTENUMBER} += length $arg;
	while ($copy =~ m/\G (.*?) ((?:\r\n)|\r|\n) /gcxs) {
	    $self->{COLUMNNUMBER} = 0;
	    $self->{LINENUMBER}++;
	}
	$self->{COLUMNNUMBER} += length($copy) - pos $copy;
#	$self->{COLUMNNUMBER} = 0;
#	my $l = length($copy);
#	my $p = pos $copy;
#	$self->{COLUMNNUMBER} = $l - $p;
    }
}

###
# parseDocument
#
# This parser attempts to simplify the parsing process by violating the standard
# top-down approach by gathering all the like parse cases together and handling
# then in this function. better? worse? I don't know.

$W3C::XML::XmlParser::XML_IN_PI		= [[16,17],	1, 'string \'xml\' in PI'];
$W3C::XML::XmlParser::PREMATURE_END	= [[-1],	2, 'premature end of document'];
$W3C::XML::XmlParser::GARBAGE_AT_END	= [[-1],	2, 'garbage at end of document'];
$W3C::XML::XmlParser::EMPTY_ROOT		= [[-1],	2, 'no root declared'];

sub parseDocument {
    my ($self) = @_;
    $self->pushContext("[document]",  $self->{PUBLICID}, $self->{SYSTEMID}, $self->{BASEREADER}, $self->{ENCODING});
    $self->StartDocument;		# prepare new parse tree.
    $self->wrap('DOC_HANDLER', 'setDocumentLocator', $self);
    $self->wrap('DOC_HANDLER', 'startDocument', );

    # [1] document ::= prolog element Misc*
    # break up line on end bracket or quote
    while (1) {
	my ($characters, $completeTag, $delim);
	# if ($self->{BASEREADER} =~ m/\G ([^<\&]*) < ([^>\'\"]+) ([>\'\"]) /gcxs) {	# @@@ still need entity support?
	if ($self->{BASEREADER} =~ m/\G ([^<]*) < ([^>\'\"]+) ([>\'\"]) /gcxs) {
	    ($characters, $completeTag, $delim) = ($1, $2, $3);

	    #  [14] CharData ::= [^<&]* - ([^<&]* ']]>' [^<&]*)
	    #  [67] Reference ::= EntityRef | CharRef
	    #  [68] EntityRef ::= '&' Name ';'
	    #  [69] PEReference ::= '%' Name ';'
	    # @@@ expand References here...
	    if ($characters ne '') {
		$self->{CHAR_DATA_LENGTH} = length ($characters);
		$self->calcLine($characters);
		$characters = $self->{DTD_DB}->expandEntities($characters) if ($self->{DTD_DB});
		$self->CharData($characters);
		$self->{CHAR_DATA_LENGTH} = 0;
	    }
	    $self->calcLine('<', $completeTag, $delim);
	    $self->processTag($completeTag, $delim);
	} else {
	    last;
	}
    }

    $self->structuredError($W3C::XML::XmlParser::PREMATURE_END, undef, '/'.$self->{TAG_STACK}->[-1]) 
	if ($#{$self->{TAG_STACK}} >= $[);
    $self->structuredError($W3C::XML::XmlParser::GARBAGE_AT_END, substr ($self->{BASEREADER}, pos $self->{BASEREADER}, 50)) 
	if ($self->{BASEREADER} !~ m/\G \s* \Z/gcxs);
    $self->structuredError($W3C::XML::XmlParser::EMPTY_ROOT) if (!$self->{ELEMENT_COUNT}); # !!! check
    $self->wrap('DOC_HANDLER', 'endDocument', );
}

sub nextTag999 {
    my ($self) = @_;
#   if ($self->{BASEREADER} =~ m/\G ([^<\&]*) < ([^>\'\"]+) ([>\'\"]) /gcxs) {	# @@@ still need entity support?
    if ($self->{BASEREADER} =~ m/\G ([^<]*) < ([^>\'\"]+) ([>\'\"]) /gcxs) {	#     or is ignorance sufficient?
	$self->calcLine($1, '<', $2, $3);
	return ($1, $2, $3);
    }
    &throw(new W3C::Util::EOFException);
}

sub processTag {
    my ($self, $completeTag, $delim) = @_;
    $self->{COMPLETE_TAG} = $completeTag;

    #  [22]  prolog ::= XMLDecl? Misc* (doctypedecl Misc*)?
    # XMLDecl
    if ($self->{COMPLETE_TAG} =~ m/\A \Q?xml\E \s+ /gcxs) {
	#  [23] XMLDecl ::= '<?xml' VersionInfo EncodingDecl? SDDecl? S? '?>'
#	    $self->XMLDecl($self->findTagEndEatQuotes('\?', '?', $delim));
	my $words = $self->findTagEndEatQuotes('?', '?', $delim);
	$self->XMLDecl($words);
	$self->{XML_DECLARED} = 1;
    }
    #  [27] Misc ::= Comment | PI |  S
    elsif ($self->{COMPLETE_TAG} =~ m/\A \Q!--\E /gcxs) {
	#  [15] Comment ::= '<!--' ((Char - '-') | ('-' (Char - '-')))* '-->'
	$self->Comment($self->findTagEnd('--', '--'));
	$self->{COMMENT_COUNT}++;
    }
    elsif ($self->{COMPLETE_TAG} =~ m/\A \Q?\E /gcxs) {
	#  [16] PI ::= '<?' PITarget (S (Char* - (Char* '?>' Char*)))? '?>'
	my $words = $self->findTagEnd('?', '?');
	my ($target, $data) = (shift @$words, shift @$words); # split('\s+', $self->{COMPLETE_TAG}, 2);
	#  [17] PITarget ::= Name - (('X' | 'x') ('M' | 'm') ('L' | 'l'))
	$self->structuredError($W3C::XML::XmlParser::XML_IN_PI) if ($target =~ m/xml/i && $target !~ m/xml-stylesheet/i);
	$self->wrap('DOC_HANDLER', 'processingInstruction', $target, $data);
	$self->{PI_COUNT}++;
    }
    #  [28] doctypedecl ::= '<!DOCTYPE' S Name (S ExternalID)? S? ('[' (markupdecl | PEReference | S)* ']' S?)? '>'
    elsif ($self->{COMPLETE_TAG} =~ m/\A \Q!DOCTYPE\E /gcxs) {
	my $words = $self->findTagEndEatQuotes('', '', $delim);
	$self->doctypedecl($words, $delim);
	$self->{DOCTYPE_COUNT}++;
    }
    #  [39] element ::= EmptyElemTag | STag content ETag
    # content comes back here so we have to parse all of:
    #  [43] content ::= (element | CharData | Reference | CDSect | PI | Comment)*
    # CharData, Reference, PI and Comment already handled so sepparate CDSect from element
    elsif ($self->{COMPLETE_TAG} =~ m/\A \!\[CDATA\[ /gcsx) { 
#	    $self->CDSect($self->findTagEndEatQuotes('\]\]', ']]', $delim));
#	my $words = $self->findTagEndEatQuotes(']]', ']]', $delim);
	my $words = $self->findTagEnd(']]', ']]'); # @@@ untested
	$self->CDSect($words);
    } else {
#	    $self->element($self->findTagEndEatQuotes('', '', $delim));
	my $words = $self->findTagEndEatQuotes('', '', $delim);
	if ($self->{DTD_DB}) {
	    for (my $i = 0; $i < @$words; $i++) {
		$words->[$i] = $self->{DTD_DB}->expandEntities($words->[$i]);
	    }
	}
	$self->element($words);
    }
}

#####
# findTagEndEatQuotes
#
#  - incorporates >s that don't follow $lookFor into $self->{COMPLETE_TAG}. The
#    caller must check to see if they are legal. For instance, [15] Comment
#    or [20] CData take [2] Char, while tag names take a [5] Name.

$W3C::XML::XmlParser::UNTERMINATED_QUOTE	= [[-1],	2, 'quote terminator not found'];

sub findTagEndEatQuotes {
    my ($self, $lookFor, $translatesTo, $delim) = @_;
    my @words = split('\s+', $self->{COMPLETE_TAG});
    while ($self->{COMPLETE_TAG} !~ m/\Q$lookFor\E\Z/ || $delim eq '\'' || $delim eq '"') {
	if ($delim eq '\'' || $delim eq '"') {
	    # find closing quote
	    $self->{BASEREADER} =~ m/\G ([^<\Q$delim\E]*) \Q$delim\E /gcxs || 
		$self->structuredError($W3C::XML::XmlParser::UNTERMINATED_QUOTE, undef, $delim);
	    $self->calcLine($1, $delim);
	    $self->{COMPLETE_TAG} .= $delim.$1.$delim;
	    push (@words, $1);
	}

	# find another open quote or the end of the tag
	$self->{BASEREADER} =~ m/\G (\s*) (.*?) (\'|\"|>) /gcxs || 
	    $self->structuredError($W3C::XML::XmlParser::UNTERMINATED_COMMENT, undef, $delim);
	$delim = $3;
	$self->calcLine($1, $2, $delim);
	$self->{COMPLETE_TAG} .= $2;
	push (@words, split('\s+', $2));
    }
    return &_hackAttributesWOEquals(\@words);
}

sub _hackAttributesWOEquals {
    my ($words) = @_;
    for (my $i = 0; $i < @$words-1; $i++) {
	if ($words->[$i+1] eq '=') {
	    $words->[$i] = "$words->[$i]=";
	    splice (@$words, $i+1, 1);
	}
    }
    return $words;
}

sub hibby {
	    my $b = "abefcdefgh";
	    $b =~ m/\G (.*?) ef/gcsx;
	    print $1, pos $b, "\n";
	    $b =~ m/\G (.*?) ef/gcsx;
	    print $1, pos $b, "\n";
}

# find ends of PIs and comments

$W3C::XML::XmlParser::UNTERMINATED_COMMENT	= [[-1],	2, 'comment terminator not found'];

sub findTagEnd {
    my ($self, $lookFor, $translatesTo) = @_;
    my @words = split('\s+', $self->{COMPLETE_TAG});
    if ($self->{COMPLETE_TAG} !~ m/\G (.*?) \Q$lookFor\E \Z/gcxs) {
	($self->{BASEREADER} =~ m/\G (.*?) \Q$lookFor\E\> /gcxs) || 
	    $self->structuredError($W3C::XML::XmlParser::UNTERMINATED_COMMENT, undef, $lookFor);
	$self->calcLine($1, $lookFor, '>');
	$self->{COMPLETE_TAG} = $self->{COMPLETE_TAG}.'>'.$1.$lookFor;
	push (@words, split('\s+', $1));
    }
    return \@words;
}

#####
# reportText - break up ignorable whitespace from characters

$W3C::XML::XmlParser::COMMENT_IN_CHARDATA	= [[-1],	2, '\']]>\' in CharData'];
$W3C::XML::XmlParser::CHARDATA_NOT_IN_EL	= [[-1],	2, 'CharData not in an element'];

sub CharData {
    my ($self, $characters) = @_;

    #  [39] element ::= EmptyElemTag | STag content ETag
    #  [43] content ::= (element | CharData | Reference | CDSect | PI | Comment)*
    if ($characters =~ m/\A\s*\Z/) {
	if (!$self->{ELEMENT_COUNT}) {
	    return;
	}
    } else {
	if (!$self->{ELEMENT_COUNT}) { # could use @{$self->{TAG_STACK}} <= 0
	    $self->structuredError($W3C::XML::XmlParser::CHARDATA_NOT_IN_EL, $characters);
	}
    }
    #  [14] CharData ::= [^<&]* - ([^<&]* ']]>' [^<&]*)
    $self->structuredError($W3C::XML::XmlParser::COMMENT_IN_CHARDATA, $characters) if ($characters =~ m/]]>/);

    # fold \r\n and \r into \n - XML:2.11
    $characters =~ s/\r\n/\n/g;
    $characters =~ tr/\r/\n/;

    if (0) { # if we are validating with a DTD
	if ($characters =~ m/\G (\s+) /gcxs) {	# leading ignorables
	    $self->IgnoreWhite($1);
	}
	while ($characters =~ m/\G (.*?) (\s{2,}) /gcxs) {	# nested ignorables
	    $self->Char($1) if ($1 ne '');
	    $self->IgnoreWhite($1.$2) if ($1.$2 ne ''); # @@@ opt
	}
	if ($characters =~ m/\G (.*?) (\s+)\Z /gcxs) {	# trailing ignorables
	    $self->Char($1) if ($1 ne '');
	    $self->IgnoreWhite($1.$2) if ($1.$2 ne ''); # @@@ opt
	}
    } else {
	$self->Char($characters);
#	if ($characters =~ m/\S/) {		# any non-white space?
#	    $self->Char($characters);
#	} else {
#	    $self->IgnoreWhite($&);
#	}
    }
}

sub Char {
    my ($self, $chars) = @_;
    $self->wrap('DOC_HANDLER', 'characters', $chars, 0, length($chars));
}

sub IgnoreWhite {
    my ($self, $chars) = @_;
    $self->wrap('DOC_HANDLER', 'ignorableWhitespace', $chars, 0, length($chars));
}

$W3C::XML::XmlParser::XML_DECL_TOO_LATE	= [[1,22,23],	2, 'XML declaration must be at start of document'];
$W3C::XML::XmlParser::MISSING_XML_DECL	= [[1,22,23], 	2, 'expected ?xml'];
$W3C::XML::XmlParser::NO_XML_VERSION	= [[1,22,23], 	2, 'no XML version'];
$W3C::XML::XmlParser::INVALID_XML_VERSION	= [[1,22,23],	0, 'invalid XML version'];
$W3C::XML::XmlParser::LATER_XML_VERSION	= [[1,22,23],	0, 'later XML version, winging it'];
$W3C::XML::XmlParser::INVALID_ENCODING	= [[1,22,23],	2, 'invalid encoding'];
$W3C::XML::XmlParser::INVALID_SDDECL	= [[1,22,23],	2, 'invalid SDDecl'];
$W3C::XML::XmlParser::BAD_XML_DECL	= [[1,22,23], 	2, 'could not parse XML declaration'];
sub XMLDecl {
    my ($self, $words) = @_;

    #  [1] document ::= prolog element Misc*
    #  [22]  prolog ::= XMLDecl? Misc* (doctypedecl Misc*)?
    if ($self->{XML_DECLARED} || $self->{PI_COUNT}>0 || 
	$self->{COMMENT_COUNT}>0 || $self->{DOCTYPE_COUNT}>0 || 
	$self->{ELEMENT_COUNT}>0) { 
	$self->{ERROR_COUNT}++;
	$self->structuredError($W3C::XML::XmlParser::XML_DECL_TOO_LATE); 
    }

    #  [23] XMLDecl ::= '<?xml' VersionInfo EncodingDecl? SDDecl? S? '?>'
    my $word = shift @$words;
    $self->structuredError($W3C::XML::XmlParser::MISSING_XML_DECL, $word) if ($word ne '?xml');
    #  [24] VersionInfo ::= S 'version' Eq (' VersionNum ' | " VersionNum ")
    $word = shift @$words;
    $self->structuredError($W3C::XML::XmlParser::NO_XML_VERSION, $word) if ($word ne 'version=');
    $word = shift @$words;
    $self->structuredError($W3C::XML::XmlParser::INVALID_XML_VERSION, $word) if ($word !~ m/\A([a-zA-Z0-9_\/.:]+|-+)\Z/);
    $self->structuredError($W3C::XML::XmlParser::LATER_XML_VERSION, $word, '1.0') if ($word != 1.0);
    $word = shift @$words;
    if ($word eq 'encoding=') {
	#  [80] EncodingDecl ::= S 'encoding' Eq ('"' EncName '"' |  "'" EncName "'" ) 
	$word = shift @$words;
	#  [81] EncName ::= [A-Za-z] ([A-Za-z0-9._] | '-')*
	$self->structuredError($W3C::XML::XmlParser::INVALID_ENCODING, $word) if ($word !~ m/\A([A-Za-z][a-zA-Z0-9\/\._\-]*)\Z/);
	$word = shift @$words;
    }

    if ($word eq 'standalone=') {
	#  [32] SDDecl ::= S 'standalone' Eq (("'" ('yes' | 'no') "'") | ('"' ('yes' | 'no') '"'))
	$word = shift @$words;
	$self->structuredError($W3C::XML::XmlParser::INVALID_SDDECL, $word) if ($word !~ m/\A(yes|no)\Z/);
	$word = shift @$words;
    }
    $self->structuredError($W3C::XML::XmlParser::BAD_XML_DECL, $word) if ($word ne '?');
}

$W3C::XML::XmlParser::TOO_MANY_DOCTYPES	= [[-1],	2, 'only one doctype allowed'];
$W3C::XML::XmlParser::DOCTYPE_TOO_LATE	= [[-1],	2, 'doctype must be in XML prolog'];

sub doctypedecl {
    my ($self, $words, $delim) = @_;
    $self->structuredError($W3C::XML::XmlParser::TOO_MANY_DOCTYPES) if ($self->{DOCTYPE_COUNT}>0);
    $self->structuredError($W3C::XML::XmlParser::DOCTYPE_TOO_LATE) if ($self->{ELEMENT_COUNT}>0);
    my ($Name_ExternalID, $markupdecl_PEReference) = $self->{COMPLETE_TAG} =~ m/\G ([^\[]*) \[ (.*) /xs;
    if ($markupdecl_PEReference) {
	if ($markupdecl_PEReference =~ m/\A \s* \% (\w+) \Z/s) {
	    my $PEReference = $1;
	    $self->{COMPLETE_TAG} = "$Name_ExternalID expand($PEReference)\n";
	} else {
	    pos $self->{BASEREADER} -= length($markupdecl_PEReference);
	    $self->markupdecl(']>') if ($self->{COMPLETE_TAG} =~ m/\[/);
	}
    }
    my ($dummy, $root, $id) = (shift @$words, shift @$words, shift @$words);
    $self->{DTD_DB}->setExpectedRoot($root) if ($self->{DTD_DB});
    return if ($id eq '[' || !@$words);
    my ($pubId, $sysId);
    if ($id eq 'SYSTEM') {
	($sysId) = (shift @$words);
    } elsif ($id eq 'PUBLIC') {
	($pubId, $sysId) = (shift @$words, shift @$words);
    } else {
	$sysId = $id;
    }
    if ($self->{DTD_HANDLER}) {
	use W3C::XML::InputSource;
	my $inputSource = new W3C::XML::FileInputSource($sysId);
	my $dtd = $inputSource->getByteStream;    
	$self->pushContext("[dtd]",  $pubId, $sysId, $dtd, $self->{ENCODING});
	#    my $markupdecl = $self->findTagEndEatQuotes(']', ']', undef);
	$self->markupdecl; #($markupdecl);
	$self->popContext;
    }
}

$W3C::XML::XmlParser::INVALID_MARKUPDECL= [[16,17],	1, 'invalid markupdecl'];
sub markupdecl {
    my ($self, $endOn) = @_;
    # Treat Name in this area as a possible PEReference, though not in spec (?)
    while ($self->{BASEREADER} =~ m/\G (\s*) (\Q$endOn\E) /gcxs || 
	   $self->{BASEREADER} =~ m/\G ([^<]*) < ([^>\'\"]+) ([>\'\"]) /gcxs) {
	if ($2 eq $endOn) {
	    $self->calcLine($1, $endOn);
	    last;
	}
	$self->calcLine($1, '<', $2, $3);
	my $characters = $1;
	$self->{COMPLETE_TAG} = $2;
	my $delim = $3;
	$characters =~ s/\A\s*(.*?)\s*\Z/$1/;
	$characters = $self->{DTD_DB}->importIds($characters) if ($self->{DTD_DB}); # ??? xhtml1-strict.dtd:20

	$self->structuredError($W3C::XML::XmlParser::INVALID_MARKUP, $characters) if ($characters =~ m/\S/);
	#  [28] doctypedecl ::= '<!DOCTYPE' S Name (S
        #                       ExternalID)? S? ('[' (markupdecl
        #                       | PEReference | S)* ']' S?)? '>'
        #  [29]  markupdecl ::= elementdecl | AttlistDecl
        #                       | EntityDecl | NotationDecl | PI
        #                       | Comment 

	#  [45] elementdecl ::= '<!ELEMENT' S Name S
        #                        contentspec S? '>'
	if ($self->{COMPLETE_TAG} =~ m/\A \Q!ELEMENT\E /gcxs) {
	    my $words = $self->findTagEndEatQuotes('', '', $delim);
	    shift @$words;
	    #  [46] contentspec ::= 'EMPTY' | 'ANY' | Mixed
	    #                        | children
	    my $name = shift @$words;
	    if ($words->[0] eq 'EMPTY') {
		$self->{DTD_DB}->addDecl(new W3C::XML::elementdecl($name, 1, 0, undef)) if ($self->{DTD_DB});
	    } elsif ($words->[0] eq 'EMPTY') {
		$self->{DTD_DB}->addDecl(new W3C::XML::elementdecl($name, 0, 1, undef)) if ($self->{DTD_DB});
	    } else {
		#  [51] Mixed ::=  '(' S? '#PCDATA' (S? '|' S? Name)*
		#                  S? ')*' 
		#                  | '(' S? '#PCDATA' S? ')'
		#  [47] children ::=  (choice | seq) ('?' | '*'
		#                     | '+')?
		#  [48]       cp ::=  (Name | choice | seq) ('?' | '*'
		#                     | '+')?
		#  [49]   choice ::=  '(' S? cp ( S? '|' S? cp )* S?
		#                     ')'
		#  [50]      seq ::=  '(' S? cp ( S? ',' S? cp )* S?
		my $token = join (' ', @$words);
		$token = $self->{DTD_DB}->expandPERefs($token) if ($self->{DTD_DB});
		$token =~ s/style\|meta\|link\|//g;
		$self->{DTD_DB}->addDecl(new W3C::XML::elementdecl($name, 0, 0, $token)) if ($self->{DTD_DB}); # $curRepeats));
	    }
	}
        #  [52] AttlistDecl ::=  '<!ATTLIST' S Name AttDef* S? '>'
	elsif ($self->{COMPLETE_TAG} =~ m/\A \Q!ATTLIST\E /gcxs) {
	    my $words = $self->findTagEndEatQuotes('', '', $delim);
	    shift @$words;
	    #  [53]      AttDef ::=  S Name S AttType S DefaultDecl ')'
	    #  [54]       AttType ::=  StringType | TokenizedType
	    #                          | EnumeratedType 
	    #  [55]    StringType ::=  'CDATA'
	    #  [56] TokenizedType ::=  'ID'
	    #                          | 'IDREF'
	    #                          | 'IDREFS'
	    #                          | 'ENTITY'
	    #                          | 'ENTITIES'
	    #                          | 'NMTOKEN'
	    #                          | 'NMTOKENS'
	    #  [57] EnumeratedType ::=  NotationType | Enumeration 
	    #  [58]   NotationType ::=  'NOTATION' S '(' S? Name (S? '|'
	    #                           S? Name)* S? ')' 
	    #  [59]    Enumeration ::=  '(' S? Nmtoken (S? '|' S?
	    #                           Nmtoken)* S? ')'
	    #  [60] DefaultDecl ::=  '#REQUIRED' | '#IMPLIED' 
	    #                        | (('#FIXED' S)? AttValue)
	}
	#  [70] EntityDecl ::=  GEDecl | PEDecl
	elsif ($self->{COMPLETE_TAG} =~ m/\A \Q!ENTITY\E /gcxs) {
	    my $words = $self->findTagEndEatQuotes('', '', $delim);
	    shift @$words;
	    #  [71]     GEDecl ::=  '<!ENTITY' S Name S EntityDef S? '>'
	    #  [72]     PEDecl ::=  '<!ENTITY' S '%' S Name S PEDef S? '>'
	    my $peDecl = ($words->[0] eq '%');
	    shift (@$words) if ($peDecl);
	    #  [73]  EntityDef ::=  EntityValue | (ExternalID NDataDecl?)
	    #  [74]      PEDef ::=  EntityValue | ExternalID
	    my ($name, $next) = (shift @$words, shift @$words);
	    my ($def, $pubId, $sysId, $nDataDecl) = (undef, 0, 0, undef);
	    if ($next eq 'SYSTEM') {
		($sysId) = (shift @$words);
	    } elsif ($next eq 'PUBLIC') {
		$pubId = shift @$words;
		$sysId = shift @$words if ($words->[0] ne 'NDATA');
	    } else {
		$def = $next;
	    }
	    $nDataDecl = shift @$words if ($words->[0] eq 'NDATA');
	    $self->{DTD_DB}->addDecl(new W3C::XML::Entitydecl($name, $peDecl, $pubId, $sysId, $def, $nDataDecl)) if ($self->{DTD_DB});
	}
	#  [82] NotationDecl ::=  '<!NOTATION' S Name S (ExternalID |  PublicID) S? '>'
	elsif ($self->{COMPLETE_TAG} =~ m/\A \Q!NOTATION\E /gcxs) {
	    my $words = $self->findTagEndEatQuotes('', '', $delim);
	    shift @$words;
	    #  [73]  EntityDef ::=  EntityValue | (ExternalID NDataDecl?)
	    #  [74]      PEDef ::=  EntityValue | ExternalID
	    #  [83]     PublicID ::=  'PUBLIC' S PubidLiteral
	    my ($name, $contentspec) = (shift @$words, shift @$words);

	}
	elsif ($self->{COMPLETE_TAG} =~ m/\A \Q!--\E /gcxs) {
	    #  [15] Comment ::= '<!--' ((Char - '-') | ('-' (Char - '-')))* '-->'
	    $self->findTagEnd('--', '--');
	    $self->Comment;
	    $self->{COMMENT_COUNT}++;
	}
	elsif ($self->{COMPLETE_TAG} =~ m/\A \Q?\E /gcxs) {
	    #  [16] PI ::= '<?' PITarget (S (Char* - (Char* '?>' Char*)))? '?>'
	    my $words = $self->findTagEnd('?', '?');
	    my ($target, $data) = (shift @$words, shift @$words); # split('\s+', $self->{COMPLETE_TAG}, 2);
	    #  [17] PITarget ::= Name - (('X' | 'x') ('M' | 'm') ('L' | 'l'))
	    $self->structuredError($W3C::XML::XmlParser::XML_IN_PI) if ($target =~ m/xml/i);
	    $self->wrap('DOC_HANDLER', 'processingInstruction', $target, $data);
	    $self->{PI_COUNT}++;
	} else {
	    $self->structuredError($W3C::XML::XmlParser::INVALID_MARKUP, $self->{COMPLETE_TAG});
	}
    }
}

$W3C::XML::XmlParser::AMBIGUOUS_CONTENT	= [[47],	1, 'ambiguous content'];

sub elementdecl1 {
    my ($self, $name, $input) = @_;
    my ($pcdata);

    # [		repeats[0] is the option list
    # ]		repeats[1] is repeat option (undef|+|?|*)
    
    #   [		list of optional routes
    #     [		list of ordered elements
    #       []	inner repeats
    #     ]
    #   ]
    my ($OPTION, $REPEAT) = (0, 1);
    my $curOrdered = [];
    my $curOptions = [$curOrdered];
    my $curRepeats = [$curOptions];
    my @repeatStack; # = ($curRepeats);
    my $base;

    my %stateMachine = {};
    my $nextState = 0;
    my $curState = $nextState++;
    my @groupStack = ([[], $curState, $nextState]);
    my (%useState, %copyState);

    while (pos $input < length $input) {
	# make an array of options, each an array of ordered elems
	my $start = pos $input;
	if ($input =~ m/\G \s* \( /gcxi) {
	    push (@repeatStack, $curRepeats);
	    my $lastOrdered = $curOrdered;
	    $curOrdered = [];
	    $curOptions = [$curOrdered];
	    $curRepeats = [$curOptions];
	    push (@$lastOrdered, $curRepeats);
	    $base = $curRepeats if (!defined $base);
	}
	if ($input =~ m/\G \s* ([\#\w\.\_\-]+) \s* (\?|\*|\+)? /gcxi) {
	    $pcdata = 1 if ($1 eq '#PCDATA');
	    push (@$curOrdered, [$1, $2 ? $2 : '.']);
	}
	# slurp ',' or '|' sepparator
	if ($input =~ m/\G \s* (\,|\|) /gcxi && $1 eq '|') {
	    # , assign next state
	    # | ignore (just put next entry in same state)
	    # '|' is not sticky - a,b|c,d assumed to mean (a,b)|(c,d)
	    $curOrdered = [];
	    push (@$curOptions, $curOrdered);
	}
	if ($input =~ m/\G \s* \) \s* (\?|\*|\+)? /gcxi) {
	    # ? copy next state entries to first element (nested) of this state
	    # * set next state entry to this state and retarget current 
	    #   object (or group) entries to this state
	    # + copy this state entries to next state

	    # ) close group and set as curent object (for + and * modifiers)
	    $curRepeats->[$REPEAT] = $1 ? $1 : '.';
	    $curRepeats = pop (@repeatStack);
	    $curOptions = $curRepeats->[$OPTION];
	    $curOrdered = $curOptions->[-1];
	}
	my $end = pos $input;
	# print '<-',substr ($input, $start, $end),"\n->",showRepeat W3C::XML::elementdecl($base, 0, 1, 1),"\n\n";
	die "stuck!" if ($end - $start == 0);
    }
    # print ":$name:", new W3C::XML::elementdecl($name, 0, 0, $pcdata, $base)->showRepeat($base, 0, 0),"\n\n";
    $self->{DTD_DB}->addDecl(new W3C::XML::elementdecl($name, 0, 0, $pcdata, $base)) if ($self->{DTD_DB}); # $curRepeats));
}

$W3C::XML::XmlParser::MALFORMED_CDATA	= [[-1],	2, 'malformed CDATA'];
$W3C::XML::XmlParser::NESTED_CDATA	= [[-1],	2, 'nested CDATA'];

sub CDSect {
    my ($self) = @_;
    if ($self->{COMPLETE_TAG} =~ m/^\!\[CDATA\[(.*)\]\]$/s) {
	my $body = $1;
	$self->structuredError($W3C::XML::XmlParser::NESTED_CDATA) if ($body =~ m/<\!\[CDATA\[/);
	$self->Char($body);
    } else {
	$self->structuredError($W3C::XML::XmlParser::MALFORMED_CDATA);
    }
}

$W3C::XML::XmlParser::UNESCAPED_COMMENT	= [[-1],	2, 'unescaped comment marker in comment'];

sub Comment {
    my ($self) = @_;
    #  [27] Misc ::= Comment | PI |  S
    # or
    #  [43] content ::= (element | CharData | Reference | CDSect | PI | Comment)*
    $self->{COMPLETE_TAG} =~ m/\!\-\-(.*)\-\-/m;
    my $body = $1;
    #  [15] Comment ::= '<!--' ((Char - '-') | ('-' (Char - '-')))* '-->'
    $self->structuredError($W3C::XML::XmlParser::UNESCAPED_COMMENT, $body) if ($body =~ m/\-\-/);
}

$W3C::XML::XmlParser::EMPTY_TAG_NAME	= [[-1],	2, 'empty tag name'];
$W3C::XML::XmlParser::EMPTY_ROOT_ELEMENT	= [[-1],	2, 'empty element at root'];
$W3C::XML::XmlParser::END_TAG_ATTRIBUTE	= [[-1],	2, 'attribute on end tag'];
$W3C::XML::XmlParser::GARBAGE_AFTER_ATTRS	= [[-1],	2, 'garbage after attributes'];
$W3C::XML::XmlParser::MISMATCHED_END_TAG	= [[-1],	2, 'mismatched end tag'];

sub element {
    my ($self, $words) = @_;
    my $xmlEmpty;
    my $isEndTag = 0;
    my $tagName = shift @$words || $self->structuredError($W3C::XML::XmlParser::INVALID_TAG_NAME);
    # $self->structuredError($W3C::XML::XmlParser::INVALID_TAG_NAME, $self->{COMPLETE_TAG});

    if ($tagName =~ s/\A\///) {
	$isEndTag = 1;
    }
    if ($tagName =~ s/\/$//) {
	$xmlEmpty = 1;
	$self->structuredError($W3C::XML::XmlParser::EMPTY_ROOT_ELEMENT) if (!$self->{ELEMENT_COUNT}>0); # @@@ check
    } else {
	$xmlEmpty = 0;
    }
    $self->checkName($tagName);

    # look for attribute=value pairs
    my $attributeList = new W3C::XML::AttributeListImpl($tagName =~ m/\G ^([^:]+): /gcxs);

    while (my $attrname = shift @$words) {
	if ($attrname eq '/') {
	    $xmlEmpty = 1;
	    last;
	}
	my $attrvalue = shift @$words;
	$attrname =~ s/\=$//;
	$attrvalue = shift @$words if ($attrvalue eq '=');
	$self->structuredError($W3C::XML::XmlParser::END_TAG_ATTRIBUTE, $1.'='.$2) if ($isEndTag);
	$self->checkName($attrname);
	$attributeList->addAttribute($attrname, "CDATA", $attrvalue);
    }
    # $self->structuredError($W3C::XML::XmlParser::GARBAGE_AFTER_ATTRS, $1) if ($self->{COMPLETE_TAG} =~ m/\G \s* ([^\s]+) /gcxs);

    if ($isEndTag) {
	# make sure </a> closes a <a>
	# print 'pop '.@{$self->{TAG_STACK}}[-1]."\n";
	if ($tagName eq $self->{TAG_STACK}->[-1]) {
	    $self->wrap('DOC_HANDLER', 'endElement', $tagName);
	    pop (@{$self->{TAG_STACK}});
	} else {
	    $self->structuredError($W3C::XML::XmlParser::MISMATCHED_END_TAG, '/'.$tagName, '/'.$self->{TAG_STACK}->[-1]);
	}
    }
    else {
	push (@{$self->{TAG_STACK}}, $tagName);
	# print 'push '.@{$self->{TAG_STACK}}[-1]."\n";
#	$self->{DOC_HANDLER}->startElement($tagName, $attributeList);
	$self->wrap('DOC_HANDLER', 'startElement', $tagName, $attributeList);
	if ($xmlEmpty) {
	    $self->wrap('DOC_HANDLER', 'endElement', $tagName);
	    # print 'pop '.@{$self->{TAG_STACK}}[-1]."\n";
	    pop (@{$self->{TAG_STACK}});
	}
    }
    $self->{ELEMENT_COUNT}++;
}

$W3C::XML::XmlParser::INVALID_NAME	= [[5],	2, 'invalid name'];

#####
# checkName for [17] PITarget, [28] doctypedecl, [40] STag, [41] Attribute, 
#		[42] ETag, [44] EmptyElemTag, [45] elementdecl, [48] cp,
#		[51] Mixed, [52] AttlistDecl, [53] AttDef, [58] NotationType, 
#		[68] EntityRef, [69] PEReference, [71] GEDecl, [72] PEDecl, 
#		[76] NDataDecl, [82] NotationDecl
# 
#  [4] NameChar ::= Letter | Digit | '.' | '-' | '_' | ':' | CombiningChar | Extender
#  [5]     Name ::= (Letter | '_' | ':') (NameChar)*

sub checkName {
    my ($self, $name, $context) = @_;
    if ($name !~ m/\A[a-zA-Z_:][a-zA-Z0-9\.\-_:]*\Z/) {
	$self->structuredError($W3C::XML::XmlParser::INVALID_NAME, $name);
#	$self->structuredError([@$context, @{$$W3C::XML::XmlParser::INVALID_NAME[0]}], 
#		     $W3C::XML::XmlParser::INVALID_NAME[1], 
#		     $W3C::XML::XmlParser::INVALID_NAME[2], $name); # @@@ check
    }
}

sub structuredError {
    my ($self, $errorCode, $found, $expected) = @_;
    my $context = $errorCode->[0];
    my $fatality = $errorCode->[1];
    my $message = $errorCode->[2];
    $message .= ': found \''.$found.'\'' if (defined $found);
    $message .= ': expected \''.$expected.'\'' if (defined $expected);
    # print $message, "\n";
    if ($fatality == 0) {
	$self->{ERROR_HANDLER}->warning(new W3C::XML::SAXParseException(-errorMessage => $message, -locator => $self));
    } elsif ($fatality == 1) {
	$self->{ERROR_COUNT}++;
	$self->{ERROR_HANDLER}->error(new W3C::XML::SAXParseException(-errorMessage => $message, -locator => $self));
    } elsif ($fatality == 2) {
	$self->{ERROR_COUNT}++;
	$self->{ERROR_HANDLER}->fatalError(new W3C::XML::SAXParseException(-errorMessage => $message, -locator => $self));
    }
}

sub show {
    my ($self, $prefix) = @_;
    my $ret;
    $ret .= $self->SUPER::show($prefix);
    $ret .= $prefix.'ELEMENT_COUNT: '.$self->{ELEMENT_COUNT}."\n";
    $ret .= $prefix.'ERROR_COUNT: '.$self->{ERROR_COUNT}."\n";
    $ret .= $prefix.'ERRSTR: '.$self->{ERRSTR}."\n";
    $ret .= $prefix.'ENTITYSTACK: '.join(' | ', @{$self->{ENTITYSTACK}})."\n";
    $ret .= $prefix.'ENCODING: '.$self->{ENCODING}."\n";
    $ret .= $prefix.'LINENUMBER:'.$self->{LINENUMBER}.' : COLUMNNUMBER:'.$self->{COLUMNNUMBER}."\n";
    return $ret;
}

package W3C::XML::ExpatXmlParser;
@W3C::XML::ExpatXmlParser::ISA = ("W3C::XML::XmlParser");

my %Selves;

#####
# new - prepare a W3C::Rdf::RdfParser with a new connection

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@_);
    bless ($self, $class);
    require XML::Parser::Expat;
    $self->{EXPAT_PARSER} = new XML::Parser::Expat; #(('Pkg', 'W3C::XML::ExpatXmlParser'), ());
    $Selves{$self->{EXPAT_PARSER}} = $self;
#    my %handlers = ('Proc'->\&Proc, 'Start'->\&Start, 'Char'->\&Char, 'End'->\&End);
    my %handlers;
    $handlers{'Proc'} = \&Proc;
    $handlers{'Start'} = \&Start;
    $handlers{'Char'} = \&Char;
    $handlers{'End'} = \&End;
    $self->{EXPAT_PARSER}->setHandlers(%handlers);

    $Selves{$self->{EXPAT_PARSER}} = $self;
    return $self;
}

sub getColumnNumber {
    my ($self) = @_;
    return $self->{EXPAT_PARSER}->current_column;
}

sub getLineNumber {
    my ($self) = @_;
    return $self->{EXPAT_PARSER}->current_line;
}

sub getByteNumber {
    my ($self) = @_;
    return $self->{EXPAT_PARSER}->current_byte;
}

sub getContextString {
    my ($self) = @_;
    my $contextString = $self->{EXPAT_PARSER}->position_in_context;
    chomp $contextString;
    return (undef, undef, $contextString, undef, undef, undef, $self->getLineNumber, $self->getLineNumber);
}

sub parseDocument {
    my ($self) = @_;
    $self->wrap('DOC_HANDLER', 'setDocumentLocator', $self);
    $self->wrap('DOC_HANDLER', 'startDocument');    
#    my $result = $self->{EXPAT_PARSER}->parse($self->{BASEREADER});
    my $result = $self->wrap('EXPAT_PARSER', 'parse', $self->{BASEREADER});
    $self->wrap('DOC_HANDLER', 'endDocument');    
    return;
}

#####
# XML::Parser::Expat callbacks

sub Start {
    my ($expat, $type, %args) = @_;
    my $self = $Selves{$expat};
    my $attributeList = new W3C::XML::AttributeListImpl($type =~ m/\G ^([^:]+): /gcxs);

    foreach my $key (keys %args) {
	my $attrname = $key;
	my $attrvalue = $args{$key};
	$attributeList->addAttribute($attrname, "CDATA", $attrvalue);
	# move to W3C::XML::OldNamespaceHandler
	# $self->wrap('DOC_HANDLER', 'addNamespace', $2, $attrvalue) if ($attrname =~ m/^xmlns(:(\w+))?$/);
    }

    return $self->wrap('DOC_HANDLER', 'startElement', $type, $attributeList);    
}

sub End {
    my ($expat, $type) = @_;
    my $self = $Selves{$expat};
    return $self->wrap('DOC_HANDLER', 'endElement', $type);    
}

sub Char {
    my ($expat, $text) = @_;
    my $self = $Selves{$expat};
#    $self->{DOC_HANDLER}->characters($text, 0, length($text));
    return $self->wrap('DOC_HANDLER', 'characters', $text, 0, length($text));
}

sub Proc {
    my ($expat, $target, $text) = @_;
    my $self = $Selves{$expat};
    warn "W3C::XML::ExpatXmlParser::Proc($target, $text)";
}

sub show {
    my ($self, $prefix) = @_;
    my $ret;
    $ret .= $self->SUPER::show($prefix);
    $ret .= $prefix.'EXPAT_PARSER: '.$self->{EXPAT_PARSER}."\n";
    return $ret;
}

package W3C::XML::XmlParser; # so make doesn't complain about the package

1;

__END__

=head1 NAME

W3C::XML::XmlParser - collection of XML parser options

=head1 SYNOPSIS

  use W3C::XML::XmlParser;
  use W3C::XML::VerboseXmlHandler;
  use W3C::XML::InputSource;
  my $xmlParser = new W3C::XML::PerlXmlParser;
  my $handler = new W3C::XML::VerboseXmlHandler;

  # set the W3C::XML::HandlerList be the document handler and the error handler
  $xmlParser->setDocumentHandler($handler);
  $xmlParser->setErrorHandler($handler);

  # assign a URI to the XML in InputSorce and parse it
  my $inputSource = new W3C::XML::FileInputSource($source);
  eval {$xmlParser->parse($inputSource);};

=head1 DESCRIPTION

When this was written, the SAX interface is still under flux. It needs to be
updated to reflect the actual SAX2 interface.

There are two XML parser options, the PerlXmlParser and the ExpatXmlParser.

I benchmarked the perl parser against expat - expat with the Subs style is 6
times faster and uses two thirds as much memory as W3C::XML::XmlParser with an empty 
W3C::XML::HandlerList as a document handler and error handler. If you are crunching much
data, it's probably worth installing XML::Parser. I continue to use this
parser because it's handy for small XML and doesn't require a new module.

#####
W3C::XML::XmlParser - This module provides the meet of W3C's Perl SAX parser and should
I expect, containt the bulk of the bugs. If the parser fails to parse good
XML, or fails to flag bad XML, or provides an improper error message, look
here first.

The top of this module contains access functions for the SAX objects like
systemId, handlers, encoding, etc.

The bottom of this module contains the XML parser. Look here for bugs. The top
level of the parser is the parseDocument function. It breaks up the document
looking for tags and determining their types. The various handlers for the tag
types pull the remainder of the tag from the input stream BASEREADER.

The tag-type handlers may flag errors with a call to the error function. It
takes a reference to an array stating the point of the lexical error in the
XML EBNF, the severity of the error, and the error string. For example:
$W3C::XML::XmlParser::LATER_XML_VERSION	=[[1,22,23], 0, 'later XML version, winging it']
indicates a warning (severity 0) occured when parsing this part of the EBNF:
[1] document ::= prolog element Misc*
[22]  prolog ::= XMLDecl? Misc* (doctypedecl Misc*)?
[23] XMLDecl ::= '<?xml' VersionInfo EncodingDecl? SDDecl? S? '?>'

Status: I have concentrated to setting up a well structured parser rather than
catching all the parsing pitfalls. Error reporting has suffered in that the
COLUMNNUMBER is set before the error is parsed therfor, the error is before
the text point indicated by the W3C::XML::XmlParser's Locator capacity.

Many of the error messages are not complete. An error location of [-1]
inidcates that I have not taken the time to place the actual error location.

While this parser is bitchy and verbose, it is not, strictly speaking, a 
validating processor. It does not read DTD's and ensure that the XML complies
with them.

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

=head1 AUTHOR

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

=head1 SEE ALSO

perl(1).

=cut

