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

use strict;
require Exporter;
require AutoLoader;

$W3C::LOTP::Core::REVISION = '$Id: Core.pm,v 1.4 2004/03/29 06:45:49 eric Exp $ ';

package W3C::LOTP::AuthRequiredException;
@W3C::LOTP::AuthRequiredException::ISA = qw(W3C::Util::Exception);

sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    $self->missingParm('-realm') if (!$self->{-realm});
    $self->{-error} = $! if (!$self->{-error});
    $self->fillInStackTrace;
    return $self;
}
sub getSpecificMessage {return 'Auth required for realm '.$_[0]->getRealm;}
sub getRealm {return $_[0]->{-realm}}

package W3C::LOTP::NoSuchLibraryException;
@W3C::LOTP::NoSuchLibraryException::ISA = qw(W3C::Util::NoSuchFileException);
sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    $self->missingParm('-INC') if (!$self->{-INC});
    $self->fillInStackTrace;
    return $self;
}
sub getSpecificMessage {return 'No library "'.$_[0]->{-file}.'" in "'.join (' ', @{$_[0]->{-INC}}).'"';}
sub getInc {return $_[0]->{-INC};}

package W3C::LOTP::Core;
use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK);
@ISA = qw(W3C::XML::StackDocumentHandler Exporter AutoLoader);

use W3C::XML::XmlParser;
use W3C::XML::ErrorHandlerImpl;
use W3C::XML::HandlerBase;
use W3C::Util::Exception;
@EXPORT = qw();
@EXPORT_OK = qw();
$VERSION = 0.01;
$DSLI = 'adpO';

#####
# Externally available constants
*W3C::LOTP::Core::LOTPNamespace = \ 'http://www.w3.org/namespaces/Protocols/LOTP/v1/';

sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    bless ($self, $class);
    $self->{PARMS} = [0, 1]; # tell the stack layer we're using SAX2
    $self->{STATE_MACHINE} = 
    {START => [{'Envelope' => 'ENVELOPE', 'Body' => 'BODY'}], 
     ENVELOPE => [{'h1' => 'H1', 'h2' => 'H2'}]};
    $self->{STATE} = 'START';
    return $self;
}

sub registerNamespaceHandler {
    my ($self, $namespace, $handler) = @_;
    $self->{NAMESPACE_HANDLERS}{$namespace} = $handler;
}

sub handle {
    my ($self, $path, $xml) = @_;
    $self->loadExtension($path);
    return $self->parse($xml);
}

sub loadExtension {
    my ($self, $path) = @_;
#    $path =~ s/^\///;
    $path =~ s/\//::/g;
    my $moduleName = 'W3C::LOTP::Lib'.$path;
    my $module;
    my $useCmd = "use $moduleName; \$module = new $moduleName(-core => \$self);";
    eval $useCmd;
    if ($@) {
	if ($@) {if (my $ex = &catch('W3C::Util::Exception')) {
	    &throw($ex);
	} elsif ($@ =~ m/^Can\'t locate W3C\/LOTP\/Lib\/([^ ]+) in \@INC \(\@INC contains: ([^\)]+)\)/) {
	    &throw(new W3C::LOTP::NoSuchLibraryException(-file => $1, -INC => [split (/ /, $2)]));
	} else {
	    my $perlError = $@;
	    chomp $perlError;
	    &throw(new W3C::Util::PerlException(-error => $perlError));
	}
    }}
}

sub parse {
    my ($self, $xml) = @_;
    if ($self->{ARGS}{-parser} eq 'expat') {
	require XML::Parser;
	$self->{XML_PARSER} = new W3C::XML::ExpatXmlParser;
    } else {
	$self->{XML_PARSER} = new W3C::XML::PerlXmlParser;
    }
    my $errorHandler = new W3C::XML::ErrorHandlerImpl(-documentLocator => $self->{XML_PARSER});

    # it's easiest to stick all your document handlers in a W3C::XML::HandlerList
    my $handlerList = new W3C::XML::HandlerList({-documentHandlers => [$self], 
						 -errorHandlers => [$errorHandler]});

    # use a W3C::XML::OldNamespaceHandler stream to map from prefix:tag - pass to LOTPParser
    # so it translate back for pretty-printing
    $self->{NAMESPACE_HANDLER} = new W3C::XML::OldNamespaceHandler({-documentHandler => $handlerList, 
								 -errorHandler => $handlerList, 
								 -passUnknownNamespaces => 1, 
								 -useSAX2 => 1});
    $self->setNamespaceHandler($self->{NAMESPACE_HANDLER});

    # and have the W3C::XML::HandlerList be the document handler and the error handler
    $self->{XML_PARSER}->setDocumentHandler($self->{NAMESPACE_HANDLER});
    $self->{XML_PARSER}->setErrorHandler($handlerList);

    # assign a URI to the XML in InputSource and parse it
    my $inputSource = new W3C::XML::InputSource(\ $xml);
    $self->{XML_PARSER}->parse($inputSource);
}

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

sub getResults {
    my ($self) = @_;
    return "$self->getResults";
}

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

sub endDocument {
    my ($self) = @_;
    $self->SUPER::endDocument();
}

sub startElement {
    my ($self, $ns, $name, $raw, $attributeList) = @_;
    $self->SUPER::startElement($ns, $name, $raw, $attributeList);
    my $state = $self->{STATE_MACHINE}{$self->{STATE}};
    if ($ns eq $W3C::LOTP::Core::LOTPNamespace) {
	print "LOTP tag: $ns - $name\n";
    } elsif (my $handler = $self->{NAMESPACE_HANDLERS}{$ns}) {
	$handler->handleNamespace($ns, $name, $raw, $attributeList);
    } else {
	&throw(new W3C::Util::ProgramFlowException);
    }
    for (my $i = 0; $i < $attributeList->getLength; $i++) {
	my ($attributeName, $attributeValue) = ($attributeList->getName($i), $attributeList->getValue($i));
	my ($attributeNameNs, $attributeValueNs) = ($attributeList->getNameNs($i), $attributeList->getValueNs($i));
	if ($attributeNameNs eq $W3C::LOTP::Core::LOTPNamespace) {
	    print "LOTP attribute: $attributeNameNs - $attributeName\n";
	}
	if ($attributeValueNs eq $W3C::LOTP::Core::LOTPNamespace) {
	    print "LOTP attribute: $attributeValueNs - $attributeValue\n";
	}
    }
}

sub endElement {
    my ($self, $ns, $name, $raw) = @_;
    $self->SUPER::endElement($ns, $name, $raw);
}

sub characters {
    my ($self, $ch, $start, $length) = @_;
    $self->SUPER::characters($ch, $start, $length);
}

sub ignorableWhitespace {
    my ($self, $ch, $start, $length) = @_;
    $self->SUPER::ignorableWhitespace($ch, $start, $length);
}

1;

__END__

=head1 NAME

W3C::LOTP::Core - Common LOTP Object Storage

=head1 SYNOPSIS

    use W3C::LOTP::Core;
    package testLOTPInterface;
    @testLOTPInterface::ISA = qw(W3C::Rdf::RdfApp);

    my $tester = new testLOTPInterface;
    $tester->execute(\@ARGV);

    sub render {
	my ($self) = @_;
	$query = "(ask '((http://www.w3.org/schema/certHTMLv1/access ?x \"acc1\") 
(?y ?x \"http://user1\"))
:collect ?x)" if (!$query);
	my ($nodes2, $messages) = $self->{RDF_DB}->algae($query, $self->{LOTP_PARSER}->{REVISION});
    }

=head1 DESCRIPTION

Common LOTP Object Storage.

This module is part of the W3C::LOTP CPAN module suite.

=head1 ARGUMENTS

=item B<@<file>> - read arguments from <file>

=item B<...>

=item B<>

=item B<>

=item B<>

=head1 AUTHOR

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

=head1 SEE ALSO

W3C::LOTP::CGI(3) perl(1).

=cut
