#!/usr/bin/perl
# -*- mode: perl -*-

# $Id: annoprox,v 1.25 2005/10/08 23:28:25 eric Exp $

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

$REVISION = '$Id: annoprox,v 1.25 2005/10/08 23:28:25 eric Exp $ ';

#BEGIN {unshift@INC,('../../..');}
use strict;

my ($ListenPort, $ListenSockets, $DefaultCharset, $CompressWhitespace) = (8080, 5, 'us-ascii', 0);
my $DOC_ANNOTS = '/html[1]/body[1]';
my $DOC_CREATE = 'p/span[@class="eoDocAnnotations"]';
my $ORPHAN_ANNOTS = '/html[1]/body[1]';
my $ORPHAN_BLOCK = 'p';
my $ORPHAN_FLOW = 'span[@class="eoDocAnnotations"]';
my $ORPHAN_ERROR = 'span[@class="error"]';
my $SCRIPT_showAnnotation = "script[\@type=\"text/javascript\"]/text(\"function showAnnotation(body){window.open(body)} 
function hideAnnotation(body){}
function showError(error){alert(error)}\")";

package miniRdfApp;
use W3C::Rdf::RdfApp;
@miniRdfApp::ISA = qw(W3C::Rdf::RdfApp);
use W3C::Util::Exception;

sub new {
    my ($proto) = @_;
    my $class = ref $proto || $proto;
    my $self = $class->SUPER::new();
    bless ($self, $class);
    $self->{ARGS} = {};
    $self->prepareParser;
    return $self;
}

package auxReqSession;
use W3C::Http::ProxySession qw($SUMMARY $ERROR $SOCKETS $OBJECTS $PROTOCOL $SELECT $DAEMON $PROXY_ACTION $DEBUG);
@auxReqSession::ISA = qw(W3C::Http::ProxySession);
use W3C::Util::Exception;



package annoProxSession;
use W3C::Http::ProxySession qw($SUMMARY $ERROR $SOCKETS $OBJECTS $PROTOCOL $SELECT $DAEMON $PROXY_ACTION $DEBUG);
@annoProxSession::ISA = qw(W3C::Http::ProxySession);
use W3C::Util::Exception;

use CGI;
use LWP::UserAgent;
use XML::DOM;
use W3C::Rdf::RdfApp;
use W3C::Rdf::Atoms qw($RDF_SCHEMA_URI);
use W3C::XML::InputSource;
use W3C::XML::XPathParser;

# Get some handy namespace constants.
use W3C::Annotations::AnnotationApp qw($NS_ANNOTATION $NS_THREAD $NS_HTTP
				       $NS_DC10  $NS_DC11 
				       $NS_PALM $NS_ATTRIBUTIONS);

sub new {
    my ($proto, $context, $style, @rest) = @_;
    my $class = ref $proto || $proto;
    my $self = $class->SUPER::new(@rest);
    $self->{Context} = $context;
    $self->{AnnotationStyle} = $style || '.annotation { color: blue; background: grey; } .orphan { color: red; }';
    $self->{AlgaeQuery} = undef;
    return $self;
}

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

    $self->{AlgaeQuery} = "(?annotation <${RDF_SCHEMA_URI}type> <${NS_ANNOTATION}Annotation> . 
        ?annotation <${NS_ANNOTATION}annotates> <$self->{URI}> .
        ?annotation <${NS_ANNOTATION}context> ?context .
        ?annotation <${NS_ANNOTATION}body> ?body .
        ?body <${NS_HTTP}Body> ?bodyData .
        ?body <${NS_HTTP}ContentType> ?contentType)";

    # select a datasources
    for my $queryServer ($self->{PROXY}->getAnnotationServerList()) {
	$self->httpQuery($queryServer);
    }

    for my $db ($self->{PROXY}->getDatabaseList()) {
	$self->localQuery($db);
    }
}

sub httpQuery {
    my ($self, $queryServer) = @_;

    $self->{PROXY}->log($SUMMARY, "querying $queryServer");
    # Construct the query.

    my $dataSource;
    if (0) {
	$dataSource = "$queryServer?w3c_annotates=$self->{URI}";
    } else {
	my $remoteQuery = " ask $self->{AlgaeQuery}
 collect (?context ?body ?contentType ?bodyData)";
	$dataSource = "$queryServer?w3c_algaeQuery=".CGI::escape($remoteQuery);
    }

    # Create a user agent object
    my $ua = LWP::UserAgent->new;
    $ua->agent('annoprox 0.1');
    my $req = HTTP::Request->new(GET => $dataSource);
    $req->header(Accept => "text/rdf, */*;q=0.1");
    my $res = $ua->request($req);
    if ($res->is_success) {
	$self->{DATA_URI} = $dataSource;
	$self->{PROXY}->parseHttpResponse(\$res->content, $self->{DATA_URI});
    }
}

sub localQuery {
    my ($self, $db) = @_;

    $self->{PROXY}->log($SUMMARY, "querying $db");
    my $queryHandler = $self->{Context}->getQueryHandler($self, {-uniqueResults => 1});
    $db->{DB}->executeSingleQuery("SELECT 1");
    my $queryNamespaceHandler = new W3C::Util::NamespaceHandler(
	-relay => $self->{NAMESPACE_HANDLER});
    my $dbQueryHandler = new W3C::Rdf::Algae2(-atomDictionary => $self->{Context}{-atomDictionary},
					      -namespaceHandler => $queryNamespaceHandler, 
					      -sources => {'' => $self}, 
					      -rdfApp => $self, 
					      -sourceAttribution => $self->{Context}{INPUT_ATTRIBUTION}, 
					      -uniqueResults => 1, 
					      -rdfDB => $db);

    my $query = "ask $self->{AlgaeQuery} 
 collect (?context ?body ?contentType ?bodyData)";
    eval {
	my ($baseUri, $queryLang) = (undef, $QL_ALGAE);
	my ($nodes, $selects, $messages, $proofs) = $dbQueryHandler->interpret($query, $baseUri, $queryLang, 0x00);
	foreach my $proof (@$proofs) {
	    $self->{Context}->getRdfDB()->copyTriples($proof);
	}
    }; if ($@) {
	#if (my $ex = &catch('W3C::Util::Exception')) {
	#} else {&throw()}
	if (my $ex = &catch('W3C::Util::NoSuchResourceException')) {
	} elsif (my $ex = &catch('W3C::Util::CachedContextException')) {
	    if ($ex->{-exception} && 
		$ex->{-exception}->isa('W3C::Util::NoSuchResourceException')) {
	    } else {&throw($ex)}
	} else {&throw()}
    }
}

sub htmlHandler {
    my ($self, $pText) = @_;
    my $charset = $self->{ReplyHeaders} =~ /\ncontent-type: [^;\r\n]+;.*?charset=([a-zA-Z0-9\-]*)/i ? $1 : $DefaultCharset;
    my $parser = new XML::DOM::Parser;

    eval {
	# Parse the document.
	my $doc;
	eval {
	    $doc = $parser->parse($$pText, ProtocolEncoding => $charset);
	}; if ($@) {
	    return $$pText;
	}

	# Apply necessary canonicallizations.
	if ($CompressWhitespace) {
	    eval {
		my $xpath = new W3C::XML::XPathParser();
		my %preserveSpace;
		my @compressElems = qw(title p li dt dd ); # capricious selection of the rendered, non-xml:space elements in the XHMTL DTD
		foreach my $elem (qw(style script pre)) { # xml:space elems in XHTML
		    foreach my $textNode ($xpath->match($doc, "//$elem//text()")) {
			$preserveSpace{$textNode} = $textNode;
		    }
		}
		my @pcdata = qw(a form title address object applet option fieldset); # + %Inline; %Flow;
		# excluding: pre style script textarea button
		my @inline = qw(p h1 h2 h3 h4 h5 h6 dt legend caption);
		# excluding: span bdo em strong dfn code q samp kbd var cite abbr acronym sub sup tt i b u s strike big small font label
		my @flow = qw(noscrip iframe noframes li dd blockquote center ins del th td);
		# excluding: body div
		my @compressElems = (@pcdata, @inline, @flow); # qw(title p li dt dd ); # capricious selection of the rendered, non-xml:space elements in the XHMTL DTD
		foreach my $elem (@compressElems) {
		    foreach my $textNode ($xpath->match($doc, "//$elem//text()")) {
			next if $preserveSpace{$textNode};
			my $parent = $textNode->getParentNode();
			my $shortened = $textNode->getData();
			$shortened =~ s/\s+/ /g;
			my $newNode = $doc->createTextNode($shortened);
			$parent->insertBefore($newNode, $textNode);
			$parent->removeChild($textNode);
		    }
		}
	    };
	}

	$$pText = $self->linkToAnnotations($doc, $self->gatherMods());
    }; if ($@) {
	my $ex;
	if ($ex = &catch('W3C::Util::Exception')) {
	} else {
	    $ex = new W3C::Util::PerlException();
	}
	$self->{PROXY}->log($ERROR, "uncaught exception in htmlHandler:\n".$ex->toString());
    }


    my $newlen = length($$pText);
    $self->{ReplyHeaders} =~ s/\nContent-Length: \d+/\nContent-Length: $newlen/i;
    $self->{Buffer} = join("", $self->{ReplyHeaders}, $$pText);
}



sub gatherMods {
    my ($self) = @_;
    # Construct the query.
    my $queryHandler = $self->{Context}->getQueryHandler($self, {-uniqueResults => 1});
    my $query = "ask $self->{AlgaeQuery} 
 collect (?context ?body ?contentType ?bodyData)";
    my @mods;
    eval {
	my ($baseUri, $queryLang) = (undef, $QL_ALGAE);
	my ($nodes, $selects, $messages, $proofs) = $queryHandler->interpret($query, $baseUri, $queryLang, 0x00);
	if (@$nodes) {
	    push (@mods, map {[$_->[0]->isa('W3C::Rdf::String') ? $_->[0]->getString : $_->[0]->getUri, 
			       $_->[1]->getUri, 
			       $_->[2]->getString, 
			       $_->[3]->getString]} @$nodes);
	}
    }; if ($@) {
	#if (my $ex = &catch('W3C::Util::Exception')) {
	#} else {&throw()}
	if (my $ex = &catch('W3C::Util::NoSuchResourceException')) {
	} elsif (my $ex = &catch('W3C::Util::CachedContextException')) {
	    if ($ex->{-exception} && 
		$ex->{-exception}->isa('W3C::Util::NoSuchResourceException')) {
	    } else {&throw($ex)}
	} else {&throw()}
    }
    return @mods;
}

sub linkToAnnotations {
    my ($self, $doc, @mods) = @_;
    my $xpath = new W3C::XML::XPathParser();

    {
	my $head = ($xpath->match($doc, '/html[1]/head[1]'))[0];
	$xpath->create($head, $SCRIPT_showAnnotation, 0);
	$xpath->create($head, "style[\@type=\"text/css\"]/text(\"
/*<![CDATA[*/
$self->{AnnotationStyle}
/*]]*/
\")", 0);
    }

    # Get a list of modifications
    my @addHere;
    foreach my $mod (@mods) {
	my ($context, $body, $contentType, $bodyData) = @$mod;
	# Only contexts we understand.
	if ($context !~ m/xpointer\((.*?)\)$/) {
	    $self->{PROXY}->log($ERROR, "don't know how to process context \"$context\"");
	    next;
	}
	my $xpointer = $1;
	my $create = undef;
	if ($xpointer eq '/html[1]') {
	    $xpointer = $DOC_ANNOTS;
	    $create = $DOC_CREATE;
	}
	my $summaryText = 'error parsing annotation body';
	eval {
	    # Parse body to extract text.
	    #my $bParser = new XML::DOM::Parser;
	    my $bDoc = (new XML::DOM::Parser())->parse($bodyData);
	    $summaryText = $self->cullText($bDoc, 200);
	}; if ($@) {
	    $summaryText = $@;
	}
	$summaryText =~ s/\"/&quot;/g;
	eval {
	    my @nodes = $xpath->xpointer($doc, $xpointer);
	    for (my $i = 0; $i < @nodes; $i++) {
		my $node = $nodes[$i];
		if ($node->getNodeType() == $node->TEXT_NODE &&
		    $node->getData() =~ m/^\s*$/) {
		    next;
		} elsif ($node->isa('XML::DOM::Range') && @nodes > 1) {
		    my $data = $node->getData();
		    my $parent = $node->getParentNode();
		    my $doc = $node->getNodeType() == $node->DOCUMENT_NODE ? $node : $node->getOwnerDocument();
		    my $startOffset = $node->startOffset();
		    my $endOffset = $node->endOffset();
		    if ($i == 0) {
			$node = $doc->createRangeNode($data, $startOffset, length($data)+1, $parent);
		    } elsif ($i == @nodes - 1) {
			$node = $doc->createRangeNode($data, 1, $endOffset, $parent);
		    }
		}
		if ($create) {
		    $node = $xpath->create($node, $create, 0);
		}
		push (@addHere, [$node, $body, $contentType, $summaryText]);
	    }
	}; if ($@) {
	    my $ex;
	    if ($ex = &catch('W3C::Util::Exception')) {
	    } else {
		$ex = new W3C::Util::PerlException();
	    }
	    $self->{PROXY}->log($ERROR, $ex->toString());
	    eval {
		if (my $spot = ($xpath->xpointer($doc, $ORPHAN_ANNOTS))[0]) {
		    my $block = $xpath->create($spot, $ORPHAN_BLOCK, 0);
		    push (@addHere, [$block, $body, $contentType, $summaryText]);
		    my $summaryText = $ex->getMessage();
		    $summaryText =~ s/\"/\\\"/g;
		    my $body = $ex->toString();
		    $body  =~ s/\"/&quot;/g;
		    $body  =~ s/\n/\\n/g;
		    my $err = $xpath->create($block, "span[\@class=\"annotation error\"]/a[\@title=\"$summaryText\" and \@onclick=\"showError(\\\"$body\\\")\"]/text(\"match failure\")", 0);
		    $spot = $xpath->create($err, $ORPHAN_FLOW, 1);
		}
	    }; if ($@) {
		my $ex;
		if ($ex = &catch('W3C::Util::Exception')) {
		} else {
		    $ex = new W3C::Util::PerlException();
		}
		$self->{PROXY}->log($ERROR, "ERROR in ERROR HANDLER\n".$ex->toString());
	    }
	}
    }

    if (@addHere) {
	# Create an index.
	my $bodyEl = ($xpath->match($doc, '/html[1]/body[1]'))[0];
	my $annotIndex = $xpath->create($bodyEl, "ul[\@id=\"annotIndex\"]", 0);

	# Sort into document order.
	@addHere = sort {&docOrder($a, $b)} @addHere;

	# Perform those modifications
	for (my $annotNo = 0; $annotNo < @addHere; $annotNo++) {
	    my $addMe = $addHere[$annotNo];
	    my ($node, $body, $contentType, $summaryText) = @$addMe;

	    eval {
		my $genId = "annot_$annotNo";
		my $indexStyle = 'annotation';
		if ($node->isa('XML::DOM::Range')) {
		    my $vessel = $node->getParentNode();
		    my $oldData = $vessel->getFirstChild();
		    while ($oldData) {
			if ($oldData->getNodeType() == $oldData->TEXT_NODE && 
			    $oldData->getData() eq $node->getData()) {
			    last;
			}
			$oldData = $oldData->getNextSibling();
		    }
			   
		    my $text = $node->getData();
		    my $start = $node->startOffset()-1;
		    my $end = $node->endOffset()-1;

		    my $l = $doc->createTextNode(substr($text, 0, $start));
		    my $m = substr($text, $start, $end-$start);
		    my $r = $doc->createTextNode(substr($text, $end));
		    $vessel->insertBefore($l, $oldData);
		    # $vessel->insertBefore($m, $oldData);
		    $vessel->insertBefore($r, $oldData);
		    $xpath->create($r, "span[\@class=\"annotation\" and \@id=\"$genId\"]/a[\@title=\"$summaryText\" and \@onclick=\"showAnnotation('$body')\"]/text(\"$m\")", 1);
		    $vessel->removeChild($oldData);

		} else {
		    my $linkText ||= '[annotation]';
		    $xpath->create($node, "span[\@class=\"annotation orphan\" and \@id=\"$genId\"]/a[\@title=\"$summaryText\" and \@onclick=\"showAnnotation('$body')\"]/text(\"$linkText\")", 1);
		    $indexStyle .= ' orphan';
		}

		$xpath->create($annotIndex, "li/a[\@href=\"#$genId\" and \@class=\"$indexStyle\"]/text('$summaryText')", 0);
	    }; if ($@)  {
		my $ex;
		if ($ex = &catch('W3C::Util::Exception')) {
		} else {
		    $ex = new W3C::Util::PerlException();
		}
		$self->{PROXY}->log($ERROR, $ex->toString());
	    }
	}
    }
    return $doc->toString;
}

sub docOrder { # static
    my ($a, $b) = @_;
    my ($aNode, $aBody, undef, undef) = @$a;
    my ($bNode, $bBody, undef, undef) = @$b;

    return $aNode->documentOrderSort($bNode);
}

sub lameXPointer1 {
    my ($self, $doc, $xpointer) = @_;
    my $ret;
    eval {
	$ret = $self->lameXPointer($doc, $xpointer);
    }; if ($@) {
	print "failed to resolve \"$xpointer\".";
	if (my $ex = &catch('W3C::Util::Exception')) {
	    &throw($ex);
	} else {
	    &throw();
	}
    }
}
sub lameXPointer {
    my ($self, $doc, $xpointer) = @_;
    my $cur = $doc;
  SEGMENT:
    while (pos $xpointer < length $xpointer) {
	my $lastPos = pos $xpointer;
	if ($xpointer =~ m/\G\/?/gcxsi) {
	} elsif ($xpointer =~ m/\G\#(\w+)\(([^\)]+)\)/gcxsi) {
	    return [$cur, $2, undef];
	} elsif ($xpointer =~ m/\Gstring-range\(\s*([\w\d\/\[\]\(\)\"]+)\s*,\s*\"([^\"]*)\"\s*,\s*(\d+)\s*,\s*(\d+)\s*\)/gcxsi) {
	    my ($nested, $targetStr, $start, $end) = ($1, $2, $3, $4);
	    my $lookIn = $self->lameXPointer($cur, $nested);
	    my $vessel = $lookIn->[0];
	    my $oldData = $vessel->getFirstChild;
	    my $l = $doc->createTextNode(substr($oldData->getData, 0, $start));
	    my $m = substr($oldData->getData, $start, $end);
	    my $r = $doc->createTextNode(substr($oldData->getData, $start+$end));
	    $vessel->insertBefore($l, $oldData);
	    #$vessel->insertBefore($m, $oldData);
	    $vessel->insertBefore($r, $oldData);
	    $vessel->removeChild($oldData);
	    return [$r, undef, $m];
	} elsif ($xpointer =~ m/\G(\w+)\[(\d+)\]\/?/gcxsi) {
	    my ($name, $count) = ($1, $2);
	    my $in = $cur;
	    eval {
		for ($cur = $cur->getFirstChild; $count; $cur = $cur->getNextSibling) {
		    if ($cur) {
			if ($cur->getNodeType == ELEMENT_NODE) {
			    if ($cur->getNodeName eq $name) {
				if (--$count == 0) {
				    next SEGMENT;
				}
			    }
			}
		    } else {
			&throw(new W3C::Util::Exception(-message => "couldn't find $name $count in ".$in->toString));
			# return undef;
		    }
		}
	    }; if ($@) {
		&throw(new W3C::Util::CachedContextException(-str => $xpointer, -pos => $lastPos, 
							     -errorMessage => $@, -contextID => $self));
	    }
	} else {
	    my $substr = substr($xpointer, pos $xpointer);
	    my $msg = "unknown path segment: \"$substr\"";
	    $self->{PROXY}->log($ERROR, $msg);
	    &throw(new W3C::Util::Exception(-message =>  $msg));
	}
    }
    return [$cur, undef, undef];
}

sub cullText {
    my ($self, $doc, $length) = @_;
    my $ret = '';
    my $node = $doc->getFirstChild();
    while ($node && $length > 0) {
	if ($node->getNodeType() == $node->TEXT_NODE) {
	    my $data = $node->getData();
	    $data =~ s/\s+/ /g;
	    if ($data =~ m/^\s*$/) {
		if ($ret =~ m/\s$/) {
		} elsif ($ret =~ m/^$/) {
		} else {
		    $ret .= ' ';
		    $length--;
		}
	    } else {
		if (length($data) > $length) {
		    $data = substr($data, 0, $length);
		}
		$ret .= $data;
		$length -= length($data);
	    }
	} elsif ($node->getNodeType() == $node->ELEMENT_NODE && 
		 $node->getTagName() ne 'head') {
	    my $data = $self->cullText($node, $length);
	    $ret .= $data;
	    $length -= length($data);
	}
	$node = $node->getNextSibling();
    }
    return $ret;
}

package annoprox;
@annoprox::ISA = qw(W3C::Http::Proxy);
use Pod::Usage;
use Getopt::Long;

use W3C::Util::Exception qw(&throw &catch &DieHandler);
use W3C::Http::Proxy;
use W3C::Http::ProxySession qw($SUMMARY $ERROR $SOCKETS $OBJECTS $PROTOCOL $SELECT $DAEMON $PROXY_ACTION $DEBUG);
sub new {
    my ($proto, $annotationServerList, $annotationDbList, $annotationStyle, @rest) = @_;
    my $class = ref $proto || $proto;
    my $self = $class->SUPER::new(@rest);
    bless ($self, $class);
    $self->{Context} ||= new W3C::Rdf::RdfApp(-forceHost => undef, 
					      -forceDir => undef);
    
    $self->{AnnotationServerList} = $annotationServerList;
    $self->{AnnotationDbList} = $annotationDbList;
    $self->{AnnotationStyle} = $annotationStyle;
    $self->{AnnotationDbs} = [];
    return $self;
}

# Overloaded Proxy methods.

sub createSession {
    my ($self, $new, $ip) = @_;
    return new annoProxSession($self->{Context}, $self->{AnnotationStyle},  $self, $new, $ip);
}

sub perLoop {
    my ($self) = @_;
    while ($self->{HUPPED}) {
	$self->log($ERROR, 'HUPPED');
	$self->{HUPPED}--;
    }
}

my $PidFile = '/tmp/annoprox.pid';
my $ErrorLog = '/tmp/annoprox.err';
my $AccessLog = '/tmp/annoprox.acc';
my @DefaultQueryServers = ('http://annotest.w3.org/annotations', 
			   'http://annodev.w3.org/annotations', 
			   'http://iggy.w3.org/annotations');

sub forkParent {
    my ($self) = @_;
    $self->log($DAEMON, "serverpid: $self->{Pid}");
    $self->log($DAEMON, "  pidfile: $PidFile");
    $self->log($DAEMON, " errorlog: $ErrorLog");
    $self->log($DAEMON, "accesslog: $AccessLog");
}

sub forkChild {
    my ($self) = @_;
    open(STDIN,  "</dev/null") ||
	&throw(new W3C::Util::Exception(-message => "can't open /dev/null for read ($!)"));
    open(ACCESS, ">>$AccessLog") ||
	&throw(new W3C::Util::Exception(-message => "can't open $AccessLog for append ($!)"));
    open(STDERR, ">>$ErrorLog") ||
	&throw(new W3C::Util::Exception(-message => "can't open $ErrorLog for append ($!)"));
    select(STDERR); $|=1;
    select(ACCESS);

    # Replace the default Logger.
    $self->{LOGGER} = new W3C::Util::Logger(-handles => {$SUMMARY => \*STDERR, 
							 $PROTOCOL => undef, 
							 $SELECT => undef},
					    -default => \*STDERR);
}

sub beforeEventLoop {
    my ($self) = @_;
    foreach my $dbSpec (@{$self->{AnnotationDbList}}) {
	my $props = new W3C::Util::Properties($dbSpec);
	require W3C::Rdf::SqlDB;
	my $connection = new W3C::Rdf::SqlDB(-errorHandler => $self->{ERROR_HANDLER}, 
					      -lazyReification => 1, 
					      -properties => $props, 
					      -atomDictionary => $self->{Context}{-atomDictionary});
	push (@{$self->{AnnotationDbs}}, $connection);
    }
    $self->SUPER::beforeEventLoop();
}

sub getAnnotationServerList {
    my ($self) = @_;
    return @{$self->{AnnotationServerList}};
}

sub getDatabaseList {
    my ($self) = @_;
    return @{$self->{AnnotationDbs}};
}

sub parseHttpResponse {
    my ($self, $pText, $uri) = @_;
    $self->{Context}->parse($$pText, $uri, 'RDF/XML', 
			    $self->{Context}->getQueryHandler($self, 
							      {-uniqueResults => 1}));
}

# MAIN -- simple exception handler.
eval {
    my ($kill, $annotationStyle, $testUrl, @testHeaders, $userPassword, $forground, $help, $man);
    local($SIG{"__DIE__"}) = \&DieHandler;
    my $serverList = [];
    my $dbList = [];
    my $res = &GetOptions('server|s=s' => $serverList, 
			  'db|d=s' => $dbList, 
			  'port=i' => \$ListenPort, 
			  'listen|l=i' => \$ListenSockets, 
			  'style=s' => \$annotationStyle, 
			  'test|t=s' => \$testUrl, 
			  'header|h=s' => \@testHeaders, 
			  'encoding|e=s' => \$DefaultCharset, 
			  'auth|a=s' => \$userPassword, 
			  'whitespace|w' => \$CompressWhitespace, 
			  'kill' => \$kill, 
			  'help|?' => \$help, 
			  'man' => \$man, 
			  'X' => \$forground, 
			  );
    if ($kill) {
	&W3C::Http::Proxy::killProxy($PidFile);
	exit(0);
    }
    &pod2usage(-exitstatus => 0, -verbose => 1) if $help;
    &pod2usage(-exitstatus => 0, -verbose => 2) if $man;

    my $proxy = new annoprox($serverList, $dbList, $annotationStyle, undef, $ListenPort, $ListenSockets);
    $proxy->addHandler('text/html', \&annoProxSession::htmlHandler, 1, undef);

    if ($testUrl) {
	$proxy->beforeEventLoop();
	my $session = $proxy->createSession(undef, undef);
	my $reqStr = "GET $testUrl HTTP/1.1\n";
	my $defaultAccept = "Accept: text/html\n";
	my $defaultAuth = '';
	if ($userPassword) {
	    require MIME::Base64;
	    $defaultAuth = 'Authorization: Basic '.&MIME::Base64::encode_base64($userPassword)."\n";
	}
	foreach my $header (@testHeaders) {
	    $reqStr .= "$header\n";
	    if ($header =~ m/^Accept:/) {
		$defaultAccept = '';
	    } elsif ($header =~ m/^Authorization:/) {
		$defaultAuth = '';
	    }
	}
	$reqStr .= "$defaultAccept$defaultAuth\n"; # terminated head
	print $session->blockingRequest($reqStr);
	exit(0);
    }

    #use sigtrap qw(die normal-signals);
    $proxy->enableSignals(HUP => sub {$proxy->{HUPPED}++});
    $proxy->main($forground, $PidFile);
}; if ($@) {if (my $ex = &catch('W3C::Util::SignalException')) {
	exit(0);
    } elsif (my $ex = &catch('W3C::Util::Exception')) {
	die $ex->toString;
    } else {
	die $@;
    }
}

__END__

=head1 NAME

W3C::Annotations::annoprox - an HTTP proxy for decorating pages with annotations

=head1 SYNOPSIS

annoprox [options]

=head1 DESCRIPTION

C<annoprox> connects to an annotation server for each mime type that
it has a prayer of annotating. If it gets back an annotation type
that it understands, it will tweak the rendering to reflect that
annotation context and body.

This module is part of the W3C::Annotations CPAN module.

=head1 OPTIONS

=over 8

=item B<-s|server>

HTTP Annotea server to consult for annotations.

=item B<-d|db>

SQL database to consult for annotations.

=item B<-p|port>

Port number to listen on [8080].

=item B<-l|listen>

Number of sockets to listen with [5].

=item B<-s|style>

The CSS associated with the B<annotation> class.
ex. -style '.annotation { color: blue; background: grey; } .orphan { color: red; }'

=item B<-t|test>

URL to test for rendering. B<annoprox> will markup that document, print the results, and exit(0).

=item B<-h|header>

Add a header to be sent when requesting a B<test> URL. This may be invoked multiple times.

=item B<-e|encoding>

Default character encoding if none supplied with the proxied resource. e.g. utf-8 or iso-8859-1

=item B<-a|auth>

username:password to be used when requesting the B<test> URL.

=item B<-w|whitespace>

Flag to compress consequtive whitespaces in html//p prior to applying annotations. This is a work-around for an Amaya bug. Use it if you suspect that most of your annotations were generated by Amaya.

=item B<-kill>

Flag to kill the current server and exit.

=item B<-help>

Print a brief help message and exit.

=item B<-man>

Send the manual page to the $PAGER and exit.

=item B<-X>

Run in debugging mode (don't fork, log to screen).

=back

=head1 AUTHOR

Eric Prud'hommeaux <eric@w3.org>

=head1 SEE ALSO

L<W3C::Http::ProxySession>

=cut