#!/usr/bin/perl

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

# $Id: annotate,v 1.196 2005/02/11 07:53:51 eric Exp $

#####
# What It Does:

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

#BEGIN {unshift@INC,('../../..');}
@AnnotationQueryObject::ISA = qw(W3C::Rdf::CGIApp::QueryObject);

package W3C::Annotations::cgibin::AnnotateScript;
use W3C::Rdf::CGIApp qw($CGIApp_DeleteMarker);
@W3C::Annotations::cgibin::AnnotateScript::AnnotateHTMLPresenter::ISA = qw(W3C::Rdf::CGIApp::HTMLPresenter);

use vars qw(@ISA);
@ISA = qw(W3C::Annotations::AnnotationApp);

use W3C::Annotations::AnnotationApp qw($SCRIPT_HOME_URI_PROP 
				       $SCHEMA_ANNOTATION_ATTRIBUTION_PROP 
				       $SCHEMA_ANNOTATION_EMAIL_PROP 
				       $SCHEMA_ANNOTATION_GIVEN_PROP 
				       $SCHEMA_ANNOTATION_FAMILY_PROP 
				       $NS_ANNOTATION $NS_THREAD $NS_HTTP
				       $NS_DC10 $NS_DC11 $NS_PALM 
				       $NS_ATTRIBUTIONS);

use W3C::Util::W3CDebugCGI;
use W3C::Util::Exception qw(&throw &catch &DieHandler);
use W3C::Util::Properties;
use W3C::Annotations::UserRecord qw($RW_read);
use W3C::Rdf::Atoms qw($RDF_SCHEMA_URI);
use W3C::Rdf::Algae2;

use vars qw($REVISION $VERSION);
$REVISION = '$Id: annotate,v 1.196 2005/02/11 07:53:51 eric Exp $ ';
$VERSION=0.95;

use vars qw($DEFAULT_dbClass $DEFAULT_dbParms);
$DEFAULT_dbClass = "W3C::Annotations::FlatUserRecords";
$DEFAULT_dbParms = "-file => '/etc/apache/users'";

use vars qw(%ParmMapping %PathMapping);
%ParmMapping = (
		# active (POST) methods
		'w3c_annotate' => 'RDF_INPUT', 
		'w3c_resource' => 'BASE_URI', 
		'w3c_rdfUri' => 'RDF_URI', 
		'w3c_append' => 'APPEND', 
		'delete_source' => 'DELETE_SOURCE', 
		'replace_source' => 'REPLACE_SOURCE', 

		# passive (GET) methods
		'w3c_annotates' => 'ANNOTATION_ANNOTATES', 
		'w3c_replyTree' => 'REPLY_TREE', 
#		'w3c_root' => 'ANNOTATION_ANNOTATES_TREE', 
		'annotation' => 'QUERY_ANNOTATION', 
		'reply' => 'QUERY_REPLY', 
		'attribution' => 'QUERY_ATTRIBUTION', 
		'w3c_annotation' => 'ANNOTATION_REQ', 
		'w3c_body' => 'BODY_REQ', 
		'body' => 'QUERY_BODY', 
		'explain' => 'EXPLAIN',
		'statistics' => 'QUERY_STATISTICS', 

		# algae query specifiers
		'w3c_algaeQuery' => 'ALGAE_QUERY', 
		'q' => 'RDF_QUERY', 
		'lang' => 'RDF_QUERY_LANG', 
		'rdftype' => 'ALGAE_DELETE_TYPE', 

		# output/content control
		'w3c_forceText' => 'RDF_FORCE_RDF', 
		'w3c_forceHTML' => 'RDF_FORCE_HTML', 
		'w3c_ephemoralDB' => 'EPHEMORAL_DB', 

		'w3c_submit' => 'DOIT', 
		);

%PathMapping = (
		'attribution' => 'QUERY_ATTRIBUTION', 
		'body' => 'QUERY_BODY', 
		'annotation' => 'QUERY_ANNOTATION', 
		'bookmark' => 'QUERY_BOOKMARKSHUN', 
		'reply' => 'QUERY_REPLY', 
		'statistics' => 'QUERY_STATISTICS', 
		);

use vars qw($RDFS_RULES);
$RDFS_RULES = <<EORULE
(namespace '(rdf http://www.w3.org/1999/02/22-rdf-syntax-ns# 
	     rdfs http://www.w3.org/2000/01/rdf-schema#) 
 fwrule (head '((rdfs::subPropertyOf ?a ?b)(?a ?c ?d)) 
	 body '((?b ?c ?d))) 
; rdfs subPropertyOf transitivity
 fwrule (head '((rdfs::subPropertyOf ?a ?b)(rdfs::subPropertyOf ?b ?c)) 
	 body '((rdfs::subPropertyOf ?a ?c))) 
; rdfs subClassOf and rdf type
 fwrule (head '((rdf::type ?a ?b)(rdfs::subClassOf ?b ?c)) 
	 body '((rdf::type ?a ?c))) 
; rdfs subClassOf transitivity
 fwrule (head '((rdfs::subClassOf ?a ?b)(rdfs::subClassOf ?b ?c)) 
	 body '((rdfs::subClassOf ?a ?c))) 
; rdfs domain
 fwrule (head '((rdfs::domain ?a ?b)(?a ?c ?d))
	 body '((rdf::type ?c ?b))) 
; rdfs range
 fwrule (head '((rdfs::range ?a ?b)(?a ?c ?d))
	 body '((rdf::type ?d ?b))) 
)
EORULE
    ; #'

use vars qw($NS);
$NS = "ns rdf=<http://www.w3.org/1999/02/22-rdf-syntax-ns#>
ns b=<http://www.w3.org/2002/01/bookmark#>
ns a=<http://www.w3.org/2000/10/annotation-ns#>
ns t=<http://www.w3.org/2001/03/thread#>
ns http=<http://www.w3.org/1999/xx/http#>
ns dc0=<http://purl.org/dc/elements/1.0/>
ns dc1=<http://purl.org/dc/elements/1.1/>
";
$AnnotationQueryObject::InputAnnotationQuery = "${NS}ask
     (?annotation rdf:type    a:Annotation {\\%ATTRIB == <\$self->{-attribution}>}.
      ?annotation a:annotates ?annotates.
      ?annotation a:context   ?context.
      ?annotation a:body      ?body {\\%ATTRIB == <\$self->{-attribution}>}
     )
collect (?annotation ?body)";

$AnnotationQueryObject::InputReplyQuery = "${NS}ask
     (?annotation rdf:type    t:Reply {\\%ATTRIB == <\$self->{-attribution}>}.
      ?annotation t:inReplyTo ?annotates.
      ?annotation a:context   ?context.
      ?annotation a:body      ?body {\\%ATTRIB == <\$self->{-attribution}>}
     )
collect (?annotation ?body)";

$AnnotationQueryObject::InputBookmarkQuery = "${NS}ask
     (?bookmark rdf:type b:Bookmark {\\%ATTRIB == <\$self->{-attribution}>}.
      ?bookmark b:hasTopic ?hasTopic.
      ?bookmark b:recalls ?recalls
     )
collect (?bookmark)";

$AnnotationQueryObject::POQuery = "${NS}ask
     (<\$self->{-annotation}> ?p ?o
     )
collect (?p ?o)";

$AnnotationQueryObject::ReplyQuery = "${NS}ask
     (<\$self->{-reply}> ?p ?o
     )
collect (?p ?o)";

$AnnotationQueryObject::HasTopicQuery = "${NS}ask
     (?bookmark rdf:type b:Bookmark.
      ?bookmark b:recalls ?recalls.
      ?bookmark b:hasTopic <\$self->{-hasTopic}>
     )
collect (?bookmark ?recalls)";

$AnnotationQueryObject::SubTopicQuery = "${NS}ask
     (?topic b:subTopicOf <\$self->{-hasTopic}>
     )
collect (?topic)";

$AnnotationQueryObject::SuperTopicQuery = "${NS}ask
     (<\$self->{-hasTopic}> b:subTopicOf ?topic.
     )
collect (?topic)";

$AnnotationQueryObject::FatAnnotationQuery = "${NS}ask
     (<\$self->{-annotation}> rdf:type    a:Annotation {\\%ATTRIB == <\$self->{-attribution}>}.
      <\$self->{-annotation}> a:annotates ?annotates.
      <\$self->{-annotation}> a:context   ?context.
      ( <\$self->{-annotation}> dc0:creator  ?creator ||
        <\$self->{-annotation}> dc1:creator  ?creator )
      ?creator              a:E-mail    ?email.
      ?creator              a:name      ?name.
      <\$self->{-annotation}> a:ceated    ?created.
      ( <\$self->{-annotation}> dc0:date     ?date || 
        <\$self->{-annotation}> dc1:date     ?date )
      <\$self->{-annotation}> a:body      ?body {\\%ATTRIB == <\$self->{-attribution}>}.
      ?body                 http:Body        ?bodyData.
      ?body                 http:ContentType ?contentType
     )
collect (?annotation ?body)";

$AnnotationQueryObject::BodyQuery = "${NS}ask
     (<\$self->{-bodyId}> http:Body ?bodyData {?attrib = \\%ATTRIB}.
      <\$self->{-bodyId}> http:ContentType ?contentType
      ) collect (?bodyData ?contentType ?attrib)";

$AnnotationQueryObject::AnnotatesQuery = "${NS}ask
     (?annotation rdf:type a:Annotation.
      ?annotation a:annotates <\$self->{-annotates}>
      ) collect (?annotation)";

$AnnotationQueryObject::SubjectQuery = "${NS}ask
     (<\$self->{-subject}> ?p ?o
      ) collect (?p ?o)";

$AnnotationQueryObject::RootQuery = "${NS}ask
     (?reply rdf:type t:Reply.
      ?reply t:root <\$self->{-subject}>.
      (?reply dc0:title ?title || 
       ?reply dc1:title ?title)
      ) collect (?reply ?title)";

$AnnotationQueryObject::InReplyToQuery = "${NS}ask
     (?reply rdf:type t:Reply.
      ?reply t:inReplyTo <\$self->{-subject}>
      ) collect (?reply)";


$AnnotationQueryObject::FatAnnotatesQuery = "(ask
     '(?annotation rdf:type a:Annotation. 
       ?annotation a:annotates <\$self->{-annotates}>.
       ?annotation a:context ?context.
       (?annotation dc0:creator ?creator || 
        ?annotation dc1:creator ?creator)
       ?creator a:E-mail ?email.
       ?creator a:name ?name.
       ?annotation a:created ?created.
       (?annotation dc0:date ?date || 
        ?annotation dc1:date ?date)
       ?annotation a:body ?body
      ) collect '(?annotation ?context ?creator ?created ?date ?body))";

$AnnotationQueryObject::DocumentQuery = "${NS}ask
     (?s ?p ?o {\\%ATTRIB == <\$self->{-attribution}>}
      ) collect (?p ?s ?o)";

$AnnotationQueryObject::AttributionQuery = "${NS}ask
     (<\$self->{-annotation}> a:body ?body {?attrib = \\%ATTRIB}
      ) collect (?attrib)";

$AnnotationQueryObject::ForAttributionQuery = "${NS}ask
     (?s ?p ?o {\\%ATTRIB == <\$self->{-attribution}>}
      ) collect (?p ?s ?o)";

#$AnnotationQueryObject::AttributionQuery = "(ask
#     '((rdf:type <\$self->{-annotation}> a:Annotation ?r ?b ?attrib) 
#       (a:annotates <\$self->{-annotation}> ?annotates)
#      ) collect '(?attrib))";

$annotate::SUBMIT_APPEND_STR = 'append';

$annotate::RDF_HEAD = <<EOHEAD;
<r:RDF xmlns:r="$RDF_SCHEMA_URI"
       xmlns:a="$NS_ANNOTATION"
       xmlns:http="$NS_HTTP"
       xmlns:d="$NS_DC11"
       xmlns="http://www.w3.org/1999/xhtml"
       xmlns:t="$NS_THREAD">
EOHEAD
    ;

$annotate::RDF_FOOT = <<EOFOOT;
</r:RDF>
EOFOOT
    ;

#####
# main - either annotate or show source

my ($query, $annotate);

eval {
    local($SIG{"__DIE__"}) = \&DieHandler;
    $W3C::Util::W3CDebugCGI::DEBUG_SESSION = $ARGV[1]; # use a session id like 957296047.909868 or -2;
    $query = new W3C::Util::W3CDebugCGI($0, $ARGV[0] eq 'DEBUG', 
					{-dieNoOpen => 1,
					 -logExt => '.log', 
					 -storeIn => '/tmp', 
					 -rerun => 'w3c_rerun', 
					 -mergeQueryAndPOST => 1});

    $annotate = new W3C::Annotations::cgibin::AnnotateScript($query);
    my $presenter = $annotate->execute();
    print $presenter->flush($query->getPOST ? 201 : 200);
}; if ($@) {
    my $sessionId = $query ? $query->getSessionId : undef;
    if (my $ex = &catch('W3C::Http::HttpMessageException')) {
	if ($annotate && $annotate->{RDF_DB}) {
	    $annotate->{RDF_DB}->disconnect;
	    delete $annotate->{ACL_REPOSITORY};
	}
	my $message = $ex->getHttpMessage();
	$message->addHeader('Session-Id', $sessionId) if (defined $sessionId);
	print $message->toString;
    } elsif (my $ex = &catch('W3C::Rdf::CGIApp::AppException')) {
	print $ex->toString($sessionId);
    } elsif (my $ex = &catch('W3C::Util::CachedContextException')) {
#	my $trace;
#	$ex->printStackTrace(\ $trace);
#	$annotate->{READ}->escapeHTML($trace);
	my $trace = $annotate->{READ}->escapeHTML($ex->toString());
	my $head = $annotate->{READ}->escapeHTML($ex->{-head});
	my $lineHead = $annotate->{READ}->escapeHTML($ex->{-lineHead});
	my $context = $annotate->{READ}->escapeHTML($ex->{-ctxString});
	my $lineTail = $annotate->{READ}->escapeHTML($ex->{-lineTail});
	my $indicator = $annotate->{READ}->escapeHTML('-' x length ($lineHead) . $ex->{-indicator});
	my $tail = $annotate->{READ}->escapeHTML($ex->{-tail});
	print "Status: 500
Content-type: text/html

<html>
  <head><title>Algae2 Parsing error</title>
    <style type=\"text/css\">
	body { color: black; background-color: white }
	span.indicator { color: red; }
    </style>
  </head>
  <body>
    <pre>$head
$lineHead$context$lineTail
<span class=\"indicator\">$indicator</span>
$tail</pre>
    <pre>$trace</pre>
  </body>
</html>\n";
	if ($sessionId) {
	    print "<p>Session-id: $sessionId</p>\n";
	}
    } elsif (my $ex = &catch('W3C::Util::Exception')) {
	my $sStr = $sessionId ? "<p>Session-id: $sessionId</p>\n" : '';
	print "Status: 500\nContent-type: text/html\n\n";
	print "<html><head><title>Exception: ".$ex->getMessage."</title></head><body><pre>".$ex->toString."</pre>\n$sStr</body></html>\n";
    } else {
	print "Status: 500\n\n";
	print "died with $@";
	if ($sessionId) {
	    print "\n\nSession-id: $sessionId\n";
	}
    }
}

sub new {
    my ($proto, $read) = @_;
    my $class = ref $proto || $proto;
    my $self = $class->SUPER::new($read, 
				  -parmMapping => \%ParmMapping, 
				  -pathMapping => \%PathMapping);
    bless ($self, $class);

    # attach to user database
    my $userDatabase = $self->{-properties}->getI('auth.database.class') || $DEFAULT_dbClass;
    my $parameters = $self->{-properties}->getI('auth.database.parms') || $DEFAULT_dbParms;
    # better not get too fancy
    # my $evalMe = "use $userDatabase; \$self->{USER_RECORDS} = new $userDatabase(-errorHandler => \$self, $parameters);";
    my $evalMe = "use $userDatabase; \$self->{USER_RECORDS} = new $userDatabase($parameters);";
    eval $evalMe;
    if ($@) {&throw()}

    $self->{SHORT_TITLE} => 'annotate';
    return $self;
}

sub execute {
    my ($self) = @_;
    my @titles = ();

    # grab some stuff from the properties
    $self->{ADMIN_IDS} = {};
    my @ids = $self->{-properties}->getI('auth.admin.user');
    foreach my $id (@ids) {
	my $idUri = $self->mapWebIdToUri($id);
	$self->{ADMIN_IDS}{$idUri} = $idUri;
    }

    # get authentication parameters
    my $auth = $self->getAuthenticatedUser();
    if (my $realSession = $self->{READ}->getRealSession()) {
	if ($realSession->getEnv('REQUEST_METHOD') eq 'POST') {
	    if (my $user = $realSession->getEnv('REMOTE_USER')) {
		my $callersAuth = $self->mapWebIdToUri($user);
		if ($self->checkEquivOrAdminAuth($callersAuth, $auth)) {
		    # we are allowing a user or admin user to rerun a session
		} else {
		    &throw($self->failAuth($callersAuth, 'rerun', $realSession->param('w3c_rerun')));
		}
	    } else {
		&throw($self->failAuth(undef, 'rerun', $realSession->param('w3c_rerun')));
	    }
	} else {
	    my $selfUri = $self->{WRITE}->url;
	    my $desiredSession = $self->{READ}->getSessionId;
	    my $form = "<form method=\"post\" action=\"$selfUri\" enctype=\"application/x-www-form-urlencoded\">
  session-id: <input name=\"w3c_rerun\" value=\"$desiredSession\" />
</form>
";
	    &throw($self->htmlReply(200, 'text/html', "Post Required", $form, {'WWW-Authenticate' => 'Basic realm="su"'}));
	}
    }

    # Add foward chaining RDFS rules to the DB rule cache.
    # my $queryHandler = $self->{RDF_DB}->getAlgaeInterface;
    my $queryNamespaceHandler = new W3C::Util::NamespaceHandler();
    # -relay => $self->{NAMESPACE_HANDLER}->getAggregateNamespaceHandler()); # -separator => '::');
    # my $queryHandler = $self->getAlgaeInterface($self, undef); # !!! $sysID);
#    my $queryHandler = new W3C::Rdf::Algae2($self->{-atomDictionary},
#					    $queryNamespaceHandler, 
#					    {'' => $self}, $self, 
#					    undef, {-uniqueResults => 1}, 
#					    -defaultDB => $self->{RDF_DB});
    # my ($nodes, $selects, $messages, $proofs) = $queryHandler->interpret($RDFS_RULES, undef, {-uniqueResults => 1});

    my $assertAttrib = $self->{-atomDictionary}->
	getGroundFactAttribution($self->{-atomDictionary}->getUri($self->{BASE_URI}), undef, $auth, undef);
    my $annotationObject = new AnnotationQueryObject($self->{-atomDictionary}, $assertAttrib, $self->{RDF_DB}, -filter => sub {
	# Add the attributions to each graph we serialize.

	my ($db) = @_;
	eval{
	    $self->addIdStatements($db);
	}; if ($@) {if (my $ex = &catch('W3C::Annotations::UserRecord::UserNotFoundException')) {
	    my $user = $ex->getUsername;
	    my $errorString = "There is no record for user \"$user\".";
	    push (@{$self->{PRE_MESSAGES}}, $errorString);
	} elsif (my $ex = &catch('W3C::Annotations::UserRecord::UserIdException')) {
	    push (@{$self->{PRE_MESSAGES}}, $ex->getMessage);
	} elsif (my $ex = &catch('W3C::Util::Exception')) {
	    &throw($ex);
	} else {&throw(new W3C::Util::PerlException())}}
    });

    my $algaeURL = new URI('algae')->abs(new URI($self->getSelfUri));
    # make interface appropriate to the accept header
    $self->{PRESENTER} = $self->makePresenter({-htmlPresenter => 'W3C::Annotations::cgibin::AnnotateScript::AnnotateHTMLPresenter'}); # @presenterParms

    # Deletions and Replacements
    my $deleteAttribution = undef;
    if ($self->{DELETE_SOURCE}) {
	$self->{DELETE_SOURCE} = $self->urlize($self->{DELETE_SOURCE}, '/annotation/');
	$deleteAttribution = $self->{DELETE_SOURCE};
	push (@titles, "delete $deleteAttribution");
    } elsif ($self->{REPLACE_SOURCE}) {
	$self->{REPLACE_SOURCE} = $self->urlize($self->{REPLACE_SOURCE}, '/annotation/');
	$deleteAttribution = $self->{REPLACE_SOURCE};
	push (@titles, "replace $deleteAttribution");
    }
    if ($deleteAttribution) {
	$annotationObject->{-annotation} = $deleteAttribution;
	my ($results, $selects, $messages, $statements, $query) = 
	    $annotationObject->templateReq($self->{RDF_DB}, $AnnotationQueryObject::AttributionQuery);
	if (@$results > 1) {
	    my $struct = $AnnotationQueryObject::AttributionQuery;
	    &throw($self->htmlReply(500, 
				    'text/html', "Server Error", "More than one annotation \"$deleteAttribution\" found".
				    $annotationObject->algaeLink($struct, $algaeURL)));
	}
	if (@$results == 0) {
	    $annotationObject->{-attribution} = $deleteAttribution;
	    ($results, $selects, $messages, $statements, $query) = 
		$annotationObject->templateReq($self->{RDF_DB}, $AnnotationQueryObject::ForAttributionQuery);
	    if (@$results == 0) {
		my $struct = $AnnotationQueryObject::ForAttributionQuery;
		&throw($self->htmlReply(404, 
					'text/html', "Not Found", "No annotation \"$deleteAttribution\" found".
					$annotationObject->algaeLink($struct, $algaeURL)));
	    }
	}
	my $attribution = (($statements->[0]->getTriples)[0]->getAttributionList->getAllDirect)[0];
	my $storedAuth = $attribution->getAuth;

	# Only the creator or admin user may delete.
	my $method = $self->{REPLACE_SOURCE} ? 'PUT' : 'DELETE';
	if (!($self->checkAuth($auth, $method, $deleteAttribution) > 0 && 
	      $self->checkEquivOrAdminAuth($auth, $storedAuth))) {
	    &throw($self->failAuth($auth, $method, $deleteAttribution));
	}

	# Don't delete anything with replies.
	$annotationObject->{-subject} = $deleteAttribution;
	$annotationObject->{-attribution} = $attribution->getSource->getUri;
	($results, $selects, $messages, $statements, $query) = 
	    $annotationObject->templateReq($self->{RDF_DB}, $AnnotationQueryObject::InReplyToQuery);
	if ($method eq 'DELETE' && @$results != 0) {
	    my $struct = $AnnotationQueryObject::InReplyToQuery;
	    &throw($self->htmlReply(409, 
				    'text/html', "Protocol Vaguery", "Declined to delete \"$deleteAttribution\" as it has replies".
				    $annotationObject->algaeLink($struct, $algaeURL)));
	}

	# Get a new Attribution object with the $deleteAttribution id and
	# clear set to 1. This deletes the old data from that Attribution.
	# $self->{-atomDictionary}->getGroundFactAttribution($document, undef, $storedAuth, undef);
	$self->{RDF_DB}->deleteAttribution($attribution);
	$self->{BASE_URI} = $attribution->getSource->getUri;
    }

    if ($self->{QUERY_BODY}) {
	$self->{QUERY_BODY} = $self->urlize($self->{QUERY_BODY}, '/body/');
	$annotationObject->{-bodyId} = $self->{QUERY_BODY};
	my $bodyInfo = $annotationObject->bodyInfo($self->{RDF_DB}, $AnnotationQueryObject::BodyQuery);
	if (ref $bodyInfo eq 'ARRAY') {
	    my $bodyAttribution = $bodyInfo->[2];
	    if (1 || 
		$self->checkAuth($auth, 'GET', $bodyAttribution->{-bodyId}) > 0 || 
		$auth == $bodyAttribution->getAuth) {

		# Make the body fragment a nice, stand-alone document.
		my $bodyText = "<?xml version=\"1.0\" ?>\n$bodyInfo->[1]";
		my $measuredSize = length $bodyText;
		my $message = $self->simpleReply(200, $bodyInfo->[0], $measuredSize, $bodyText);
		&throw(new W3C::Http::HttpMessageException(-httpMessage => $message));
		#$self->{RDF_FORCETYPE} = [$bodyInfo->[0], 'MessagePresenter'];
		#return $self->makePresenter(undef, -httpMessage => $message);
	    } else {
		&throw($self->failAuth($auth, 'GET', $bodyAttribution->{-bodyId}));
	    }
	} else {
	    my $struct = $AnnotationQueryObject::BodyQuery;
	    &throw($self->htmlReply(404, 
				    'text/html', "Not Found", "Unable to locate \"$self->{QUERY_BODY}\" with <pre>$bodyInfo</pre>".
				    $annotationObject->algaeLink($struct, $algaeURL)));
	}
	return;
    }

    if ($ENV{'REQUEST_METHOD'} eq "GET" &&
	(($ENV{'QUERY_STRING'} eq "" && $ENV{'PATH_INFO'} eq "") 
	 || $self->{EXPLAIN} eq "true")) {
	if (my $ov = $self->{-properties}->getI('Overview')) {
	    if ($ov =~ m/^http:\/\//) {
		&throw($self->htmlReply(307, 'text/html', "Temporary Redirect", 
					"go see <a href=\"$ov\">$ov</a>", {Location => $ov}));
	    } else {
		local *OV;
		if (open (OV, "<$ov")) {
		    while (my $line = <OV>) {
			$self->{PRESENTER}->printOK($line);
		    }
		    close OV;
		    return $self->{PRESENTER};
		} else {
		    &throw($self->htmlReply(500, 'text/html', "Configuration Error", 
					    "could not find overview page <em>$ov</em>"));
		}
	    }
	}
    }

    if ($self->{RDF_INPUT}) {
	my $tmpDB = new W3C::Rdf::RdfDB(-atomDictionary => $self->{-atomDictionary});
	if ($self->checkAuth($auth, 'POST', $self->getSelfUri) > 0) {
	    eval {
		$self->parse($self->{RDF_INPUT}, $tmpDB, $assertAttrib);
	    }; if ($@) {if (my $ex = &catch('W3C::Util::NoSuchFileException')) {
		return print $self->confFileMissing($ex->getFile);
	    } elsif (my $ex = &catch('W3C::Util::Exception')) {
		return print $self->unknownException($ex);
	    } else {
		return print $self->unknownException(new W3C::Util::Exception(-message => "perl error: $@"));
	    }}
	} else {
	    &throw($self->failAuth($auth, 'POST', $self->getSelfUri));
	}
	$annotationObject->{-attribution} ||= $self->{BASE_URI};
	my $found = $annotationObject->inputReq($tmpDB, $self->{PRESENTER}, 
						$assertAttrib, $self, 
						$deleteAttribution ? scalar $self->decomposeUid($deleteAttribution) : undef, 
						[[$AnnotationQueryObject::InputAnnotationQuery, 
						  [['annotation', '-annotation'], ['body', '-bodyId']]], 
						 [$AnnotationQueryObject::InputReplyQuery, 
						  [['reply', '-reply'], ['body', '-bodyId']]], 
						 [$AnnotationQueryObject::InputBookmarkQuery, 
						  [['bookmark', '-bookmark']]]]);
	# Copy to the persistent store if it meets our policy.
	$self->{RDF_DB}->copyTriples($tmpDB);
	if ($found = 0) {
	    push (@titles, "accept annotation $annotationObject->{-annotation}");
	} elsif ($found = 1) {
	    push (@titles, "accept annotation $annotationObject->{-annotation}");
	} else {
	    push (@titles, "accepted data of unknown type");
	}
    }

    if ($self->{ANNOTATION_REQ} || $self->{QUERY_ANNOTATION} || $self->{QUERY_BOOKMARKSHUN}) {
	if ($self->{QUERY_ANNOTATION}) {
	    $self->{QUERY_ANNOTATION} = $self->urlize($self->{QUERY_ANNOTATION}, '/annotation/');
	    $annotationObject->{-annotation} = $self->{QUERY_ANNOTATION};
	} elsif ($self->{QUERY_BOOKMARKSHUN}) {
	    $self->{QUERY_BOOKMARKSHUN} = $self->urlize($self->{QUERY_BOOKMARKSHUN}, '/bookmark/');
	    $annotationObject->{-annotation} = $annotationObject->{-bookmark} = $self->{QUERY_BOOKMARKSHUN};
	} else {
	    $self->{ANNOTATION_REQ} = $self->urlize($self->{ANNOTATION_REQ}, undef);
	    $annotationObject->{-annotation} = $self->{ANNOTATION_REQ};
	}
	push (@titles, "annotation $annotationObject->{-annotation}");
	$annotationObject->genericReq($self->{RDF_DB}, $self->{PRESENTER}, 
				      $AnnotationQueryObject::POQuery, $annotationObject->{-annotation}, 
				      'annotation details: ', 'found no annotation matching ', 
				      [$AnnotationQueryObject::POQuery], 
				      $auth);
    }
    if ($self->{REPLY_REQ} || $self->{QUERY_REPLY}) {
	if ($self->{QUERY_REPLY}) {
	    $self->{QUERY_REPLY} = $self->urlize($self->{QUERY_REPLY}, '/reply/');
	    $annotationObject->{-reply} = $self->{QUERY_REPLY};
	} else {
	    $self->{REPLY_REQ} = $self->urlize($self->{REPLY_REQ}, undef);
	    $annotationObject->{-reply} = $self->{REPLY_REQ};
	}
	push (@titles, "reply $annotationObject->{-reply}");
	$annotationObject->genericReq($self->{RDF_DB}, $self->{PRESENTER}, 
				      $AnnotationQueryObject::ReplyQuery, $annotationObject->{-reply}, 
				      'reply details: ', 'found no reply matching ', 
				      [$AnnotationQueryObject::ReplyQuery], 
				      $auth);
    }
    if ($self->{HAS_TOPIC_REQ}) {
	$annotationObject->{-hasTopic} = $self->{HAS_TOPIC_REQ};
	push (@titles, "bookmarks with topic $annotationObject->{-hasTopic}");
	$annotationObject->genericReq($self->{RDF_DB}, $self->{PRESENTER}, 
				      $AnnotationQueryObject::HasTopicQuery, $annotationObject->{-hasTopic}, 
				      'topic details: ', 'found no bookmark with topic ', 
				      [$AnnotationQueryObject::HasTopicQuery], 
				      $auth);
    }

    if ($self->{SUB_TOPIC_REQ}) {
	$annotationObject->{-hasTopic} = $self->{SUB_TOPIC_REQ};
	push (@titles, "subtopics of $annotationObject->{-hasTopic}");
	$annotationObject->genericReq($self->{RDF_DB}, $self->{PRESENTER}, 
				      $AnnotationQueryObject::SubTopicQuery, $annotationObject->{-hasTopic}, 
				      'subtopic details: ', 'found no subtopic ', 
				      [$AnnotationQueryObject::SubTopicQuery], 
				      $auth);

	push (@titles, "supertopics of $annotationObject->{-hasTopic}");
	$annotationObject->genericReq($self->{RDF_DB}, $self->{PRESENTER}, 
				      $AnnotationQueryObject::SuperTopicQuery, $annotationObject->{-hasTopic}, 
				      'subtopic details: ', 'found no subtopic ', 
				      [$AnnotationQueryObject::SuperTopicQuery], 
				      $auth);
    }
    if ($self->{QUERY_ATTRIBUTION}) {
	$self->{QUERY_ATTRIBUTION} = $self->urlize($self->{QUERY_ATTRIBUTION}, '/attribution/');
	$annotationObject->{-attribution} = $self->{QUERY_ATTRIBUTION};
	push (@titles, "annotation $annotationObject->{-attribution}");
	$annotationObject->genericReq($self->{RDF_DB}, $self->{PRESENTER}, 
				      $AnnotationQueryObject::DocumentQuery, $annotationObject->{-attribution}, 
				      'attribution details: ', 'found no attribution matching ', 
				      [$AnnotationQueryObject::DocumentQuery], 
				      $auth);
    }
    if ($self->{BODY_REQ}) {
	$self->{BODY_REQ} = $self->urlize($self->{BODY_REQ}, undef);
	$annotationObject->{-bodyId} = $self->{BODY_REQ};
	push (@titles, "body $annotationObject->{-bodyId}");
	$annotationObject->genericReq($self->{RDF_DB}, $self->{PRESENTER}, 
				      $AnnotationQueryObject::BodyQuery, $annotationObject->{-bodyId}, 
				      'http message: ', 'found no body matching ', 
				      [$AnnotationQueryObject::BodyQuery],
				      $auth);
    }
    if ($self->{ANNOTATION_ANNOTATES}) {
	$self->{ANNOTATION_ANNOTATES} = $self->urlize($self->{ANNOTATION_ANNOTATES}, undef);
	my $annotators = new AnnotationQueryObject($self->{-atomDictionary}, $assertAttrib, $self->{RDF_DB});
	$annotators->{-annotates} = $self->{ANNOTATION_ANNOTATES};
	my $title = "annotators of $annotators->{-annotates}";
	push (@titles, $title);
	my ($results, $selects, $messages, $statements, $query) = 
	    $annotators->templateReq($self->{RDF_DB}, $AnnotationQueryObject::AnnotatesQuery);
	$self->{PRESENTER}->printAnnotation($title, $query);
	for (my $i = 0; $i < @$results; $i++) {
	    # For each annotation...
	    eval {
		my $row = $results->[$i];
		my $annotation = $row->[0];
		$annotationObject->{-subject} = $annotation->getUri();
		$annotationObject->{-annotates} = $self->{ANNOTATION_ANNOTATES};

		# Get all arcs from this annotation.
		$annotationObject->genericReq($self->{RDF_DB}, $self->{PRESENTER}, 
					      $AnnotationQueryObject::SubjectQuery, $annotationObject->{-annotates}, 
					      'an annotation for ', 'incomplete annotation ', 
					      [$AnnotationQueryObject::SubjectQuery],
					      $auth);
	    }; if ($@) {
		my $ex;
		if ($ex = &catch('W3C::Util::Exception')) {
		} else {
		    $ex = new W3C::Util::PerlException(-error => $@);
		}
		my $message = $ex->toString; # getMessage;
		my $annotStr = '-- unknown annotation --';
		eval {$annotStr = $results->[$i][0]->toString();}; if ($@) {}
		my $errorString = "$ex Exception dumping $i:$annotStr:\n$message\n";
		push (@{$self->{PRE_MESSAGES}}, $errorString);
	    }
	}
    }
    if ($self->{REPLY_TREE}) {
	my $threadLeaves = new AnnotationQueryObject($self->{-atomDictionary}, $assertAttrib, $self->{RDF_DB});
	$threadLeaves->{-subject} = $self->{REPLY_TREE};
	my $title = "thread leaves of $threadLeaves->{-subject}";
	push (@titles, $title);
	my ($results, $selects, $messages, $statements, $query) = 
	    $threadLeaves->templateReq($self->{RDF_DB}, $AnnotationQueryObject::RootQuery);
	$self->{PRESENTER}->printAnnotation($title, $query);
	for (my $i = 0; $i < @$results; $i++) {
	    eval {
		my $row = $results->[$i];
		my $annotation = $row->[0];
		$annotationObject->{-subject} = $annotation->getUri;
		$annotationObject->{-thread} = $self->{ANNOTATION_THREAD};
		$annotationObject->genericReq($self->{RDF_DB}, $self->{PRESENTER}, 
					      $AnnotationQueryObject::SubjectQuery, $annotationObject->{-subject}, 
					      'replies for ', 'found nothing replying to ', 
					      [$AnnotationQueryObject::SubjectQuery],
					      $auth);
	    }; if ($@) {
		my $ex;
		if ($ex = &catch('W3C::Util::Exception')) {
		} else {
		    $ex = new W3C::Util::PerlException(-error => $@);
		}
		my $message = $ex->getMessage;
		my $annotStr = $results->[$i][0]->show();
		my $errorString = "Error dumping $annotStr:\n$message\n";
		push (@{$self->{PRE_MESSAGES}}, $errorString);
	    }
	}
    }
    if ($self->{ALGAE_QUERY}) {
	push (@titles, "algae query $self->{ALGAE_QUERY}");
	$annotationObject->algaeReq($self->{RDF_DB}, $self->{PRESENTER}, $self->{ALGAE_QUERY}, $auth);
    }
    if ($self->{RDF_QUERY}) {
	my $lang = $self->{RDF_QUERY_LANG} eq 'Algae' ? $QL_ALGAE : 
	    $self->{RDF_QUERY_LANG} eq 'Algae' ? $QL_SPARQL : 
	    &throw(new W3C::Util::Exception(-message => "unknown query language \"$self->{RDF_QUERY_LANG}\""));
	push (@titles, "$self->{RDF_QUERY_LANG} query $self->{RDF_QUERY}");
	$annotationObject->algaeReq($self->{RDF_DB}, $self->{PRESENTER}, $self->{RDF_QUERY}, $auth, $lang);
    }
    if (!@titles) {
	push (@titles, 'W3C annotation server');
    }
    $self->{PRESENTER}->printHead($self->{PRE_MESSAGES}, join ('; ', @titles));
    $self->{PRESENTER}->printFoot($annotationObject);
    return $self->{PRESENTER};
}

# Return number of reasons $user can perform $method on $resource

sub checkAuth {
    my ($self, $auth, $method, $document) = @_;
    if ($method eq 'GET' || 
	$method eq 'HEAD' || 
	$method eq 'CONNECT' || 
	$method eq 'TRACE' || 
	$method eq 'OPTIONS') {
	return 1;
    } elsif (($method eq 'POST' || $method eq 'PUT' || 
	      $method eq 'DELETE') && defined $auth) {
	return 1;
    } else {
	return 0;
    }
}

# Check whether $auth is the same as $equiv or if $auth is a known admin id.
# This is usefull for PUT, DELETE and rerun as you only want a user to be
# able to replace, delete, or replay his own sessions.
sub checkEquivOrAdminAuth {
    my ($self, $auth, $equiv) = @_;
    if ($equiv && $auth == $equiv) {
	return 1;
    }
    if ($self->{ADMIN_IDS}{$auth}) {
	return 1;
    }
    return 0;
}

sub failAuth {
    my ($self, $auth, $method, $document) = @_;
    my $message = '';
    if ($auth) {
	my $authStr = $self->{WRITE}->escapeHTML($auth->getUri);
	my $docStr = $self->{WRITE}->escapeHTML($document->toString);
	$message = "<em>$authStr</em> does not have rights to <em>$method</em> <em>$docStr</em>";
    } else {
	$message = "un-authenticated users do not have the rights to <em>$method</em> <em>$document</em>";
    }
    return $self->htmlReply(401, 'text/html', "Auth Required", $message, {'WWW-Authenticate' => 'Basic realm="su"'});
}

# overload CGIApp::importCGIParms so we can get non-CGI POSTs

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

    # load a properties file if available
    eval {
	$self->{-properties} = new W3C::Util::Properties('annotate.prop'); # 'rdf.prop', 
	$self->{SELF_URI} = $self->{READ}->uriFromProperties($self->{-properties}, $SCRIPT_HOME_URI_PROP);
    }; if ($@) {if (my $ex = &catch('W3C::Util::FileNotFoundException')) {
	$self->{-properties} = new W3C::Util::Properties();
	$self->{SELF_URI} = $self->{READ}->url;
    } else {&throw()}}

    # @@@ temporary hack to deal with clients that POST urlencoded data without CGI parms
    if ($ENV{'REQUEST_METHOD'} eq 'POST' && 
	$self->{READ}->getPOST() =~ m/^<\?xml/ && 
	$ENV{CONTENT_TYPE} =~ m/^application\/x-www-form-urlencoded(.*)/) {
	$ENV{CONTENT_TYPE} = "application/xml$1";
	# this hack requires the parms be ignore (as they are garbage).
	undef $self->{-flags}{-parmMapping};
    }

    if ($ENV{'REQUEST_METHOD'} eq 'POST' && 
	$ENV{CONTENT_TYPE} =~ m/^application\/xml(.*)/) {
	$self->{RDF_INPUT} = $self->{READ}->getPOST(); # @@@ no &CGI::unescape
	# delete $self->{-parmMapping};
	$self->{READ}->param('POSTDATA', \ $CGIApp_DeleteMarker);
	$self->SUPER::importCGIParms;
	return;
    }

    # @@@ temporary hack to deal with clients that submit urlencoded GETs with %3As instead of ':'s
    if ($ENV{'REQUEST_METHOD'} eq 'GET' && 
	$ENV{CONTENT_TYPE} eq 'application/x-www-form-urlencoded' && 
	$self->{READ}->param('w3c_annotates') =~ m/^(\w+)\%3A(.*)$/) {
	$self->{ANNOTATION_ANNOTATES} = "$1:$2";
	# this hack requires the parms be ignore (as they are garbage).
	return;
    }

    $self->SUPER::importCGIParms;
    if ($ENV{'REQUEST_METHOD'} eq 'PUT') {
	my $putXML = $self->{READ}->getPUT();
	$self->{RDF_INPUT} = $putXML;
	$self->{REPLACE_SOURCE} = $self->{SELF_URI}.$ENV{'PATH_INFO'};
	# $self->{BASE_URI} = $self->getSelfUri.'/attribution/'.$self->{QUERY_ANNOTATION};
	undef $self->{QUERY_ANNOTATION}; # no need to do annonotation
	undef $self->{QUERY_REPLY};	 #    or reply query for PUT data
	undef $self->{QUERY_BOOKMARKSHUN};
    } elsif ($ENV{'REQUEST_METHOD'} eq 'DELETE') {
	$self->{DELETE_SOURCE} = $self->{SELF_URI}.$ENV{'PATH_INFO'};
	undef $self->{QUERY_ANNOTATION}; # no need to do annonotation
	undef $self->{QUERY_REPLY};	 #    or reply query for PUT data
	undef $self->{QUERY_BOOKMARKSHUN};
    } elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
	my $postXML = $self->{READ}->getPOST();
	if ($ENV{CONTENT_TYPE} eq 'text/xml' || 
	    $ENV{CONTENT_TYPE} eq 'application/xml') {
	    $self->{RDF_INPUT} = $postXML;
	} elsif ($ENV{CONTENT_TYPE} eq 'application/x-www-form-urlencoded') {
	} elsif ($ENV{CONTENT_TYPE} =~ m/^multipart\/form-data/) {
	} else {
	    &throw(new W3C::Util::Exception(-message => "Don't know how to deal with POSTed mime type $ENV{CONTENT_TYPE}"));
	}
    }
}

sub getSelfUri {
    my ($self)  = @_;
    return $self->{SELF_URI};
}

sub word {
    my ($content) = @_;
    my $contentLength = length ($content);
    print <<EOF
Status: 200
Content-type: text/plain

$content
EOF
    ;
#Content-length: $contentLength
#    exit(0);
}

sub urlize {
    my ($self, $urlString, $typeString) = @_;
    if ($urlString !~ m/^(\~?)(\w+)\:(\/\/([\w\d\-]+))?/) {
	if (defined $typeString) {
	    $urlString = $self->getSelfUri.$typeString.$urlString;
	} else {
	    &throw(new W3C::Util::MalformedUriException(-uri => $urlString));
	}
    }
    $urlString = new URI($urlString)->canonical();
    return $urlString;
}

package W3C::Annotations::cgibin::AnnotateScript::AnnotateHTMLPresenter;
use W3C::Rdf::Atoms qw($RDF_SCHEMA_URI);
use W3C::Annotations::AnnotationApp qw($NS_ANNOTATION $NS_BOOKMARK);

sub printHead {
    my ($self, $preMessages, $title) = @_;
    $self->SUPER::printHead($preMessages, $title);
    $self->printOK('<pre class="code head">');
}

sub printFoot {
    my ($self, $annotationObject) = @_;
    $self->printAnnotation('close RDF', '');
    $self->endRdf;
    $self->printOK($self->{SERIALIZED_STRING}.'</pre>');
    my $selfUri = $self->{ENGINE}->getSelfUri;

    my $displayAnnotationId = $self->{RENDERER}->escapeHTML($annotationObject->{-annotation});
    my $displayReplyId = $self->{RENDERER}->escapeHTML($annotationObject->{-reply});
    my $displayBookmarkId = $self->{RENDERER}->escapeHTML($annotationObject->{-bookmark});
    my $displayAnnotates = $self->{RENDERER}->escapeHTML($annotationObject->{-annotates});
    my $displayThread = $self->{RENDERER}->escapeHTML($annotationObject->{-thread});
    my $displayBodyId = $self->{RENDERER}->escapeHTML($annotationObject->{-bodyId});
    my $displayName = $annotationObject->{'authorId'} || 'John Smith';
    my $displayEmail = $annotationObject->{'email'} || 'mailto:jsmith@example.com';
    my $displayCreated = $annotationObject->{'createdId'} || gmtime().' GMT';
    my $displayModified = $annotationObject->{'modifiedId'} || gmtime().' GMT';

    my $annotationTemplate; # = $self->{ENGINE}->{RDF_INPUT};
    my $replyTemplate; # = $self->{ENGINE}->{RDF_INPUT};
    my $bookmarkTemplate; # = $self->{ENGINE}->{RDF_INPUT};

    if (!$annotationTemplate) {
	my $displayAnnotationStr = $displayAnnotationId ? ' r:about="'.$displayAnnotationId.'"' : '';
	my $displayBodyStr = $displayBodyId ? ' r:about="'.$displayBodyId.'"' : '';
	my $displayFragment = $annotationObject->{'fragmentId'} || '#(1|2)';
	$annotationTemplate = <<EORDF
<?xml version="1.0"?>
$annotate::RDF_HEAD
 <r:Description$displayAnnotationStr>
  <r:type resource="${NS_ANNOTATION}Annotation"/>
  <r:type resource="${NS_ANNOTATION}Comment"/>
  <a:annotates r:resource="http://example.org/some/page.html"/>
  <a:context>$displayFragment</a:context>
  <!-- d:creator>
    <rdf:Description>
      <a:E-mail resource="$displayEmail"/>
      <a:name>$displayName</a:name>
    </rdf:Description>
  </d:creator -->
  <d:creator>$displayName</d:creator>
  <a:created>$displayCreated</a:created>
  <d:date>$displayModified</d:date>
  <a:body>
   <http:Message$displayBodyStr>
    <http:ContentType>text/html</http:ContentType>
    <http:Body r:parseType="Literal"><html>
 <head>
  <title>an annotation</title>
 </head>
 <body>
  this is my annotation
  <RDF xmlns="$RDF_SCHEMA_URI">
  </RDF>
 </body>
</html></http:Body>
   </http:Message>
  </a:body>
 </r:Description>
$annotate::RDF_FOOT
EORDF
    ;
    }
    $annotationTemplate = $self->{RENDERER}->escapeHTML($annotationTemplate);
    $annotationTemplate =~ s/\n/\\n/gs;

    if (!$replyTemplate) {
	my $displayReplyStr = $displayReplyId ? ' r:about="'.$displayReplyId.'"' : '';
	my $displayBodyStr = $displayBodyId ? ' r:about="'.$displayBodyId.'"' : '';
	$replyTemplate = <<EORDF
<?xml version="1.0"?>
$annotate::RDF_HEAD
 <a:Reply$displayReplyStr>
  <t:foo r:resource="$displayAnnotationId"/>
  <d:creator>$displayName</d:creator>
  <a:created>$displayCreated</a:created>
  <d:date>$displayModified</d:date>
 </a:Reply>
$annotate::RDF_FOOT
EORDF
    ;
    }
    $replyTemplate = $self->{RENDERER}->escapeHTML($replyTemplate);
    $replyTemplate =~ s/\n/\\n/gs;

    if (!$bookmarkTemplate) {
	my $displayBookmarkStr = $displayBookmarkId ? ' r:about="'.$displayBookmarkId.'"' : '';
	my $displayBodyStr = $displayBodyId ? ' r:about="'.$displayBodyId.'"' : '';
	$bookmarkTemplate = <<EORDF
<?xml version="1.0"?>
$annotate::RDF_HEAD
  <r:Description$displayBookmarkStr>
    <r:type r:resource="${NS_BOOKMARK}Bookmark"/>
    <!-- b:appearsIn r:resource="http://example.com/folders/ghoti"/ -->
    <b:hasTopic r:resource="#myTopic"/>
    <!-- dc:creator r:resource="http://example.com/person/one"/ -->
    <dc:creator>$displayName</dc:creator>
    <a:created>$displayCreated</a:created>
    <dc:date>$displayModified</dc:date>
    <dc:title>title 1</dc:title>
    <dc:description>this is one of my favorite sites</dc:description>
    <b:recalls r:resource="http://example.org/some/page.html" />

  </r:Description>

  <r:Description r:about="#myTopic">
    <a:created>2002-02-08T13:05</a:created>
    <r:type r:resource="http://www.w3.org/2002/01/bookmark#Topic"/>
    <b:subTopicOf r:resource="#myTopic2"/>
    <dc:title>My Favorite Sites</dc:title>
    <dc:description>My collection of favorite sites</dc:description>
  </r:Description>

  <r:Description r:about="#myTopic2">
    <a:created>2002-02-22T12:01</a:created>
    <r:type r:resource="http://www.w3.org/2002/01/bookmark#Topic"/>
    <dc:title>My Favorites</dc:title>
    <dc:description>These are some of my favorite things</dc:description>
  </r:Description>

$annotate::RDF_FOOT
EORDF
    ;
    }
    $bookmarkTemplate = $self->{RENDERER}->escapeHTML($bookmarkTemplate);
    $bookmarkTemplate =~ s/\n/\\n/gs;

    my $displayAttribution = $self->{ENGINE}->{BASE_URI};
    $displayAttribution = $self->{RENDERER}->escapeHTML($displayAttribution);

    $displayAnnotates ||= 'http://example.org/some/page.html';
    my $algaeTemplate = $self->{ENGINE}->{RDF_QUERY} || "${W3C::Annotations::cgibin::AnnotateScript::NS}ask (
       ?annotation rdf:type a:Annotation. 
       ?annotation a:annotates <$displayAnnotates>.
       ?annotation a:context ?context.
       (?annotation dc0:creator ?creator || 
        ?annotation dc1:creator ?creator).
      #?creator a:E-mail ?email.
      #?creator a:name ?name.
       (?annotation dc0:date ?date || 
        ?annotation dc1:date ?date).
       ?annotation a:body ?body)
collect (?annotation ?context ?date ?body)";
    $algaeTemplate = $self->{RENDERER}->escapeHTML($algaeTemplate);
    $algaeTemplate =~ s/\n/\\n/gs;

    my $sparqlTemplate = $self->{ENGINE}->{RDF_QUERY} || "SELECT ?annotation ?context ?date ?body
WHERE {?annotation rdf:type a:Annotation. 
       ?annotation a:annotates <$displayAnnotates>.
       ?annotation a:context ?context.
       ?annotation a:body ?body.
       ?annotation dc0:creator ?creator OR 
        {?annotation dc1:creator ?creator}.
       ?annotation dc0:date ?date OR
        {?annotation dc1:date ?date}}
USING rdf FOR <http://www.w3.org/1999/02/22-rdf-syntax-ns#>
      a FOR <http://www.w3.org/2000/10/annotation-ns#>
      t FOR <http://www.w3.org/2001/03/thread#>
      http FOR <http://www.w3.org/1999/xx/http#>
      dc0 FOR <http://purl.org/dc/elements/1.0/>
      dc1 FOR <http://purl.org/dc/elements/1.1/>";
    $sparqlTemplate = $self->{RENDERER}->escapeHTML($sparqlTemplate);
    $sparqlTemplate =~ s/\n/\\n/gs;

    my $revstr = '$Revision: 1.196 $ $Date: 2005/02/11 07:53:51 $ ';
    my $tmp = <<EOF;
  <p>
    Welcome to the W3C Annotation Server!
  </p>
  <p>
    This tool manipulates <a href="http://www.w3.org/1999/07/13-persistant-RDF-DB.html">persistent RDF data</a> associated with a given resource.
  </p>
  <hr />
  <h2><a name=\"byUri\">Create an Annotation</a></h2>
  <form id=\"createForm\" name=\"createForm\" enctype=\"application/x-www-form-urlencoded\" method=\"post\" action=\"$selfUri\">
    <p>RDF input area:<br />
    <div style="border: 4px double gray; margin: 0em; padding: 0em">
    <div style="float: right;">
      <input type="button" value="Annotation Template" onclick="document.createForm.w3c_annotate.value='$annotationTemplate'" /><br />
      <input type="button" value="Reply Template" onclick="document.createForm.w3c_annotate.value='$replyTemplate'" /><br />
      <input type="button" value="Bookmark Template" onclick="document.createForm.w3c_annotate.value='$bookmarkTemplate'" /><br />
      <input type="button" value="Clear" onclick="document.createForm.w3c_annotate.value=''" />
    </div>
    <div style="float: left;">
      <textarea name=\"w3c_annotate\" rows=\"13\" cols=\"100\"></textarea>
    </div>
    <div style="clear: both;">
    </div></div><br />
    Replacing Annotation: <input name=\"replace_source\" size=\"55\" value=\"$displayAnnotationId\" /><br />
    <a href="http://www.w3.org/1999/07/13-persistant-RDF-DB.html#Attributions">Attribution</a> for this RDF (and reference for <a href="http://info.internet.isi.edu/in-notes/rfc/files/rfc2396.txt">relative URIs</a>): <input name=\"w3c_resource\" size=\"55\" value=\"\" /><br />
    append previous version:<input type="checkbox" name="w3c_append" value=\"$annotate::SUBMIT_APPEND_STR\" /><br />
<br />
    <input type=\"submit\" name=\"w3c_submit\" value=\"POST new annotation\" />
    <input type=\"submit\" name=\"w3c_submit\" value=\"REPLACE annotation\" />
    <input type=\"submit\" name=\"w3c_submit\" value=\"DELETE annotation\" />
    <input type=\"reset\" value=\"Reset this form\" />
    <input type="checkbox" name="w3c_forceText" value="*" />force text/xml 
    <input type="checkbox" name="w3c_ephemoralDB" value="*" />use ephemoral DB</p>
  </form>
  <hr />
  <h2><a name=\"byUri\">Query Annotations</a></h2>
  <form id=\"queryForm\" name=\"queryForm\" method=\"get\" action=\"$selfUri\">
    <p>annotation to retrieve: <input name=\"w3c_annotation\" size=\"55\" value=\"$displayAnnotationId\" /> <input type="button" value="Clear" onclick="document.queryForm.w3c_annotation.value='';" /><br />
    body to retrieve: <input name=\"w3c_body\" size=\"55\" value=\"$displayBodyId\" /><input type="button" value="Clear" onclick="document.queryForm.w3c_body.value=''" /><br />
    uris to check for annotations: <input name=\"w3c_annotates\" size=\"55\" value=\"$displayAnnotates\" /><input type="button" value="Clear" onclick="document.queryForm.w3c_annotates.value=''" /><br />
    threads: <input name=\"w3c_replyTree\" size=\"55\" value=\"$displayThread\" /><input type="button" value="Clear" onclick="document.queryForm.w3c_replyTree.value=''" /><br />

    <div style="border: 4px double gray; margin: 0em; padding: 0em; background-color: #fff">
    <div style="float: right;">
      <input type="button" value="Algae Template" onclick="document.queryForm.q.value='$algaeTemplate'; document.queryForm.Algae.lang.selected='selected'; document.queryForm.SPARQL.lang.selected=''; " /><br />
      <input type="button" value="SPARQL Template" onclick="document.queryForm.q.value='$sparqlTemplate'; document.queryForm.Algae.lang.selected=''; document.queryForm.SPARQL.lang.selected='selected'; " /><br />
      <input type="button" value="Clear" onclick="document.queryForm.q.value=''" /><br />
      <select name="lang">
      <option name="Algae" selected="selected" value="Algae">Algae</option>
      <option name="SPARQL" value="SPARQL">SPARQL</option>
      </select>
    </div>
    <div style="float: left;">
      <textarea name=\"q\" rows=\"13\" cols=\"100\"></textarea><br />
    </div>
    <div style="clear: both;">
    </div>
    </div><br />
    <input type=\"submit\" name=\"w3c_submit\" value=\"query RDF DB\" />
    <input type=\"reset\" value=\"Reset this form\" />
    <input type="checkbox" name="w3c_forceText" value="*" />force text/xml 
    <input type="checkbox" name="w3c_ephemoralDB" value="*" />use ephemoral DB</p>
  </form>
  <hr />
  <address>
    $revstr
  </address>
EOF
    ;
    $self->printOK($tmp);

    # done - clean up
    $self->printOK($self->{RENDERER}->end_html."\n");
}

__END__

=head1 NAME

W3C::Annotations::cgibin::annotate - A W3C::Rdf::CGIApp to store and retrieve W3C annotations

=head1 SYNOPSIS

  http://<server>/Annotations/access

=head1 DESCRIPTION

The C<annotate> script provides a CGI server that implements the Annotea (L<http://www.w3.org/2001/Annotea/>) procotol. It uses a L<W3C::Rdf::SqlDB> database for persistent storage. Installation and use details are available on the Annotea home page.

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

=head2 Apache Authentication

This is one of the biggest challenges to installing this script. See L<W3C::Annotations::cgibin::access> for details and trouble shooting tips.

=head1 AUTHOR

Eric Prud'hommeaux <eric@w3.org>

=head1 SEE ALSO

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

=cut