#!/usr/bin/perl 
=head1 NAME

@SectionPush(Annotation Documents)
The simple Annotation Server stores Annotation Documents in flat files. 

@SectionPush(Root Directory)
@Var(\$AnnRoot)
is the name of the root directory in which the files are stored. This directory must be
writable by the user that the web server runs under.
=cut
$AnnRoot = "/tmp/Annotations";
=head1 NAME

@Section(Document ID)
Each document will be identified by a <i>Document ID</i>. For the purposes of this sample,
the Document ID is simply a unique string. 

@DefPerlFunc{adFileName(\$id)}
Return the filename of the Annotation Document with the Document ID @Var(\$id).
=cut
sub adFileName { my ($id) = @_;

	# Remove unsafe characters from the ID
	$id =~ s/[^a-zA-Z0-9\.,_]/_/g;

	# Map it to a file in the annotation directory
	qq{$AnnRoot/$id.data};
}
=head1 NAME
@DefPerlEnd

@Section(Loading)
To load an Annotation Document, we simply map the ID to a file and load
the contents of the file.

@DefPerlFunc{adLoad(\$id)}
Return the annotation data for Document ID @Var(\$id).
=cut
sub adLoad { my ($id) = @_;

	# If the file can not be opened, return an empty annotation document.
	if(!open(FILE, adFileName($id))) { 
		return qq{<?xml version="1.0" ?><annotations/>}; 
	}

	# Read the file in binary mode under a non-exclusive lock
    binmode(FILE);
    flock(FILE, 1);
    my $data = join('', <FILE>);
	flock(FILE, 8);

	# Close the file and return the data
    close(FILE);
    $data;
}
=head1 NAME
@DefPerlEnd

@Section(Storing)
To store an Annotation Document, we simply map the ID to a file and save
the data to the file.

@DefPerlFunc{adStore(\$id, \$xml)}
Save @Var(\$xml) as the annotation data for the Document ID @Var(\$id).
Returns 1 if the operation is successful; otherwise @Var(undef).
=cut
sub adStore { my ($id, $xml) = @_;

	# If the file can not be opened for writing, return an error.
	if(!open(FILE, ">".adFileName($id))) { return undef; }

 	# Write the file in binary mode under an exclusive lock
    binmode(FILE);
    flock(FILE, 2);
	print FILE $xml;
	flock(FILE, 8);

	# Close the file and return no error
	close(FILE);
    1;
}
=head1 NAME
@DefPerlEnd
@SectionPop

@Section(CGI Interface)
The following utilities are used to interface with the CGI host. 

@SectionPush(Parsing CGI Parameters)
Per the CGI specification, the request URL parameters are
supplied in @Var(\$ENV{QUERY_STRING}).
@DefPerlFunc{cgiParse()}
Parse the CGI parameters and store the name-value pairs into the @Var(CGI) hash.
=cut

sub cgiParse {
	# The name/value pairs are separated by '&'.
	foreach(split(/&/, $ENV{QUERY_STRING})) {
		# Convert plus's to spaces
		s/\+/ /g; 

		# Split into name and value. The two fields are separated by '='.
		local($key, $val) = split(/=/,$_,2); # splits on the first =.
		
		# Convert hex escapes (&#37;XX) to alphanumeric
		$key =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
		$val =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
	
		# Associate key and value
		$CGI{$key} = $val;
	}
}
=head1 NAME
@DefPerlEnd

@Section(Generating a Response)

@DefPerlFunc{cgiRespond(\$code, \$mime, \$text)}
Generate the HTTP response to a request. The response specifies
a status code of @Var(\$code). The response data has a mime type
of @Var(\$mime). @Var(\$text) is the data to send with the response.
=cut

sub cgiRespond { my ($code, $mime, $text) = @_; 
	my $len = length($text);
	print qq{Content-Type: $mime
Content-Length: $len
Status: $code

$text
};
}

=head1 NAME
@DefPerlEnd
@SectionPop
@Section(The Server)
The server merely parses the CGI parameters and reads or writes the
specified annotations, depending on whether the request is a <b>GET</b>
or a <b>POST</b>.
=cut

# The Document ID is specified as the @Var(ID) CGI parameter.  Parse the CGI parameters into the @Var(CGI) hash
cgiParse();

# If they did not specify an ID, return an error
if(!$CGI{ID}) { 
	cgiRespond(400, "text/plain", "<error>There was no document specified</error>");
}

# If this is not a POST, load the XML data
elsif($ENV{REQUEST_METHOD} ne "POST") { 
	cgiRespond(200, "text/xml", adLoad($CGI{ID}));
}

# This is a POST operation. Store the XML data
else {
	# Get the data to store
	my $xml; 
	read(STDIN, $xml, $ENV{'CONTENT_LENGTH'}); 

	# Store the new annotation data
	my $worked = adStore($CGI{ID}, $xml);
	if(!$worked) { cgiRespond(503, qq{<error>Unable to update annotations</error>}); }
	else { cgiRespond(200, "text/plain", "Update succeeded"); }
}
=head1 NAME
@DefPerlEnd

=cut