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

use strict;
require Exporter;
require AutoLoader;

$W3C::XML::VerboseXmlHandler::REVISION = '$Id: VerboseXmlHandler.pm,v 1.13 2004/03/29 06:45:50 eric Exp $ ';

package W3C::XML::VerboseXmlHandler;
use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK);
@ISA = qw(Exporter AutoLoader);
@EXPORT = qw();
@EXPORT_OK = qw();
$VERSION = 0.91;
$DSLI = 'adpO';

#####
# per-class data

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

#####
# per-object data
# DEBUG		- per-object control of debugging info

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

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

#####
# entityResolver routines

sub resolveEntity {
    my $self = shift;
    my $publicId = shift;
    my $systemId = shift;
    print "resolveEntity($publicId, $systemId)\n";
    return undef;
}

#####
# DTDHandler routines

sub notationDecl {
    my $self = shift;
    my $name = shift;
    my $publicId = shift;
    my $systemId = shift;
    print "notationDecl($name, $publicId, $systemId)\n";
}

sub unparsedEntityDecl {
    my $self = shift;
    my $name = shift;
    my $publicId = shift;
    my $systemId = shift;
    my $notationName = shift;
    print "unparsedEntityDecl($name, $publicId, $systemId, $notationName)\n";
}

#####
# documentHandler routines

sub setDocumentLocator {
    my $self = shift;
    $self->{LOCATOR} = shift;
    print "setDocumentLocater($self->{LOCATOR})\n";
}

sub startDocument {
    my $self = shift;
    print "startDocument()\n";
}

sub endDocument {
    my $self = shift;
    print "endDocument()\n";
}

sub startElement {
    my $self = shift;
    my $name = shift;
    my $attributeList = shift;
    print "startElement($name";
    for (my $i = 0; $i <= $attributeList->getLength(); $i++) {
	print ", ", $attributeList->getName($i), " ", $attributeList->getType($i), " ", $attributeList->getValue($i);
    }
    print ")\n";
}

sub endElement {
    my $self = shift;
    my $name = shift;
    print "endElement($name)\n";
}

sub characters {
    my $self = shift;
    my $ch = shift;
    my $start = shift;
    my $length = shift;
    print "characters(\"",substr($ch, $start, $start+$length),"\")\n"
}

sub ignorableWhitespace {
    my $self = shift;
    my $ch = shift;
    my $start = shift;
    my $length = shift;
    print "ignorableWhitespace(\"",substr($ch, $start, $start+$length),"\")\n"
}

sub processingInstruction {
    my $self = shift;
    my $target = shift;
    my $data = shift;
    print "processingInstruction($target, $data)\n";
}

#####
# ErrorHandler routines

sub warn {
    my $self = shift;
    my $exception = shift;
    print "warning(",$exception->getMessage()," ("
	,$exception->getSystemId, ":", $exception->getLineNumber(),
	",", $exception->getColumnNumber(), ")\n";
}

sub error {
    my $self = shift;
    my $exception = shift;
    print "error(",$exception->getMessage()," ("
	,$exception->getSystemId, ":", $exception->getLineNumber(),
	",", $exception->getColumnNumber(), ")\n";
}

sub fatalError {
    my $self = shift;
    my $exception = shift;
    print "fatalError(",$exception->getMessage()," ("
	,$exception->getSystemId, ":", $exception->getLineNumber(),
	",", $exception->getColumnNumber(), ")\n";
}

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

sub debug {
    my $self = shift;
    warn "usage: thing->debug(level)"    unless @_ == 1;
    my $level = shift;
    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::VerboseXmlHandler destroying $self " . $self->name;
    }
    -- ${ $self->{"_OUTSTANDING"} };
}

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

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

1;
__END__

=head1 NAME

W3C::XML::VerboseXmlHandler - display handler calls for diagnostics

=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;

  my $handlerList = new W3C::XML::HandlerList([$handler], [$handler]);

  # use a W3C::XML::OldNamespaceHandler stream to map from prefix:tag
  my $namespaceHandler = new W3C::XML::OldNamespaceHandler($handlerList);

  # set 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);};

=head1 DESCRIPTION

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

=head1 AUTHOR

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

=head1 SEE ALSO

perl(1).

=cut
