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

# $Id: RdfApp.pm,v 1.129 2007-10-09 03:48:25 eric Exp $

use strict;
require Exporter;

$W3C::Rdf::RdfApp::REVISION = '$Id: RdfApp.pm,v 1.129 2007-10-09 03:48:25 eric Exp $ ';


package W3C::Rdf::RdfApp;
use W3C::Util::Exception;
use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK);
@ISA = qw(W3C::Util::NamedParmObject Exporter);

use W3C::Util::Exception;
use W3C::XML::XmlParser;
use W3C::XML::InputSource;
use W3C::XML::HandlerBase;
use W3C::XML::ErrorHandlerImpl;
use W3C::Rdf::Atoms qw($RDF_SCHEMA_URI $ATTRIB_GroundFact);
use W3C::Rdf::RdfDB;
use W3C::Rdf::Algae2;
use W3C::Rdf::XmlParser;
use W3C::Rdf::N3Parser;
use W3C::Rdf::TurtleSParser;

# Re-export query language names from W3C::Rdf::Algae2
use vars qw($QL_ALGAE $QL_N3 $QL_RDQL $QL_SPARQL $QL_SeRQL $QL_RXQuery $CurrentContext);

#####
# Externally available constants
@EXPORT = qw($QL_ALGAE $QL_N3 $QL_RDQL $QL_SPARQL $QL_SeRQL $QL_RXQuery $CurrentContext);
@EXPORT_OK = qw();
$VERSION = 0.94;
$DSLI = 'adpO';

use vars qw($FLAG $LOOK_FOR $STORE_IN $DESCRIPTION $DEFAULT $OPTIONS $TYPE_SPECIFIC);
($FLAG, $LOOK_FOR, $STORE_IN, $DESCRIPTION, $DEFAULT, $OPTIONS, $TYPE_SPECIFIC) = (0..6);


sub getInputSource { # static
    my ($source, $parms) = @_;
    $parms ||= {};
    my $ret = undef;
    my $url = new URI($source);
    if ($url->scheme) {
	eval {
	    if ($url->scheme() eq 'file') {
		$ret = new W3C::XML::FileInputSource($url->path(), {'host' => $url->host, %$parms});
	    } else {
		$ret = new W3C::XML::URIInputSource($url->canonical, $parms);
	    }
	}; if ($@) {if (my $ex = &catch('W3C::Util::LibraryNotFoundException')) {
	    if ($source =~ m/^file\:(.+)/) {
		$ret = new W3C::XML::FileInputSource($1);
	    } else {
		&throw($ex);
	    }
	} else {&throw()}}
    } else {
	$ret = new W3C::XML::FileInputSource($source, $parms);
    }
    return $ret;
}

sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    bless ($self, $class);
    $self->{NAMESPACE_HANDLER} ||= new W3C::Util::NamespaceHandler(-passUnknownNamespaces => 1, -useSAX2 => 1);
    $self->{-atomDictionary} ||= new W3C::Rdf::Atoms();
    $self->{-rdfDB} ||= new W3C::Rdf::RdfDB(-atomDictionary => $self->{-atomDictionary}, -lazyReification => 1);
    $self->{-urlMediaType} ||= {};
    $self->makeInputAttribution($0);
    $CurrentContext = $self;
    return $self;
}

sub makeInputAttribution {
    my ($self, $urlStr) = @_;
    my ($hostname, $cwd) = ('localhost', '.');
    if (defined $self->{-forceHost}) {
	$hostname = $self->{-forceHost};
    } else {
	eval {
	    require Sys::Hostname;
	    $hostname = &Sys::Hostname::hostname;
	};
    }
    if (defined $self->{-forcePath}) {
	$cwd = $self->{-forcePath};
    } else {
	eval {
	    use Cwd;
	    $cwd = &getcwd;
	    chomp $cwd;
	    if ($^O eq 'MSWin32' && $cwd =~ m/^([A-Z])\:(.*)$/) {
		$cwd = '/'.$1.'%3A'.$2;
	    }
	};
    }
    my $base = new URI("file://$hostname$cwd/");
    my $url = $self->{-atomDictionary}->getUri(new_abs URI($urlStr, $base));
    return $self->{INPUT_ATTRIBUTION} = $self->{-atomDictionary}->
	getGroundFactAttribution($url, undef, undef, undef);
}

sub getInputAttribution {
    my ($self) = @_;
    return $self->{INPUT_ATTRIBUTION};
}


use vars qw($srx $xsd $rdf $rs $xml $CM);
$srx = 'http://www.w3.org/2005/sparql-results#';
$xsd = 'http://www.w3.org/2001/XMLSchema#';
$rdf = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#';
$rs  = 'http://www.w3.org/2001/sw/DataAccess/tests/result-set#';
$xml = 'http://www.w3.org/XML/1998/namespace';

use vars qw($T_N3 $T_TextN3 $T_TURTLE $T_SRX $T_JASON $T_RDFXML @TYPES);
$T_N3 = 'application/n3';
$T_TextN3 = 'text/rdf+n3';
$T_TURTLE = 'application/turtle';
$T_SRX = 'application/sparql-results+xml';
$T_JASON = 'application/sparql-results+json';
$T_RDFXML = 'application/rdf+xml';
@TYPES = ($T_N3, $T_TextN3, $T_TURTLE, $T_SRX, $T_JASON, $T_RDFXML);

sub parse {
    my ($self, $bytes, $location, $type, $algae2) = @_;
    my $p;
    if (my $t = $self->{-uriMediaTypes}{$location}) {
	$type = $t;
    }
    my $defaultMediaType = $self->{-defaultMediaType} ? ${$self->{-defaultMediaType}} : undef;
  tryAgainDumbAss:
    if ($type eq $T_N3 || $type eq 'n3') {
	$p = new W3C::Rdf::N3Parser($bytes, $algae2, $location);
	$p->YYData->{-namespaceHandler} = new W3C::Util::NamespaceHandler(-relay => $self->{-namespaceHandler});
    } elsif ($type eq $T_TURTLE || $type eq 'turtle' || $type eq $T_TextN3) {
	$p = new W3C::Rdf::TurtleSParser($bytes, $algae2, $location);
	$p->YYData->{-namespaceHandler} = new W3C::Util::NamespaceHandler(-relay => $self->{-namespaceHandler});
    } elsif ($type eq $T_SRX || $type eq 'srx') {
	require W3C::Rdf::SRXParser;
	require W3C::XML::HandlerStack;
	require XML::SAX::ParserFactory;
	my $handlerStack = new W3C::XML::HandlerStack();
	my $attrib = $self->{-atomDictionary}->getGroundFactAttribution(
	    $self->{-atomDictionary}->getAbsoluteUri($location));

	my $root = $self->{-atomDictionary}->createBNode($attrib);
	my $typeRS = $self->{-atomDictionary}->getAbsoluteUri("${rs}ResultSet");
	$self->_addTriple($root, "${rdf}type", $typeRS, $attrib);
	my $xsd_int = $self->{-atomDictionary}->getAbsoluteUri("${xsd}integer");
	my $count = 0;

	my $first = 1;
	my ($result, $binding, $bnodeMap) = (undef, undef, {});
	my $srxHandler = new W3C::Rdf::SRXParser($attrib, $handlerStack, -location => $location, 
						 -boolean => sub {
						     my ($bool) = @_;
						     my $o = $self->{-atomDictionary}->getString($bool, 
							 $self->{-atomDictionary}->getAbsoluteUri("${xsd}boolean"), 
												 'PLAIN');
						     $self->_addTriple($root, "${rs}boolean", $o, $attrib);
						 }, 
						 -vars => sub {
						     my (@vars) = @_;
						     foreach my $var (@vars) {
							 my $name = $self->{-atomDictionary}->getString($var, undef, 'PLAIN');
							 $self->_addTriple($root, "${rs}resultVariable", $name, $attrib);
						     }
						 }, 
						 -bindings => sub {
						     my (%bindings) = @_;
						     $count++;
						     $result = $self->{-atomDictionary}->createBNode($attrib);
						     $self->_addTriple($root, "${rs}solution", $result, $attrib);
						     #if ($ordered) {
						     my $index = $self->{-atomDictionary}->getString($count, $xsd_int, 'PLAIN');
						     $self->_addTriple($result, "${rs}index", $index, $attrib);
						     #}
						     foreach my $varName (keys %bindings) {
							 $binding = $self->{-atomDictionary}->createBNode($attrib);
							 $self->_addTriple($result, "${rs}binding", $binding, $attrib);
							 my $name = $self->{-atomDictionary}->getString($varName, undef, 'PLAIN');
							 $self->_addTriple($binding, "${rs}variable", $name, $attrib);
							 $self->_addTriple($binding, "${rs}value", $bindings{$varName}, $attrib);
						     }
						 }, -atomDictionary => $self->{-atomDictionary});
	    $handlerStack->set_handler($srxHandler);
	    my $srxParser = XML::SAX::ParserFactory->parser(Handler => $handlerStack);

	    $srxParser->parse_string($bytes);
	    return $location;
    } elsif ($type eq $T_JASON || $type eq 'jason') {
	&throw(new W3C::Rdf::UnknownFormatException(-format => 'application/sparql-results+json'));
    } elsif ($type eq $T_RDFXML || !defined $type || $type eq 'rdf' || $type eq 'rdfxml') {
	$p = new W3C::Rdf::XmlParser($bytes, $algae2, $location, -relay => $self->{-namespaceHandler});
    } elsif ($type eq 'http://www.rfc-editor.org/rfc/rfc2606.txt') {
	$p = undef;
    } elsif ($defaultMediaType) {
	$type = $defaultMediaType;
	$defaultMediaType = undef;
	goto tryAgainDumbAss;
    } else {
	my $types = join(', ', @TYPES);
	&throw(new W3C::Util::Exception(-message => "unable to parse type \"$type\", associate \"$location\" with one of $types"));
    }
    my $attrib = $self->makeInputAttribution($location);
    if ($p) {
	my $actions = $p->parse(0x00);
	foreach my $action (@$actions) {
	    $action->delayedEvaluate(undef, {}, undef, $attrib);
	}
    }
    return $location;
}
sub _addTriple {
    my ($self, $s, $pStr, $o, $attrib) = @_;
    if ($self->{-rdfDB}->can('addTriple')) {
	my $p = $self->{-atomDictionary}->getAbsoluteUri($pStr);
	my $t = $self->{-atomDictionary}->getStatement($p, $s, $o, undef, $attrib);
	$self->{-rdfDB}->addTriple($t);
	return 1;
    } else {
	return 0;
    }
}


sub getQueryHandler {
    my ($self, $script, %flags) = @_;
    my $queryNamespaceHandler = $flags{-namespaceHandler} ? 
	$flags{-namespacesHandler} : 
	new W3C::Util::NamespaceHandler(
	-relay => $self->{NAMESPACE_HANDLER});
    my $ret = new W3C::Rdf::Algae2(-atomDictionary => $self->{-atomDictionary},
				-namespaceHandler => $queryNamespaceHandler, 
				-rdfApp => $self, 
				-sourceAttribution => $self->{INPUT_ATTRIBUTION}, 
				-uniqueResults => 1, 
				%flags);
    $ret->addSource('', $self->{-rdfDB});
    return $ret;
}

sub getNamespaceHandler {
    my ($self) = @_;
    return $self->{NAMESPACE_HANDLER};
}

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

1;

__END__

=head1 NAME

W3C::Rdf::RdfApp - Common handlers and CLI for RDF apps

=head1 SYNOPSIS

    use W3C::Rdf::RdfApp;
    package testRdfParser;
    @testRdfParser::ISA = qw(W3C::Rdf::RdfApp);

    my $tester = new testRdfParser;
    $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 $queryHandler = $self->{-rdfDB}->getAlgaeInterface;
	my ($nodes2, $messages) = $queryHandler->algae($query, $self->{RDF_PARSER}->{REVISION});
    }

=head1 DESCRIPTION

Common handlers and CLI for RDF apps.

This module is part of the W3C::RDF 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::Rdf::XmlParser(3) W3C::Rdf::RdfDB(3) W3C::XML::XmlParser(3) perl(1).

=cut
