#!/usr/bin/perl

$REVISION = '$Id: algae,v 1.69 2004/06/13 07:08:42 eric Exp $ ';

use strict;

#BEGIN {unshift@INC,('../../..');}
package testRdfParser;
use vars qw(@ISA %ParserClassAbbreviations %SerializerClassAbbreviations
	    $IFACE $IFACE_unknown $IFACE_Gnu $IFACE_Perl);
@ISA = qw(W3C::Rdf::RdfApp);

use W3C::Util::Exception qw(&throw &catch &DieHandler);
use W3C::Rdf::RdfApp;
use W3C::Rdf::Atoms qw($ATTRIB_GroundFact $Value_NULL);
use W3C::Rdf::Algae2;
%ParserClassAbbreviations = ('statements' => 'W3C::Rdf::StatementsParser', 
			     'RDFXML' => 'W3C::Rdf::XmlParser', 
			     'arrows' => 'W3C::Rdf::ArrowParser', 
			     'n3' => 'W3C::Rdf::N3Parser', 
			     'ntriples' => 'W3C::Rdf::NTriplesParser', 
			     'dot' => 'W3C::Rdf::DotParser'
			     );

%SerializerClassAbbreviations = ('statements' => 'W3C::Rdf::StatementsSerializer', 
				 'RDFXML' => 'W3C::Rdf::XmlSerializer', 
				 'arrows' => 'W3C::Rdf::ArrowSerializer', 
				 'n3' => 'W3C::Rdf::N3Serializer', 
				 'ntriples' => 'W3C::Rdf::NTriplesSerializer', 
				 'dot' => 'W3C::Rdf::DotSerializer'
				 );

($IFACE_unknown, $IFACE_Gnu, $IFACE_Perl) = (0..2);
$IFACE = $IFACE_unknown;

eval {
    local($SIG{"__DIE__"}) = \&DieHandler;
    my $tester = new testRdfParser;
    $tester->execute(\@ARGV);
}; if ($@) {if (my $ex = &catch('W3C::Util::Exception')) {
	die $ex->toString();
    } else {
	die $@;
    }
}

sub render {
    my ($self) = @_;

    if ($self->{ARGS}{-outputFile}) {
	open (STDOUT, ">$self->{ARGS}{-outputFile}") || 
	    &throw(new W3C::Util::FileOperationException(-filename => $self->{ARGS}{-outputFile}, -operation => 'write'));
    }
    eval {
	$self->_process();
    }; if ($@) {
	unlink $self->{ARGS}{-outputFile};
	if (my $ex = &catch('W3C::Util::Exception')) {
	    &throw($ex);
	} else {
	    &throw(new W3C::Util::PerlException());
	}
    }
}

sub _process {
    my ($self) = @_;
    if ($self->{ARGS}{-interactiveQueryBuilder}) {
	$self->interactiveQueryBuilder();
    }
    if (my $attrib = $self->{RDF_PARSER}->getRootAttribution && 0) {
	
	my $statements = [$self->{RDF_DB}->triplesMatching(undef, [[undef, undef, undef]], 
							   {-attributions => [$attrib], 
							    -sourceOnly => $self->{ARGS}{-sourceOnly}})];
	print $self->showQueryResults(undef, [$statements]);
    }
    my $queryNamespaceHandler = new W3C::Util::NamespaceHandler(-relay => $self->{NAMESPACE_HANDLER}->getAggregateNamespaceHandler());
    # my $queryHandler = $self->getAlgaeInterface($self, undef); # !!! $sysID);
    my $queryHandler = new W3C::Rdf::Algae2($self->{-atomDictionary},
					    $queryNamespaceHandler, 
					    {'' => $self}, $self, 
					    $self->{INPUT_ATTRIBUTION}, 
					    {-uniqueResults => 1}, 
					    -rdfDB => $self->{RDF_DB});
    $self->{-queryHandler} = $queryHandler;
    #$queryHandler->setParserEnv($self);

    # Read algae rules.
    foreach my $ruleFile (@{$self->{ARGS}{-rules}}) {
	local $/ = undef;
	my $fh;
	if ($ruleFile eq '-') {
	    $fh = \*STDIN;
	} else {
	    if (!open (RULE_FILE, $ruleFile)) {
		&throw(new W3C::Util::FileNotFoundException(-filename => $ruleFile));
	    }
	    $fh = \*RULE_FILE;
	}
	my $ruleData = <$fh>;
	close ($fh);
	$ruleData =~ s/^\#[^\n]*//;
	my ($nodes, $selects, $messages, $proofs) = $queryHandler->algae($ruleData, undef, {-uniqueResults => 1});
    }

    # Exectute algae requested queries.
    foreach my $query (@{$self->{ARGS}{-algae}}) {
	$query =~ s/^\#[^\n]*//;
	$self->_executeQuery($query, $queryHandler, 1, $QL_ALGAE); # @@@ STDOUT);
    }

    # Exectute RDQL queries.
    foreach my $query (@{$self->{ARGS}{-rdql}}) {
	$query =~ s/^\#[^\n]*//;
	$self->_executeQuery($query, $queryHandler, 1, $QL_RDQL); # @@@ STDOUT);
    }

    # Exectute SeRQL queries.
    foreach my $query (@{$self->{ARGS}{-serql}}) {
	$query =~ s/^\#[^\n]*//;
	$self->_executeQuery($query, $queryHandler, 1, $QL_SeRQL); # @@@ STDOUT);
    }
}

sub _executeQuery {
    my ($self, $query, $queryHandler, $outHandle, $language) = @_;
    my $sysID = $self->{RDF_PARSER}->getSystemId;
    $query =~ s/^\#[^\n]*//;
    my ($nodes, $selects, $messages, $proofs) = $queryHandler->interpret($query, $self->{-location}, $language, 0x00);


    # print join ("\n", @$messages)."\n";
    # print 'algae "'.$query."\" -> \n".join ("\n", map {'('.join (' ', map {$_->toString} @$_).')'} @$nodes)."\n";
    # print 'algae'.$query." -> \n";
    if ($queryHandler->{-templateDB}) {
	print join ("\n", map {$_->toString} $queryHandler->{-templateDB}->getTriples()),"\n";
	exit (0);
    }
    my $outUri = $self->{-atomDictionary}->getUri("file:/stdout/", undef);
    my $outAttribution = $self->{-atomDictionary}->getGroundFactAttribution($outUri, undef, undef, undef);
    # print $outHandle $self->showQueryResults($nodes, $proofs, $outAttribution, $selects);
    if (@$nodes && @{$nodes->[0]}) {
	print $self->showQueryResults($nodes, $proofs, $outAttribution, $selects);
    }
}

# ./algae -d"\"W3C::Rdf::ObjectDB\" (\"name:local:/db\" \"\"properties:../../../Conf/rdf.prop)" -i

sub interactiveQueryBuilder {
    my ($self) = @_;
    eval {require Term::ReadLine;}; if ($@) {&throw()}
    my $term = new Term::ReadLine 'Query Builder';
    my $attribs = $term->Attribs;

    # Setup terminal and readline.
    my $origAttribs = {};
    my $SET1 = '"\'`('; # '"\'`<>!(';
    my $overrideAttribs = {'basic_word_break_characters' => $SET1, 
			   'completer_word_break_characters' => $SET1};
    foreach my $attrib (keys %$overrideAttribs) {
	$origAttribs->{$attrib} = $attribs->{$attrib};
	$attribs->{$attrib} = $overrideAttribs->{$attrib};
    }
    $term->ornaments('md,me,,');	# bold face prompt

    my $prompt = "command: ";
    # Is stdout redirected to $self->{ARGS}{-outputFile} ? Is that good/bad?
    my $OUT = $term->OUT || *STDOUT;

    # Some diagnostics to improve life for the user of the default perl inst.
    eval {require Term::ReadLine::Gnu}; if (!$@) {$IFACE = $IFACE_Gnu;}
    else {
	eval {require Term::ReadLine::Perl}; if (!$@) {$IFACE = $IFACE_Perl}
    }
    print $OUT $IFACE == $IFACE_Gnu ? "Using GNU readline interface.\n" :
	$IFACE == $IFACE_Perl ? "Using perl readline interface.\n" :
	"Using unknown readline interface.\nYou may need Term::ReadLine::Gnu or Term::ReadLine::Perl.\n";

    my $sysID = $self->{RDF_PARSER}->getSystemId;
    my $queryHandler = $self->{RDF_DB}->getAlgaeInterface($self, $sysID);
    $self->{-queryHandler} = $queryHandler;
    $queryHandler->setParserEnv($self);

    my $preput = '(ask \'(';
    my $counter = undef;
    $attribs->{attempted_completion_function} = sub {$self->_hairyCompletionFunction($term, \$counter, @_)};
    $self->_hairyCompletionFunction($term, \$counter, 'ht', "(ask '(asdf ))", 7, 9);
    while (defined ($_ = $term->readline($prompt, $preput)) ) {
	my $res = eval {
	    my $query = $_;
	    if ($query =~ m/^ *(quit|exit|bye) *$/) {goto quitWithCommand}
	    $self->_executeQuery($query, $queryHandler, $OUT, $QL_ALGAE);
	}, "\n";
	warn $@ if $@;
	$term->addhistory($_) if /\S/;
    }
    print "<EOF>\n";
  quitWithCommand:
    foreach my $attrib (keys %$origAttribs) {
	$attribs->{$attrib} = $origAttribs->{$attrib};
    }
}

sub _hairyCompletionFunction {
    my ($self, $term, $pCounter, $text, $line, $start, $end) = @_;
    #print "_hairyCompletionFunction($term, $pCounter, $text, $line, $start, $end)\n";
    my $attribs = $term->Attribs;

    if ($line =~ /^\s*\(/ && 1) {
	my ($tree, $delim, $newSymbs, $variableSet) = (undef, undef, undef, {});
	my $algae = substr($line, 0, $start);
	eval {
	    ($tree, $delim, $newSymbs) = 
		new W3C::Util::SExpr()->parse(\$algae, undef, 
					      {-noTokensAtRoot => 1, 
					       -noNonTermException => 1, 
					       -laterSymbols => $variableSet});
	};
    }

    if (substr($line, 0, $start) =~ /^\s*$/) {
	$attribs->{completion_word} = ['quit', 'exit', 'bye', '('];
	undef $attribs->{completion_display_matches_hook};
	return $term->completion_matches($text,
					 $attribs->{'list_completion_function'});
    } elsif ($line =~ /^(\s*\(()\s*)(\w*)$/) {
	my $soFar = $1;
	my $len = length $soFar;
	my $cmds = ['ask', 'collect', 'namespace', 'attach'];
	my @list = grep {substr($_, 0, $len) eq $soFar} @$cmds;
	$attribs->{completion_word} = [@$cmds]; # @list];
	undef $attribs->{completion_display_matches_hook};
	return $term->completion_matches($text,
					 $attribs->{'list_completion_function'});
    } elsif ($line =~ /^(\s*\(()\s*)(\w*) +$/) {
	$attribs->{completion_word} = ['\'('];
	undef $attribs->{completion_display_matches_hook};
	return $term->completion_matches($text,
					 $attribs->{'list_completion_function'});
    } elsif ($line =~ /^(\s*\(()\s*)(\w*) *\'\( *([\w\:\/0-9\_\-]*)$/) {
#	$attribs->{completion_display_matches_hook} = sub {$self->db_display_match_list($term, @_)};
	return $term->completion_matches($text,
					 sub {$self->db_name_completion_function($term, $pCounter, ['('], @_)});
    } elsif ($line =~ /^(\s*\(()\s*)(\w*) *\'\( *([\w\:\/0-9\_\-]+) +$/) {
	$attribs->{completion_word} = ['('];
	undef $attribs->{completion_display_matches_hook};
	return $term->completion_matches($text,
					 $attribs->{'list_completion_function'});
    } else {			# put mput lcd
	undef $attribs->{completion_display_matches_hook};
	return ();		# local file name completion
    }
}

sub db_display_match_list {
    my ($self, $term, $matches, $num_matches, $max_length) = @_;
    #print "\n\nMATCH:{", &_ray($matches), ", $num_matches, $max_length\n\n";
#    map { $_ =~ s|.*/([^/])|\1|; }(@{$matches});
    $term->display_match_list($matches);
    $term->forced_update_display;
    #print " ==> $_}";
}

sub _ray {
    my ($array, @rest) = @_;
    if (ref $array eq 'ARRAY') {
	my $ret = join (' ', @$array);
	return "[$ret]";
    } else {
	my $ret = join (' ', $array, @rest);
	return "($ret)";
    }
}

sub db_name_completion_function ( $$ ) {
    my($self, $term, $pCounter, $suffix, $text, $state) = @_;
    my $attribs = $term->Attribs;
    my $entry;

    my $queryHandler = $self->{RDF_DB}->getAlgaeInterface($self, undef); # !!! $sysID);
    my @list = ($queryHandler->getSourceNames(), @$suffix);
    #my @list = (qw(one two three), @$suffix);
    #print &_ray(@list), "\n";
    #print "\ndb_name_completion($text, $state)";
    #$self->dumpVars($term);
    if (!$state) {
	$$pCounter = 0;
	# $attribs->{completion_append_character} = ' ';
    } else {
	$$pCounter++;
    }
    my $ret = undef;
    for (; $$pCounter < @list; $$pCounter++) {
	if ($list[$$pCounter] =~ m/^$text/) {
	    $ret = $list[$$pCounter];
	    last;
	}
    }
    #print " ==> $ret\n";
    return $ret;
}

sub dumpVars {
    my ($self, $term) = @_;
    my $attribs = $term->Attribs;
    my @list = ('completion_query_items', 'basic_word_break_characters', 'basic_quote_characters', 'completer_word_break_characters', 'completer_quote_characters', 'filename_quote_characters', 'special_prefixes', 'completion_append_character', 'completion_suppress_append', 'completion_mark_symlink_dirs', 'ignore_completion_duplicates', 'filename_completion_desired', 'filename_quoting_desired', 'attempted_completion_over', 'completion_type', 'inhibit_completion');
    foreach my $attrib (@list) {
	print "$attrib: \"$attribs->{$attrib}\"\n";
    }
}

sub showQueryResults {
    my ($self, $nodes, $proofs, $outAttribution, $selects) = @_;
    my $source = $outAttribution->getSource()->getUri();
    my @ret;
    my $renderClass = $self->{ARGS}{-serializationClass};
    if (defined $SerializerClassAbbreviations{$renderClass}) {
	$renderClass = $SerializerClassAbbreviations{$renderClass};
    }
    my $nsMap = {'r' => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#', 
		 'attrib' => 'http://www.w3.org/2001/12/attributions/ns#'};
    if ($renderClass) {
	# Put the flags together.
	my $flags = {-indent => 3, 
		     -publicId => $source, 
		     -systemId => $source, 
		     -noRdfTag => 0, 
		     -RdfDB => $self->{RDF_DB}, 
		     -allowAnonymousRefs => 1, 
		     -ignoreReifications => 1, 
		     -ignoreAnonymousReifications => 1, 
		     -neededNamespaces =>[keys %$nsMap],
		     -atomDictionary => $self->{-atomDictionary}, 
		     -resource => $outAttribution, 
#		     -createNamespaces => 1, 
		     -importMap => $self->{NAMESPACE_HANDLER}->getAggregateNamespaceHandler()};

	# Incorporate serialization parms.
	$flags = {%$flags, %{$self->{ARGS}{-serializationParms}}};
	# n3 could use -nestNonAnonNode => 0, 

	# Build the serializer class.
	my $serializer;
	eval "require $renderClass; \$serializer = new $renderClass(\$flags);";
	if ($@) {&throw();}

	# @$proofs is an array of proofs.
	# Each proof is an array of statements.
	my $aggregateDB = new W3C::Rdf::RdfDB(-atomDictionary => $self->{-atomDictionary});
	foreach my $proof (@$proofs) {
	    $aggregateDB->copyTriples($proof);
	}
	my $statements = [$aggregateDB->getTriples];
	push (@ret, $self->showRdf($statements, $serializer, $source, $nsMap));
    } else {
	if ($self->{ARGS}{-serializationParms}{-barebones}) {
	    foreach my $row (@$nodes) {
		my @line;
		foreach my $col (@$row) {
		    $_ = $col;
		    &renderNode;
		    push (@line, $_);
		}
		push (@ret, join (',', @line));
	    }
	    push (@ret, undef); # newline at end
	} elsif ($self->{ARGS}{-serializationParms}{-resultSet}) {
	    push (@ret, $self->RSRenderer($nodes, $selects, $proofs));
	} else {
	    push (@ret, $self->arrayRenderer($nodes, $selects, $proofs, 
				  $self->{ARGS}{-serializationParms}{-proofs}));
	}
    }
    return join("\n", @ret);
}

sub renderNode {
    $_ = !defined $_ ? '!unbound!' : 
	$_ == $Value_NULL ? 'NULL' : 
	ref $_ eq 'ARRAY' ? $_ : 
	$_->isa('W3C::Rdf::Uri') ? '<'.$_->getUri.'>' : 
	$_->isa('W3C::Rdf::String') ? $_->getDatatype eq $main::XSD_INT ? $_->getString : '"'.$_->getString.'"' : 
	$_->isa('W3C::Rdf::BNode') ? '_:g'.$_->getId.'' : 
	$_->isa('W3C::Rdf::Attribution') ? '['.$_->getUri->getUri.']' : 
	&throw(new W3C::Util::Exception(-message => "don't know how to serialize \"$_\""));
}

sub arrayRenderer {
    my ($self, $rows, $selects, $proofs, $includeProofs) = @_;

    my %flags = (%{$self->{ARGS}{-serializationParms}});
    my $nsHandler = delete $flags{-ns} ? 
	new W3C::Util::NamespaceReducer(-relay => 
	    $self->{NAMESPACE_HANDLER}->getAggregateNamespaceHandler()) : undef;
    if ($nsHandler) {
	$flags{-namespaceHandler} = $nsHandler;
    }

    require W3C::Util::TableRenderer;
    my $tr = new W3C::Util::TableRenderer();

    # Allocate an extra column for spillover in the proof strings.
    $tr->addHeaders($includeProofs ? [@$selects, ''] : $selects);

    # Walk through each row and optionally add the proofString after it.
    for (my $row = 0; $row < @$rows; $row++) {
	$tr->addData(map {$self->{-atomDictionary}->renderAtom($_, %flags)} @{$rows->[$row]});
	if ($includeProofs) {
	    my $proofStr = join ("\n", map {$_->toString(%flags)} $proofs->[$row]->getTriples());
	    $tr->addRow($proofStr);
	    if ($row < @$rows-1) {
		$tr->underline();
	    }
	}
    }

    my $nsStr = $nsHandler ? $nsHandler->toString(%flags)."\n" : '';
    return $nsStr.$tr->toString."\n";
}

sub RSRenderer {
    my ($self, $rows, $selects, $nodes) = @_;
    my $nsh = new W3C::Util::NamespaceInventor(-relay => $self->{NAMESPACE_HANDLER}->getAggregateNamespaceHandler());
    print "\@prefix rdf:    <http://www.w3.org/1999/02/22-rdf-syntax-ns#> .\n\@prefix rs:     <http://jena.hpl.hp.com/2003/03/result-set#> .\n\n[] rdf:type rs:ResultSet ;\n";
    for (my $iCol = 0; $iCol < @$selects; $iCol++) {
	print "    rs:resultVariable \"$selects->[$iCol]\" ;\n"
    }
    my $rowCount = @$rows;
    print "    rs:size \"$rowCount\" ;\n";
    my $genIds = {};
    for (my $iRow = 0; $iRow < @$rows; $iRow++) {
	print "    rs:solution\n        [ rdf:type rs:ResultSolution ;\n";
	for (my $iCol = 0; $iCol < @$selects; $iCol++) {
	    my $value = $rows->[$iRow][$iCol];
	    if ($value->isa('W3C::Rdf::Uri')) {
		$value = '<'.$value->getUri.'>';
	    } elsif ($value->isa('W3C::Rdf::String')) {
		$value = '"'.$value->getUri.'"';
	    } elsif ($value->isa('W3C::Rdf::BNode')) {
		my $t = $genIds->{$value};
		if (!$t) {
		    $genIds->{$value} = $t = keys (%{$genIds}) + 1;
		}
		$value = '_:'.$t;
	    } else {
#		&throw(new W3C::Util::ProgramFlowException());
	    }
	    print "          rs:binding [ rdf:type rs:ResultBinding ;\n                       rs:variable \"$selects->[$iCol]\" ; rs:value $value ] ;\n";
	}
    }
    print "        ] ;\n    .\n"
}

sub showRdf {
    my ($self, $statements, $serializer, $resource, $nsMap) = @_;
    my $result;

    {
	my $aggregate = $self->{NAMESPACE_HANDLER}->getAggregateNamespaceHandler();

	foreach my $qname (keys %{$self->{-queryHandler}{NAMESPACES}}) {
	    my $uri = $self->{-queryHandler}{NAMESPACES}{$qname};
	    $aggregate->addNamespace($qname, $uri, $resource);
	}

	foreach my $ns (keys %$nsMap) {
	    $aggregate->addNamespace($ns, $nsMap->{$ns}, $resource);
	}
    }

    my $iterator = $self->{RDF_DB}->makeSerializerIterator($statements, 
							   {-scheme => 'guess', 
							    -ignoreReifications => 1, 
							    -ignoreAnonymousReifications => 1, 
							    # -exceptionHandler => 
							    #     new W3C::Rdf::RdfDB::Serializer::ExceptionIgnorer
							});
    eval {
	$iterator->iterate($serializer);
	$result = $serializer->getText();
    }; if ($@) {
	if (my $ex = &catch('W3C::Util::Exception')) {
	    $result = $ex->toString;
	} else {
	    $result = "died with $@";
	}
    }
    return $result;
}

