<%

'***********************************************************************

' UNIVERSITY OF FLORIDA - INSTITUTE OF FOOD AND AGRICULTURAL SCIENCES

'***********************************************************************

'DEPARTMENT: Information Technologies

'SYSTEM NAME: FAWN

'PROGRAM NAME: <FAWN root>/scripts/fawndataserver.asp

'AUTHOR NAME: ANDY KING

'CREATION DATE: 12/11/2002

'VERSION: 1.0

'DESCRIPTION: Gateway to FAWN data. Abstraction layer for FAWN data model.

' Accepts SQL query for execution.

'

' syntax:

' fawndataserver.asp?sql=select ...&Of=...

' the sql= is required to execute submitted query. If not,

' fawndataserver.asp returns the latest weather observations

' for all stations.

' the Of= is output format. The choice is text, xml92 or xmlRs. Default is xml.

'xml92 is ordinary xml format, xmlRs is ado persist xml format

'CHANGES:

' Date Description Developer

' 2/26/03 added comment block lak

' 1/21/04 added xml output Jin Zhong Wu

'***********************************************************************

On Error Resume Next

const strSeparator = ","

Dim cn

Dim rs

Dim strSQL

Dim i

Dim queryOf

Dim MyError

MyError=0

'Response.ContentType="text/html"

' check for query passed in

queryOf= Request.QueryString("of")

strSQL = Request.QueryString("sql")

if UCase(queryOf)="XML" Then

queryOf="XML92"

End if

if UCase(queryOf)="XML92" Or UCase(queryOf)="XMLRS" then

Response.ContentType="text/xml"

Response.Write "<?xml version='1.0' encoding='ISO-8859-1'?>" & vbCRLF

Response.Write vbCRLF

Response.Write "<!-- Reporting from Fawn -->" & vbCRLF

Response.Write vbCRLF

set xmlDoc = Server.CreateObject("MSXML2.DOMDocument.3.0")

Set RootElement = xmlDoc.createElement("Observations")

RootElement.setAttribute "UnitSystem", "SI"

RootElement.setAttribute "TimeZone", "UTC"

xmlDoc.appendChild RootElement

Else

Response.ContentType="text/html"

End if

if UCase(strSQL) = "SELECT * FROM WEATHER" then

if UCase(queryOf)="TEXT" Or UCase(queryOf)="" then

Response.Write "FAWNDATASERVER ERROR " & now & ": LONG RUNNING QUERY" & vbNewline

Response.Write "CONTACT FAWN DATABASE ADMINISTRATOR for dataset at FAWNADMIN@mail.ifas.ufl.edu" & vbNewline

elseif UCase(queryOf)="XML92" Or UCase(queryOf)="XMLRS" then

MyError = 1000-1

Set ErrorElement = xmlDoc.createElement("Error")

ErrorElement.setAttribute "Number", MyError

ErrorElement.setAttribute "Name", "FAWNDATASERVER ERROR: Long Running Query"

ErrorElement.setAttribute "Description", "CONTACT FAWN DATABASE ADMINISTRATOR for dataset at FAWNADMIN@mail.ifas.ufl.edu"

ErrorElement.setAttribute "DateTime", now

ErrorElement.setAttribute "Logged", "No"

RootElement.appendChild ErrorElement

end if

else

'create connection

Set cn = Server.CreateObject("ADODB.Connection")

'if can not create connection, return error msg and quit

if isEmpty(cn) then

if UCase(queryOf)="TEXT" Or UCase(queryOf)="" then

Response.Write "FAWNDATASERVER ERROR " & now & ": Server unable to create database connection." & vbNewline

elseif UCase(queryOf)="XML92" Or UCase(queryOf)="XMLRS" then

MyError=1000-2

Set ErrorElement = xmlDoc.createElement("Error")

ErrorElement.setAttribute "Number", MyError

ErrorElement.setAttribute "Name", "FAWNDATASERVER ERROR: UnableCreateDB"

ErrorElement.setAttribute "Description", "Server unable to create DB"

ErrorElement.setAttribute "DateTime", now

ErrorElement.setAttribute "Logged", "No"

RootElement.appendChild ErrorElement

End if

else 'open connection

cn.Open "PROVIDER=SQLOLEDB;DATA SOURCE=SRVIPSST;DATABASE=FAWN;Trusted_Connection=YES;UID=fawnuser;PWD=fawnuser"

'if can not open connection, return error and quit

if Err.Number > 0 then

if UCase(queryOf)="TEXT" Or UCase(queryOf)="" then

Response.Write "FAWNDATASERVER ERROR " & now & ": Unable to open database connection." & vbNewline

elseif UCase(queryOf)="XML92" Or UCase(queryOf)="XMLRS" then

MyError=1000-3

Set ErrorElement = xmlDoc.createElement("Error")

ErrorElement.setAttribute "Number", MyError

ErrorElement.setAttribute "Name", "FAWNDATASERVER ERROR: UnableOpeneDBConn"

ErrorElement.setAttribute "Description", "Unable to open DB connection"

ErrorElement.setAttribute "DateTime", now

ErrorElement.setAttribute "Logged", "No"

RootElement.appendChild ErrorElement

End if

for i = 0 to cn.Errors.Count - 1

if UCase(queryOf)="TEXT" or UCase(queryOf)="" then

Response.write cn.Errors(i).description & vbNewline

elseif UCase(queryOf)="XML92" Or UCase(queryOf)="XMLRS" then

MyError=i

Set ErrorElement = xmlDoc.createElement("Error")

ErrorElement.setAttribute "Number", MyError

ErrorElement.setAttribute "Name", "DBConn Error"

ErrorElement.setAttribute "Description", cn.Errors(i).description

ErrorElement.setAttribute "DateTime", now

ErrorElement.setAttribute "Logged", "No"

RootElement.appendChild ErrorElement

end if

next

else 'create result set

Set rs = Server.CreateObject("ADODB.Recordset")

' make sure result set is created

if isNull(rs) then

if UCase(queryOf)="TEXT" or UCase(queryOf)="" then

Response.Write "FAWNDATASERVER ERROR " & now & ": Server unable to create result set." & vbNewline

elseif UCase(queryOf)="XML92" Or UCase(queryOf)="XMLRS" then

MyError=1000-3

Set ErrorElement = xmlDoc.createElement("Error")

ErrorElement.setAttribute "Number", MyError

ErrorElement.setAttribute "Name", "FAWNDATASERVER ERROR"

ErrorElement.setAttribute "Description", "Unable to create RS"

ErrorElement.setAttribute "DateTime", now

ErrorElement.setAttribute "Logged", "No"

RootElement.appendChild ErrorElement

end if

else 'check for long query

'if (InStr(1,UCase(strSQL),"SELECT * FROM WEATHER",1) > 0) then 'someone is requesting all fawn data

' Response.Write "FAWNDATASERVER ERROR " & now & ": LONG RUNNING QUERY" & vbNewline

' Response.Write "CONTACT FAWN DATABASE ADMINISTRATOR for dataset at FAWNADMIN@mail.ifas.ufl.edu" & vbNewline

'else

' if no query specified, return default: latest observations

if (strSQL = "") then

strSQL = "select id,"

strSQL = strSQL & "(select location from locations where locid=id) as 'name',"

strSQL = strSQL & "datetime,floor(totalrad) as 'radiation',"

strSQL = strSQL & "CAST((soiltempavg*100)/100 as Decimal(9,2)) as 'soilTemperature',"

strSQL = strSQL & "CAST((airtemp1*100)/100 as Decimal(9,2)) as 'airTemperature60cm',"

strSQL = strSQL & "CAST((airtemp9*100)/100 as Decimal(9,2)) as 'airTemperature2cm',"

strSQL = strSQL & "CAST((airtemp15*100)/100 as Decimal(9,2)) as 'airTemperature10cm',"

strSQL = strSQL & "CAST((relhumavg*100)/100 as Decimal(9,2)) as 'relativeHumidity',"

strSQL = strSQL & "CAST((windspeed) as Decimal(9,2)) as 'windSpeed',"

strSQL = strSQL & "CAST((winddir) as Decimal(9,2)) as 'windDirection',"

strSQL = strSQL & "CAST((rainfall*100)/100 as Decimal(9,2)) as 'rainfall',"

strSQL = strSQL & "CAST((dewpoint*100)/100 as Decimal(9,2)) as 'dewpoint'"

strSQL = strSQL & "from weather_latest"

end if

rs.Open strSQL, cn

'make sure query ran successfully

if cn.Errors.Count > 0 then

if UCase(queryOf)="TEXT" or UCase(queryOf)="" then

Response.Write "FAWNDATASERVER ERROR " & now & ": SQL Execution Error" & vbNewline

elseif UCase(queryOf)="XML92" Or UCase(queryOf)="XMLRS" then

MyError=1000-4

Set ErrorElement = xmlDoc.createElement("Error")

ErrorElement.setAttribute "Number", MyError

ErrorElement.setAttribute "Name", "FAWNDATASERVER ERROR"

ErrorElement.setAttribute "Description", "SQL Execution Error"

ErrorElement.setAttribute "DateTime", now

ErrorElement.setAttribute "Logged", "No"

RootElement.appendChild ErrorElement

end if

for i = 0 to cn.Errors.Count - 1

if UCase(queryOf)="TEXT" or UCase(queryOf)="" then

Response.write cn.Errors(i).description & vbNewline

elseif UCase(queryOf)="XML92" Or UCase(queryOf)="XMLRS" then

MyError = 100 + i

Set ErrorElement = xmlDoc.createElement("Error")

ErrorElement.setAttribute "Number", MyError

ErrorElement.setAttribute "Name", "SQL Execution Erro"

ErrorElement.setAttribute "Description", cn.Errors(i).description

ErrorElement.setAttribute "DateTime", now

ErrorElement.setAttribute "Logged", "No"

RootElement.appendChild ErrorElement

end if

next

'end if

else 'return the data retrieved

IF UCase(queryOf)="XMLRS" Then

If MyError=0 Then

'Response.ContentType="text/xml"

'Response.Write "<?xml version='1.0' encoding='ISO-8859-1'?>" & vbCRLF

rs.Save Response, 1

End if

End if

IF UCase(queryOf)="XML92" Then

IF MyError = 0 Then

Set ErrorElement = xmlDoc.createElement("Error")

ErrorElement.setAttribute "Number", 000

ErrorElement.setAttribute "Name", "No Error"

ErrorElement.setAttribute "Description",""

ErrorElement.setAttribute "DateTime", now

ErrorElement.setAttribute "Logged", "No"

RootElement.appendChild ErrorElement

End If

Do While Not rs.EOF

'if not rs.EOF then

Set DataElement = xmlDoc.createElement("Observation")

RootElement.appendChild DataElement

set fields = rs.Fields

i = 0

For Each field In fields

DataElement.setAttribute field.name, rs.Fields(i)

i = i + 1

Next

rs.MoveNext

Loop

Set CommentsElement = xmlDoc.createElement("COMMENTS")

RootElement.appendChild CommentsElement

CommentsElement.setAttribute "Test", "Fawn Test"

Elseif UCase(queryOf)="TEXT" Or UCase(queryOf)="" Then

'Response.ContentType="text/html"

' write the column names

if not rs.EOF then

Response.write rs.Fields(0).Name

For i=1 to rs.Fields.Count-1

Response.write strSeparator & rs.Fields(i).Name

Next

Response.write vbNewline

end if

' write the data

While NOT rs.EOF

Response.write rs.Fields(0)

For i=1 to rs.Fields.Count-1

response.write strSeparator & rs.Fields(i)

Next

Response.write vbNewline

rs.MoveNext

Wend

End If

end if 'SQL exectuion

'end if 'long query requested

end if 'isEmpty(rs)

' tidy up

rs.Close

cn.Close

Set rs = Nothing

Set cn = Nothing

end if 'open connection

end if 'isEmpty(cn)

end if

IF (UCase(queryOf)="XML92") Or ( (UCase(queryOf)="XMLRS") And (MyError>0)) Then

xmlDoc.async = False

xmlDoc.Save (Response)

End if

%>