#!/usr/bin/perl
use strict; 
use CGI qw(:standard);
use LWP::Simple qw(!head); # Note: both LWP and CGI have head methods, so this avoids warnings
use XML::LibXML;

# No system buffering
$! = 1;
# The GoMOOS GetCapabilities URL
my $url = 'http://www.gomoos.org/cgi-bin/sos/oostethys_sos.cgi?request=GetCapabilities';
# Default offering
my $offering = 'A01';
# Default observerdProperty
my $observedProperty = 'sea_water_temperature';

# Some simple styles 
my $styles = <<EOS;
p, th, td, ul, ol, dl, span, div
{ 
	font-family: Verdana, Helvetica, Arial, sans-serif;
	font-size: 12px;
	color: #333;
	text-align: left;
}
.error
{
	color: #c00;
}
EOS


my $q = new CGI;

our $parser = XML::LibXML->new();

my $mode = '';

# Check any query string input
$mode = $q->param('mode') if ( $q->param('mode') );
$offering = $q->param('offering') if ( $q->param('offering') );
$observedProperty = $q->param('observedProperty') if ( $q->param('observedProperty') );

my $title = "OIE SOS Client Tests<br>Latest Sea Water Temperature Observations from GoMOOS Platform $offering";


print $q->header(
		-type => 'text/html',
);

print $q->start_html(
		-title => $title,
		-author => 'eric@gomoos.org',
		-style => {'code' => $styles},
);

print $q->h2("$title");
print $q->h3("See also: OOSTethsys OGC Ocean Interoperability <a target=\"_blank\" href=\"http://www.oostethys.org/ogc-oceans-interoperability-experiment/experiment-1\"> Experiment #1 </a>");

my $cap_results = GetCapabilities($url, $offering, $observedProperty);
# returns a HASH or an error string
if( ref($cap_results) eq 'HASH')
{
	print $q->h4("Latest Water Temperature Observations for Platform $offering");
	print '<ul>';
	foreach my $obsprop (keys %{ $cap_results->{$offering} } )
	{
		print "<li> <b>XML</b> <a href=\"$cap_results->{$offering}->{$obsprop}\" target=\"_blank\">$cap_results->{$offering}->{$obsprop}</a></li>\n";
		print "<li><a href=\"/cgi-bin/oie_sos_latest_obs.cgi?offering=$offering&observedProperty=$obsprop&mode=GetLatestObs\">Get Latest Observation</a></li>\n";
	}
	print '</ul>';
}
else
{
	print "<p class=\"error\">$cap_results</p>";
}

if($mode eq 'GetLatestObs'){
	print "<hr>\n";
	# Note we are using the defaults (A01 and sea_water_temperature) rather than checking 
	# what keys %cap_results actually contains.
	my $url = $cap_results->{$offering}->{$observedProperty};
	my $obs_results =  getLatestObservation($url);
	if ($obs_results =~ /Exception/ or $obs_results =~ /Unavailable/)
	{
		print "<p class=\"error\">$obs_results</p>\n"
	}else
	{
		print $obs_results;
	}
}

print "<hr>\n";
print '<ul>';
	print "<li><a href=\"/testbed/oie/oie_sos_latest_obs.about.html\" target=\"_blank\">About this script</a></li>\n";
	print "<li><a href=\"/testbed/oie/oie_sos_latest_obs.cgi\" target=\"_blank\">Download source</a></li>\n";
print '</ul>';

print $q->end_html;

exit;

###################################
# GetCapabilities:
#	* Uses LWP to retrieve the GetCapabilities XML then checks for errors
#	* Uses LibXML and XPathContext to parse the returned XML independent of the servers namespace prefixes
#	* Use XPath queries to retrieve the GetObservation URLs for the passed $this_offering 
#	* and for the passed $this_property
###################################
sub GetCapabilities
{
	my ($url, $this_offering, $this_property) = @_;

	my $results = '';
	my $cap_xml = LWP::Simple::get($url);

	# Check for Exceptions
	my $error = '';
	if(!$cap_xml)
	{
		$error .= "SOS Unavailable\n";
		return $error;
	}
	if($cap_xml =~ /<ExceptionReport/i )
	{
		$cap_xml =~ s/</&lt;/g;
		$cap_xml =~ s/>/&gt;/g;
		$error .= "$cap_xml\n";
		return $error;
	}

	my $sos = '';
	eval {
		$sos = $parser->parse_string($cap_xml);
	};
	if($@)
	{
		$error .= "$@";
		return $error;
	}
	my $xc = XML::LibXML::XPathContext->new($sos);
	$xc->registerNs( 'swe' => 'http://www.opengis.net/swe/0');
	$xc->registerNs( 'gml' => 'http://www.opengis.net/gml');
	$xc->registerNs( 'sos' => 'http://www.opengis.net/sos/0');
	$xc->registerNs( 'om' => 'http://www.opengis.net/om');
	$xc->registerNs( 'ows' => 'http://www.opengeospatial.net/ows');
	$xc->registerNs( 'xlink' => 'http://www.w3.org/1999/xlink');

	my %obs_urls = ();
	my $node = ( $xc->findnodes('//sos:Capabilities/ows:OperationsMetadata/ows:Operation[@name="GetObservation"]') )[0];
	my $get = ($xc->findnodes('ows:DCP/ows:HTTP/ows:Get', $node))[0];
	my $obs_url = $get->getAttribute('xlink:href');
	# Make sure obs_url has a query string
	if($obs_url =~ /\?/)
	{
		$obs_url .= 'request=GetObservation';
	}
	else
	{
		$obs_url .= '?request=GetObservation';
	}
	foreach my $node ( $xc->findnodes('//sos:Contents/sos:ObservationOfferingList/sos:ObservationOffering') )
	{
		my $offering = $node->getAttribute('gml:id');
		next if $offering ne $this_offering;
		my ($obsProp_uri, $obsProp);
		foreach my $node2 ( $xc->findnodes('sos:observedProperty', $node) )
		{
			($obsProp_uri, $obsProp) = split('#', $node2->getAttribute('xlink:href') );
			next if ( $obsProp ne $this_property);
			$obs_urls{$offering}{$obsProp} = $obs_url . '&offering=' . $offering . '&observedProperty=' . $obsProp;
		}
	}

	return \%obs_urls;
}

####################################
# getLatestObservation
####################################
sub getLatestObservation
{
	my ($obsurl) = @_;
	my $results = '';
	my $obs_xml = LWP::Simple::get($obsurl);
	my $error  = '';

	if(!$obs_xml){
		$error .= 'SOS Unavailable';
		return $error;
	}
	# Would be nice to display some error message
	if($obs_xml =~ /<ExceptionReport/i ){
		$obs_xml =~ s/</&lt;/g;
		$obs_xml =~ s/>/&gt;/g;
		$error .= "$obs_xml";
		return $error;
	}

	my $obs = '';
	eval {
		$obs = $parser->parse_string($obs_xml);
	};
	if($@)
	{
		$error .= "$@";
		return $error;
	}

	my $xc = XML::LibXML::XPathContext->new($obs);

	my $sos_title = $xc->find('//gml:name')->string_value;
	if(not $sos_title){
		$sos_title = $xc->find('//gml:description')->string_value;
	}

	# We don't need units for these elements
	my @ignore_uom = qw(time TIME Time latitude LATITUDE Latitude longitude LONGITUDE Longitude );
	my @fields = ();
	my @uoms = ();
	my $uom;
	foreach my $node ( $xc->findnodes('//swe:DataRecord/swe:field'))
	{
		$uom = '';
		my $name = $node->getAttribute('name');
		push @fields, ucfirst($name);
		my @splitvals = ('');
		if(not grep( /^$name$/, @ignore_uom)){
			my $node2 = ( $xc->findnodes('swe:Quantity/swe:uom', $node))[0];
			if($node2->getAttribute('code')){
				$uom = $node2->getAttribute('code');
			}else{
				$uom = $node2->getAttribute('xlink:href');
			}
			# The default case
			push @splitvals, $uom;
			if($uom =~ /#/){
				@splitvals = split('#', $uom);
			}elsif ($uom =~ /:/){
				@splitvals = split(':', $uom);
			}
		}
		push @uoms, $splitvals[$#splitvals];
	}

	return $results if not @fields;

	$results .= '<table border="1" cellpadding="3" cellspacing="3">' . "\n";
	
	my $enc =  ($xc->findnodes('//swe:encoding/swe:AsciiBlock'))[0];
	my $tokenSeparator = $enc->getAttribute('tokenSeparator');
	my $tupleSeparator = $enc->getAttribute('blockSeparator');

	# Escape the separators before passing to split in case they passed a special RE char, e.g. '|'
	my $pat = "\\" . $tupleSeparator;
	my @tuples = split( /$pat/, $xc->find("//om:result")->string_value );
	$pat = "\\" . $tokenSeparator;

	return '' if not @tuples;

	my $fld_num = @fields;
	$fld_num++;  # we add units at the end
	$results .= "<tr><th colspan='$fld_num'>$sos_title Latest Observations</th></tr>\n";

	$results .= '<tr>';
	foreach my $field (@fields){
		$results .= "<th>$field</th>";
	}
	$results .= '</tr>';
	foreach my $line (@tuples){
		$results.= '<tr>';
		my @vals = split(/$pat/, $line);
		foreach my $i (0..$#vals){
			$results .= "<td>$vals[$i] $uoms[$i]</td>";
		}
		$results .= '</tr>';
	}

	$results .= "</table>\n";
	return $results;
} # end latest_obs subroutine