#!/usr/bin/perl # Description: Perl CGI implementation of part of the OGC WFS # Output is based on output schema provided by Daniel Martin w/ the NOAA CSC DTL. # Author: John R. Ulmer (PSGS Contractor for NOAA CSC) # Alpha Date: 20070718 # Beta Date: Not Yet # Release Date: Not Yet # # General Flow: # 1- parse config parameters from config file (sub parse_config_file). # 2- parse and check user inputs (sub parse_checks_inputs). # 3- connect to DB # 4- construct SQL query # 5- run DB query and build memory structure # 6- disconnect DB # 7- cylce through memory structure building featureMembers # 8- send HTTP response #--------------------------------------------------------------------- # $Id: microWFS.cgi,v 1.3 2007/09/26 15:28:48 root Exp $ #--------------------------------------------------------------------- use strict; use CGI; #use CGI ":cgi"; use CGI::Carp qw(fatalsToBrowser warningsToBrowser); use DBI; $| = 1; # Turn on autoflush # Edit the following line to point at your config file. my $config_location = '/var/www/cgi-bin/microwfs/microWFSConf.xml'; my $run_date_time = getDateTime(); #Global vars my ($config, @db_row, $max_lat, $min_lat, $max_lon, $min_lon, $num_features, $feature_members, $dbhost, $dbname, $dbport, $dbuser, $dbpass, $logDir, $response, %valid_type_names,@platforms, $srsName, $sensorCodeSpace, $verticalDatumCodeSpace, $verticalPositionUom, $obsNameCodeSpace,$query_max_lon, $query_min_lat, $query_min_lon, $query_max_lat, $type_name, $start_time, $end_time); # instantiate CGI object my $cgi; $cgi = new CGI; # open/read config file &parse_config_file(); # open LOG file at location specified in config element open(LOG,">>$logDir/service.log") or die "Failed to open log file($logDir/microWFS.log), $!\n"; # parse and check input parameters. Must regex each input carefully to avoid # DB code insertion hack. All three user supplied inputs are controlled. &parse_check_inputs; =comment: debug when testing from command line - comment out parse_check_inputs $dbname = '/var/www/cgi-bin/microwfs/microwfs.db'; $query_min_lat = 22; $query_max_lat = 40; $query_min_lon = -85; $query_max_lon = -77; $start_time = '2008-01-01'; $end_time = '2008-03-04'; $type_name = 'windSpeed'; =cut #map $type_name to $query_m_type_id my ($query_m_type_id,$uom); if ($type_name eq 'windSpeed') { $query_m_type_id = 1; $uom = 'm_s-1'; } if ($type_name eq 'waterTemperature') { $query_m_type_id = 28; 'celsius'; } if ($type_name eq 'salinity') { $query_m_type_id = 6; 'psu'; } # It appears we have reasonably inputs # connect to DB and get data for specified constraints. #my $dbh = DBI->connect("dbi:SQLite:dbname=$dbname", "", "", { RaiseError => 1, AutoCommit => 1 }); my $dbh = DBI->connect("dbi:SQLite:dbname=$dbname", "", "", { RaiseError => 1, AutoCommit => 1 }); unless ($dbh) { gripe("Database Error", DBI->errstr); } #debug #print "Content-type: text/html\n\n"; #print "debug1"; #exit 0; # construct SQL statement to pull data from view =comment my $sql_statement = qq(select "platformName","obsName","obsDateTime","obsValue","stdUnitName", "latitude", "longitude","vPosition",'orgName',"orgID","platformID","vDatum" from "vwMicroWFS" where latitude >= $query_min_lat and latitude <= $query_max_lat and longitude >= $query_min_lon and longitude <= $query_max_lon and "obsDateTime" >= '$start_time' and "obsDateTime" <= '$end_time' and "obsName" = '$type_name' order by "platformID", "obsDateTime"); =cut #map $type_name to $query_m_type_id my ($query_m_type_id,$uom); if ($type_name eq 'windSpeed') { $query_m_type_id = 1; $uom = 'm_s-1'; } if ($type_name eq 'waterTemperature') { $query_m_type_id = 28; 'celsius'; } if ($type_name eq 'salinity') { $query_m_type_id = 6; 'psu'; } my $sql_statement = qq(select platform_handle,'$type_name',m_date,m_value,'$uom', m_lat,m_lon,m_z,'','',platform_handle,'MSL' from multi_obs where m_lat >= $query_min_lat and m_lat <= $query_max_lat and m_lon >= $query_min_lon and m_lon <= $query_max_lon and m_date >= '$start_time' and m_date <= '$end_time' and m_type_id = $query_m_type_id order by platform_handle,m_date); # while getting records, build a memory struct organized by platformName and vertical position # a unique platform+vPosition constitues a distinct featureMember in the output XML. my %data; print LOG "$run_date_time \n\tSQL: $sql_statement\n"; my $sth = $dbh->prepare($sql_statement) or gripe("Database Error", $dbh->errstr); if ($sth->execute()) { while (my @array = $sth->fetchrow_array()) { # print "DBArray: @array
\n"; #my $featureMemberKey = $array[0].'.'.$array[7]; # my $featureMemberKey = $array[0]; #ignore vPosition to identify separate featureMember my $array_ref = \@array; push @{$data{$featureMemberKey}}, $array_ref; } } else { gripe("Database Error", $dbh->errstr); } $sth->finish(); undef $sth; # to stop error "closing dbh with active statement handles" # http://rt.cpan.org/Ticket/Display.html?id=22688 $dbh->disconnect(); # Cycle through platformName+vPosition items and build XML featureMember elements. # keep track of min and max lat and lon for XML header chunk. foreach my $featureMemberKey (keys(%data)) { $num_features++; my $firstRow = 1; my $feature_xml; my @row_refs = $data{$featureMemberKey}; foreach my $rref (@row_refs) { my @station_row_refs = @$rref; foreach my $stat_row_ref (@station_row_refs) { my @db_row = @$stat_row_ref; # "42035","Wind direction","2007-06-01 12:50:00",100,"degree",29.22,-94.4,0, "National Data Buoy Center", 1, 5 # [ 0 ][ 1 ] [ 2 ] [3] [ 4 ][ 5 ][ 6 ][7] [ 8 ] [9] [10] # "platformName", "obsDateTime", stdUnitName longitude orgName orgID # obsName obsValue latitude vPosition platformID my $platform_sensor = groom_db_values($db_row[0]); if ($num_features == 1) { $max_lat = $db_row[5]; $min_lat = $db_row[5]; $max_lon = $db_row[6]; $min_lon = $db_row[6]; } else { if ($max_lat <= $db_row[5]) { $max_lat = $db_row[5]; } if ($min_lat >= $db_row[5]) { $min_lat = $db_row[5]; } if ($max_lon <= $db_row[6]) { $max_lon = $db_row[6]; } if ($min_lon >= $db_row[6]) { $min_lon = $db_row[6]; } } # construct date/time string in accordance with spec. # YYYY-MM-DDTHH:MM:SSZ where T is a delimiter and Z indicates # UTC time. my $obs_position = $db_row[5].' '.$db_row[6]; my $obs_date_time = $db_row[2]; $obs_date_time =~ s/\s/T/; $obs_date_time .= 'Z'; my $obs_units = "urn:x-noaa:def:noaa.units:2007a:$db_row[4]"; if ($firstRow == 1) { if ($db_row[7] = '-99999') { $db_row[7] = ''; } $feature_xml = qq( $platform_sensor $db_row[1] $db_row[11] $db_row[7] $obs_position ); $firstRow++; } # end if firstRow # create a datetime/observation chunk for each row from db. $feature_xml .= qq( $obs_date_time $db_row[3] ); } } # close newly built featuremember and add to featureMembers string. $feature_xml .= qq(\n \n ); $feature_members .= $feature_xml; } # print appropriate HTTP header and XML content print $cgi->header(-type=>'text/xml'), qq( $min_lat $min_lon $max_lat $max_lon ).$feature_members.qq(\n); exit 0; #------------------------------------------------------------------- # parse_config_file #-------------------------------------------------------------------- sub parse_config_file { # get configuration info open(CFG,"<$config_location") or die "Failed to open config file, $!\n"; while () { $config .= $_; } close CFG; # parse config parameters from config file contents if ($config =~ /\s*(.+)\s*<\/dbname>/gs) { $dbname = $1; } else { die "Failed to parse dbname from config.\n"; } if ($config =~ /\s*(.+)\s*<\/logDir>/gs) { $logDir = $1; } else { die "Failed to parse logDir from config.\n"; } if ($config =~ /\s*(.+)\s*<\/srsName>/gs) { $srsName = $1; } else { die "Failed to parse srsName from config.\n"; } if ($config =~ /\s*(.+)\s*<\/sensorCodeSpace>/gs) { $sensorCodeSpace = $1; } else { die "Failed to parse sensorCodeSpace from config.\n"; } if ($config =~ /\s*(.+)\s*<\/obsNameCodeSpace>/gs) { $obsNameCodeSpace = $1; } else { die "Failed to parse obsNameCodeSpace from config.\n"; } if ($config =~ /\s*(.+)\s*<\/verticalDatumCodeSpace>/gs) { $verticalDatumCodeSpace = $1; } else { die "Failed to parse verticalDatumCodeSpace from config.\n"; } if ($config =~ /\s*(.+)\s*<\/verticalPositionUom>/gs) { $verticalPositionUom = $1; } else { die "Failed to parse verticalPositionUom from config.\n"; } if ($config =~ /\s*(.+)\s*<\/TYPENAMES>/gs) { my $items = $1; while ($items =~ /(.+?)<\/item>/gs) { $valid_type_names{$1} = 1; } } else { die "Failed to parse valid property names from config.\n"; } } #-------------------------------------------------------------------- # parse_check_inputs #-------------------------------------------------------------------- sub parse_check_inputs { # Bounding Box my $bbox = $cgi->param('BBOX') || $cgi->param('bbox'); print ":$bbox:\n"; ($query_max_lon, $query_min_lat, $query_min_lon, $query_max_lat) = split /,\s*/, $bbox; if ($query_max_lon =~ /^-*\d+(\.\d+)*$/) { if (($query_max_lon < -180) || ($query_max_lon > 180)) { gripe("BBOX", "Bad Max Longitude: $query_max_lon."); } } else { gripe("BBOX", "Failed to parse max longitude from query string."); } if ($query_min_lon =~ /^-*\d+(\.\d+)*$/) { if (($query_min_lon < -180) || ($query_min_lon > 180)) { gripe("BBOX", "Bad Min Longitude: $query_min_lon."); } } else { gripe("BBOX", "Failed to parse min longitude from query string."); } if($query_max_lat =~ /^-*\d+(\.\d+)*$/){ if (($query_max_lat < -90) || ($query_max_lat > 90)) { gripe("BBOX", "Bad Max Latitude: $query_max_lat.");} } else { gripe("BBOX", "Failed to parse max latitude from query string."); } if ($query_min_lat =~ /^-*\d+(\.\d+)*$/){ if (($query_min_lat < -90) || ($query_min_lat > 90)) { gripe("BBOX", "Bad Min Latitude: $query_min_lat."); } } else { gripe("BBOX", "Failed to parse max latitude from query string."); } # Property Name $type_name = $cgi->param('TYPENAME') || $cgi->param('typename'); unless ($valid_type_names{$type_name} ) { my $names = join ', ', keys(%valid_type_names); gripe("TYPENAME", "Invalid TYPENAME($type_name). Must one of: $names."); } # Time start and stop my $time_range = $cgi->param('TIME') || $cgi->param('time'); ($start_time, $end_time) = split /,/, $time_range;# 2000-01-01 12:00 unless ($start_time =~ /^\d{4}-\d{2}-\d{2}T(\d{2}:\d{2}(:\d{2})*)Z$/) { gripe("TIME", "Invalid start time. Should be like YYYY-MM-DDTHH:MMZ or YYYY-MM-DDTHH:MM:SSZ."); } unless ($end_time =~ /^\d{4}-\d{2}-\d{2}T(\d{2}:\d{2}(:\d{2})*)Z$/) { gripe("TIME", "Invalid end time. Should be like YYYY-MM-DDTHH:MMZ or YYYY-MM-DDTHH:MM:SSZ."); } } #-------------------------------------------------------------------- # groom_db_values #-------------------------------------------------------------------- # Must make sure values coming from DB don't contain XML reserved chars sub groom_db_values { my $str = shift; $str =~ s//>/gs; $str =~ s/&/&/gs; $str =~ s/"/"/gs; $str =~ s/'/'/gs; return ($str); } #-------------------------------------------------------------------- # gripe #-------------------------------------------------------------------- sub gripe { my ($locator, $ExceptionText) = @_; print LOG "$run_date_time: --ERROR-- $locator, $ExceptionText\n"; print $cgi->header(-type=>'text/xml'), #print $cgi->header(-type=>'text/html'), qq( ); exit; } #-------------------------------------------------------------------- # getDateTime #-------------------------------------------------------------------- sub getDateTime { my @dt = localtime; my $yr = $dt[5]+= 1900; my $mo = $dt[4] += 1; my $da = $dt[3]; my $hr = $dt[2]; my $mn = $dt[1]; my $sc = $dt[0]; if (length($mo) == 1) { $mo = '0'.$mo; } if (length($da) == 1) { $da = '0'.$da; } if (length($hr) == 1) { $hr = '0'.$hr; } if (length($mn) == 1) { $mn = '0'.$mn; } if (length($sc) == 1) { $sc = '0'.$sc; } return("$yr$mo$da $hr:$mn:$sc"); } =pod =head2 DESCRIPTION This is a Common Gateway Interface (CGI) web application written in Perl. It is a simple implementation of the Open Geospatial Consortium's Web Feature Service (WFS). The output is GML Simple Feature Profile complaint. The intended use of this code is to exercise the use of the OGC WFS with the GML Simple Feature Profile to handle time series data. This application was written by the NOAA Coastal Services Center Data Transport Laboratory (DTL)as part of DTL Project 4. See http://www.csc.noaa.gov/DTL/. This code is a REST based XML data service. The general flow is: 1. Parse config parameters from config file (sub parse_config_file). 2. parse and check user inputs (sub parse_checks_inputs). 3. connect to DB 4. construct SQL query 5. run DB query and build memory structure 6. disconnect DB 7. cylce through memory structure building featureMembers 8. send HTTP response It accepts a few input fields in an HTTP Get. The required input fields are: 1. BBOX (-93.00,29.00,-95.00,30.00) 2. TIME (2007-06-01T12:00Z,2007-06-01T14:00Z) 3. TYPENAME (salinity, waterTemperature) The service returns either a valid data reponse expressed as GML Simple Feature Profile XML or a WFS error response. Note that there is only one method provided, 'getFeature'. This is an incomplete WFS implementation. No 'getCapabilities' method is provided. A few global configuration parameters are stored in a configuration file. They include: 1. dbname - name of the db to which to connect. 2. logDir - location for the application log 3. TYPENAMES - an array of valid parameter names that the service should handle. This is useful in checking requests to guard against db code insertion hacks. =head2 REQUIREMENTS This code was developed on Red Hat Linux and interfaces with a PostgreSQL database server. It has not been tested on other platforms. However, the code is fairly generic Perl/CGI code and the database interactions are simple and generic using the typical Perl DBI::DBD approach. To run this application you must have: 1. recent Linux OS or equivalent (Use of another OS may require modification of the code.) 2. An Apache HTTP server or equivalent. There is no known reason this code would not run on any HTTP server that supports CGI applications and Perl. 3. A PostgreSQL instance or equivalent(SQLite in this case) that is supported by the Perl DBI::DBD architecture. 4. Appropriate Perl DBD driver to talk to your database server. 5. A database view/select compliant with the view specification provided by CSC DTL Proj4. =head2 SETUP 1. Place this code (microWFS.cgi) in the 'cgi-bin' area of your web server. 2. Modify the first line of this file to point at the Perl interpreter on your system. 3. Set the execute bit on that file so that the web server process can execute it. 4. Put the configuration file (microWFSConf.xml) in an appropriate place where your web server can 'see' it. 5. Edit the configuration file location variable to point at your microWFSCon.xml file. The variable is near the top of the code and looks like: my $config_location = '/var/www/cgi-bin/microwfs/beta/microWFSConf.xml'; 6. Edit the config file with the connection specifics for your database server. To use a database other than PostgreSQL, make sure the necessary Perl DBD driver is installed and adjust the connection statement near the top of the code appropriately. Some drivers use slightly different attributes and syntaxes in their connection statements. See the documentation provided with your driver for details. The connection statement is on or near line 55 and looks like: my $dbh = DBI->connect("dbi:..... 7. Create a database view compliant with the specifications provided by the DTL Project4. See http://www.csc.noaa.gov/DTL/.