#!/usr/bin/perl

#Copyright Massachusetts Institute of technology, 2000.
#Written by Eric Prud'hommeaux

# $Id: AnnotationApp.pm,v 1.47 2005/09/20 06:16:19 eric Exp $

#####
# What It Does:

#####
# set up module environment
use strict;

use W3C::Rdf::CGIApp;
use Exporter;
@AnnotationQueryObject::ISA = qw(W3C::Rdf::CGIApp::QueryObject Exporter);

package W3C::Annotations::AnnotationApp;
@W3C::Annotations::AnnotationApp::ISA = qw(W3C::Rdf::CGIApp);

use W3C::Util::W3CDebugCGI;
use W3C::Util::Exception;
use W3C::Util::Properties;
use W3C::Annotations::UserRecord qw($RW_read);
use W3C::Rdf::Atoms qw($RDF_SCHEMA_URI);

use vars qw($REVISION $VERSION @EXPORT_OK);
$REVISION = '$Id: AnnotationApp.pm,v 1.47 2005/09/20 06:16:19 eric Exp $ ';
$VERSION = 2.0;
@EXPORT_OK = qw($SCRIPT_HOME_URI_PROP $SCHEMA_ANNOTATION_EMAIL_PROP
		$SCHEMA_ANNOTATION_GIVEN_PROP $SCHEMA_ANNOTATION_FAMILY_PROP
		$SCHEMA_ANNOTATION_ATTRIBUTION_PROP $AUTH_WEBID_BASE_PROP
		$NS_ANNOTATION $NS_BOOKMARK $NS_THREAD $NS_HTTP $NS_HTML
		$NS_DC10 $NS_DC11
		$NS_PALM $NS_ATTRIBUTIONS);

# paths
use vars qw($SCRIPT_HOME_URI_PROP $SCHEMA_ANNOTATION_EMAIL_PROP
	    $SCHEMA_ANNOTATION_CREATOR_PROP
	    $SCHEMA_ANNOTATION_GIVEN_PROP $SCHEMA_ANNOTATION_FAMILY_PROP
	    $SCHEMA_ANNOTATION_ATTRIBUTION_PROP $AUTH_WEBID_BASE_PROP);
$SCRIPT_HOME_URI_PROP = 'script.home.uri';
$SCHEMA_ANNOTATION_CREATOR_PROP = 'schema.annotation.creator';
$SCHEMA_ANNOTATION_EMAIL_PROP = 'schema.annotation.email';
$SCHEMA_ANNOTATION_GIVEN_PROP = 'schema.annotation.given';
$SCHEMA_ANNOTATION_FAMILY_PROP = 'schema.annotation.family';
$SCHEMA_ANNOTATION_ATTRIBUTION_PROP = 'schema.annotation.attribution';
$AUTH_WEBID_BASE_PROP = 'auth.idUri.base';

use vars qw($NS_ANNOTATION $NS_BOOKMARK $NS_THREAD $NS_HTTP $NS_HTML $NS_DC10 $NS_DC11 $NS_PALM $NS_ATTRIBUTIONS);
$NS_ANNOTATION = 'http://www.w3.org/2000/10/annotation-ns#';
$NS_BOOKMARK = 'http://www.w3.org/2002/01/bookmark#';
$NS_THREAD = 'http://www.w3.org/2001/03/thread#';
$NS_HTTP = 'http://www.w3.org/1999/xx/http#';
$NS_HTML = 'http://www.w3.org/1999/xhtml#';
$NS_DC10 = 'http://purl.org/dc/elements/1.0/';
$NS_DC11 = 'http://purl.org/dc/elements/1.1/'; # was 'http://purl.org/dc/elements/1.0/';
$NS_PALM = 'xmlns:http://www.w3.org/2000/08/palm56/addr#';
$NS_ATTRIBUTIONS = 'http://www.w3.org/2001/12/attributions/ns#';

sub makePresenter {
    my ($self, $presenterTypes) = @_;
    my $ns = {
	'a' => $NS_ANNOTATION, 
	'http' => $NS_HTTP, 
	'' => $NS_HTML, 
	'd' => $NS_DC11, 
	'r', $RDF_SCHEMA_URI, 
    };
    my $presenter = $self->SUPER::makePresenter($presenterTypes, $ns);
    return $presenter;
}

sub tweakPost {
    my ($self) = @_;
    &throw(new W3C::Util::Exception());
}

sub getAuthenticatedUser {
    my ($self) = @_;
    my $auth = undef;
    if (my $user = $ENV{'REMOTE_USER'}) {
	$auth = $self->mapWebIdToUri($user);
        if ($self->{USER_RECORDS} &&
            !$self->{USER_RECORDS}->getUserRecord($user)) {
            &throw (new W3C::Util::Exception(-message =>
                                  "HTTP user $user not found in user database"));
        }
    } elsif (my $user = $self->{-properties}->getI('auth.forceUser')) {
	$auth = $self->mapWebIdToUri($user);
    }
    return $auth;
}

sub mapUriToWebId {
    my ($self, $uri) = @_;
    my $authBase = $self->{-properties}->getI($AUTH_WEBID_BASE_PROP);
    if ($uri =~ m/^\Q$authBase\E(.*)$/) {
	my $user = $self->{WRITE}->unescape($1);
	my $ret;
	eval {new W3C::Annotations::UserRecord::UserNotFoundException(-username => 'bob', -database => 'joe');
	    $ret = $self->{USER_RECORDS}->getUserRecord($user);
	}; if ($@) {if (my $ex = &catch('W3C::Util::FileOperationException')) {
	    &throw(new W3C::Annotations::UserRecord::AccessException(-userid => $uri, -filename => $ex->getFilename));
	} else {
	    &throw();
	}}
	return $ret;
    } else {
	&throw(new W3C::Annotations::UserRecord::UserIdException(-userid => $uri));
    }
}

sub mapWebIdToUri {
    my ($self, $webId) = @_;
    my $authBase = $self->{-properties}->getI($AUTH_WEBID_BASE_PROP);
    my $encoded = $self->{WRITE}->escape($webId);
    my $uriStr = "$authBase$encoded";
    return $self->{-atomDictionary}->getUri($uriStr, undef)
}

sub addIdStatements {
    my ($self, $rdfDB) = @_;

    my @tripleList = $rdfDB->getTriples();
    my $attribs = $tripleList[0]->getAttributionList;
    my $attrib = $attribs->[0];
    my $annotation = $tripleList[0]->getSubject;

    my $auth = $attrib->getAuth;
    my $atoms = $self->{-atomDictionary};
    my $attribProp = $self->{-properties}->getI($SCHEMA_ANNOTATION_ATTRIBUTION_PROP);
    if ($attribProp) {
	&_addTriple1($atoms, $rdfDB, $attribProp, $annotation, $attrib->getSource, undef, $attrib);
    }
    if ($auth) {
	my $creatorProp = $self->{-properties}->getI($SCHEMA_ANNOTATION_CREATOR_PROP);
	my $emailProp = $self->{-properties}->getI($SCHEMA_ANNOTATION_EMAIL_PROP);
	my $givenProp = $self->{-properties}->getI($SCHEMA_ANNOTATION_GIVEN_PROP);

	eval {
	    my $userRecord = $self->mapUriToWebId($auth->getUri);
	    my $creator = $atoms->createBNode($attrib);
	    if (($userRecord->getByEmail && $emailProp) || 
		($userRecord->getByName && $givenProp)) {
		&_addTriple1($atoms, $rdfDB, $creatorProp, $annotation, $creator, $attrib);
	    }
	    if ($userRecord->getByEmail && $emailProp) {
		my $mailto = 'mailto:'.$userRecord->getEmail;
		&_addTriple1($atoms, $rdfDB, $emailProp, $creator, $atoms->getUri($mailto), $attrib);
	    }
	    if ($userRecord->getByName && $givenProp) {
		my $givenString = $atoms->getString($userRecord->getGiven, undef, 'PLAIN');
		&_addTriple1($atoms, $rdfDB, $givenProp, $creator, $givenString, $attrib);
		my $familyProp = $self->{-properties}->getI($SCHEMA_ANNOTATION_FAMILY_PROP);
		my $familyString = $atoms->getString($userRecord->getFamily, undef, 'PLAIN');
		$rdfDB->addTriple($atoms->getStatement($atoms->getUri($familyProp), $creator, 
						       $familyString, undef, $attrib));
	    }
	}; if ($@) {if (my $ex = &catch('W3C::Annotations::UserRecord::Exception')) {
	    if ($creatorProp) {
		&_addTriple1($atoms, $rdfDB, $creatorProp, $annotation, $auth, $attrib);
	    }
	} else {&throw()}}
    }
}

sub _addTriple1 {
    my ($atoms, $rdfDB, $p, $s, $o, $a) = @_;
    $rdfDB->addTriple($atoms->getStatement($atoms->getUri($p), $s, $o, undef, $a));
}

sub error {
    my ($self, $exception) = @_;
    my $text = $exception->toString;
    my $message = $self->standardError("<pre class=\"error\">$text</pre>");
    &throw(new W3C::Http::HttpMessageException(-httpMessage => $message));
}

sub standardError {
    my ($self, $errorString) = @_;
    return $self->standardMessage(500, 'Error', "<p>$errorString</p>");
}

sub standardMessage {
    my ($self, $statusCode, $title, $markup) = @_;
    my $sessionId = $self->{READ}->getSessionId;

    my $body = <<EOF
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd"> 
<html><head><title>$title</title></head>
      <body><h1>$title</h1>
      $markup
      <p>SessionId: $sessionId</p>
</body></html>
EOF
    ;
    my $message = new W3C::Http::Message(-statusCode => $statusCode, 
					 -headers => [], 
					 -body => $body);
    return $message;
}

package AnnotationQueryObject;
use W3C::Util::Exception;
use W3C::Rdf::Algae2;

# hostQueries:	[hostableDesc+]
# hostableDesc:	[query, [hostable*]]
# hostable:	[titel, hashSlot]
# ex: [["(ask '((p1 \$th ?o1)(p2 \$th ?o2)) collect '(?o1 ?o2))", 
#       [['O1', '-o1'], 
#        ['O2', '-o2']]],
#      ["(ask '((p3 \$th ?o3)(p4 \$th ?o4)) collect '(?o3 ?o4))", 
#       [['O3', '-o3'], 
#        ['O4', '-o4']]]]
sub inputReq {
    my ($self, $rdfDB, $presenter, $attrib, $engine, $emulateSessionId, $hostQueries) = @_;
    my $attribUri = $attrib->getSource->getUri; # needed for eval'd queries
    my $found = -1;
    my @tried;
    for (my $iHostQuery = 0; $iHostQuery < @$hostQueries; $iHostQuery++) {
	my $hostableDesc = $hostQueries->[$iHostQuery];
	my $query; eval '$query = "'.$hostableDesc->[0].'"'; if ($@) {&throw()}
	push (@tried, $query);
	if ($self->hostAndShow($rdfDB, $presenter, $attrib, $engine, $emulateSessionId, $query, $hostableDesc->[1])) {
	    $found = $iHostQuery;
	    last;
	} else {
	    $self->{QHANDLER}->clear;
	}
    }
    if ($found < 0) {
	my $lookedForsStr = join (' or ', map {$_->[1][0][0]} @$hostQueries);
	$presenter->printEmptyQuery("found no $lookedForsStr.", join("\n or \n", @tried), 'expected data in RDF input');
    }
    return $found;
}

sub hostAndShow {
    my ($self, $rdfDB, $presenter, $attrib, $engine, $emulateSessionId, $query, $hostables) = @_;
    my $location = 'internal query';
    my $attribUri = $attrib->getSource->getUri;

    my $oldDB = $self->{QHANDLER}{-rdfDB};
    $self->{QHANDLER}{-rdfDB} = $rdfDB;
    my ($results, $selects, $messages, $statements) = 
	$self->{QHANDLER}->interpret($query, $location, $QL_ALGAE, 0x00, {-group => 1, -uniqueResults => 1});
    $self->{QHANDLER}{-rdfDB} = $oldDB;
    if (@$results) {
	my $result = $results->[0];
	for (my $iHostable = 0; $iHostable < @$hostables; $iHostable++) {
	    my $hostable = $hostables->[$iHostable];
	    my $v = $results->[0][$iHostable];
	    my $v2 = $engine->checkId($v, $hostable->[0], $emulateSessionId, [$rdfDB, @$statements]);
	    $self->{$hostable->[1]} = $v2->getUri; # (undef, undef, {-raw => 1});
	}
	my $annoteStat = $emulateSessionId ? "updated" : "new";
	$self->showQueryResults($rdfDB, $results, $selects, $messages, $statements, $presenter, 
				"$annoteStat annotation document: <a href=\"$attribUri\">$attribUri</a>", $query);
	return 1;
    }
    return 0;
}

sub bodyInfo {
    my ($self, $rdfDB, $queryTemplate) = @_;
    my $query; eval '$query = "'.$queryTemplate.'"'; if ($@) {&throw()}
    my $location = 'internal query';
    my ($results, $selects, $messages) = $self->{QHANDLER}->interpret($query, $location, $QL_ALGAE, 0x00, {-group => 1, -uniqueResults => 1});
    if (@$results) {
	my $result = $results->[0];
	my $bodyData = $result->[0]->getString;
	my $contentType = $result->[1]->getString;
	my $attribution = $result->[2];
	return [$contentType, $bodyData, $attribution];
    } else {
	return $query;
    }
}

1;

__END__

=head1 NAME

W3C::Annotations::AnnotationApp - A specialization W3C::Rdf::CGIApp to support Annotea protocols

=head1 SYNOPSIS

  use W3C::Annotations::AnnotationApp qw($NS_ANNOTATION);

  sub printHead {
      my ($self, $preMessages, $title) = @_;
      $self->printOK('<html><head>...');
  }
  sub printFoot {
      my ($self, $annotationObject) = @_;
      $self->printOK('...</head></html>');
  }

=head1 DESCRIPTION

This module provides methods common to the Annotea annotation and bookmark scripts.

This module is used with the W3C::Annotations CPAN module.

=head1 AUTHOR

Eric Prud'hommeaux <eric@w3.org>

=head1 SEE ALSO

L<W3C::Annotations::cgibin::annotate>
L<W3C::Annotations::cgibin::access>

=cut

