Nothing
############################################################################## #
# Copyright (C) 2019 by 52 North #
# Initiative for Geospatial Open Source Software GmbH #
# #
# Contact: Andreas Wytzisk #
# 52 North Initiative for Geospatial Open Source Software GmbH #
# Martin-Luther-King-Weg 24 #
# 48155 Muenster, Germany #
# info@52north.org #
# #
# This program is free software; you can redistribute and/or modify it under #
# the terms of the GNU General Public License version 2 as published by the #
# Free Software Foundation. #
# #
# This program is distributed WITHOUT ANY WARRANTY; even without the implied #
# WARRANTY OF MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU #
# General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License along with #
# this program (see gpl-2.0.txt). If not, write to the Free Software #
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA or #
# visit the Free Software Foundation web page, http://www.fsf.org. #
# #
# Author: Daniel Nuest (daniel.nuest@uni-muenster.de) #
# Created: 2010-09-17 #
# Project: sos4R - https://github.com/52North/sos4R #
# #
############################################################################## #
#
# samplingTime is the only time that's really used, so set it as default
#
TM_After <- function(propertyName = sosDefaultTempOpPropertyName, time) {
new("TM_After", propertyName = propertyName, time = time)
}
TM_Before <- function(propertyName = sosDefaultTempOpPropertyName, time) {
new("TM_Before", propertyName = propertyName, time = time)
}
TM_During <- function(propertyName = sosDefaultTempOpPropertyName, time) {
new("TM_During", propertyName = propertyName, time = time)
}
TM_Equals <- function(propertyName = sosDefaultTempOpPropertyName, time) {
new("TM_Equals", propertyName = propertyName, time = time)
}
#
# constructor functins ----
#
OgcBBOX <- function(propertyName = sosDefaultSpatialOpPropertyName,
envelope) {
new("OgcBBOX", propertyName = propertyName, envelope = envelope)
}
OgcContains <- function(propertyName = sosDefaultSpatialOpPropertyName,
geometry = NULL, envelope = NULL) {
new("OgcContains", propertyName = propertyName, geometry = geometry,
envelope = envelope)
}
OgcIntersects <- function(propertyName = sosDefaultSpatialOpPropertyName,
geometry = NULL, envelope = NULL) {
new("OgcIntersects", propertyName = propertyName, geometry = geometry,
envelope = envelope)
}
OgcOverlaps <- function(propertyName = sosDefaultSpatialOpPropertyName,
geometry = NULL, envelope = NULL) {
new("OgcOverlaps", propertyName = propertyName, geometry = geometry,
envelope = envelope)
}
#
# encoding functions ----
#
setMethod(f = "encodeXML",
signature = signature(obj = "TM_After", sos = "SOS"),
definition = function(obj, sos, verbose) {
if (verbose) cat("[encodeXML] TM_After with", toString(obj@time))
.encoded <- .encodeTM(nodeName = ogcTempOpTMAfterName,
propertyName = obj@propertyName, time = obj@time,
sos = sos, verbose = verbose)
return(.encoded)
}
)
setMethod(f = "encodeXML",
signature = signature(obj = "TM_Before", sos = "SOS"),
definition = function(obj, sos, verbose) {
if (verbose) cat("[encodeXML] TM_After with", toString(obj@time),
"\n")
.encoded <- .encodeTM(nodeName = ogcTempOpTMBeforeName,
propertyName = obj@propertyName, time = obj@time,
sos = sos, verbose = verbose)
return(.encoded)
}
)
setMethod(f = "encodeXML",
signature = signature(obj = "TM_During", sos = "SOS"),
definition = function(obj, sos, verbose) {
if (verbose) cat("[encodeXML] TM_During with", toString(obj@time),
"\n")
.encoded <- .encodeTM(nodeName = ogcTempOpTMDuringName,
propertyName = obj@propertyName, time = obj@time,
sos = sos, verbose = verbose)
return(.encoded)
}
)
setMethod(f = "encodeXML",
signature = signature(obj = "TM_Equals", sos = "SOS"),
definition = function(obj, sos, verbose) {
if (verbose) cat("[encodeXML] TM_Equals with", toString(obj@time),
"\n")
.encoded <- .encodeTM(nodeName = ogcTempOpTMEqualsName,
propertyName = obj@propertyName, time = obj@time,
sos = sos, verbose = verbose)
return(.encoded)
}
)
.encodeTM <- function(nodeName, propertyName, time, sos, verbose = FALSE) {
if (verbose) cat("[.encodeTM] ", nodeName, "\n")
# FIXME: https://github.com/r-lib/xml2/issues/239
#operation <- xml2::xml_new_root(nodeName,
# xmlns = ogcNamespace)
tm <- xml2::read_xml(paste0("<", ogcNamespacePrefix, ":", nodeName,
" xmlns:", ogcNamespacePrefix, "=\"", ogcNamespace, "\" />"))
pn <- xml2::xml_add_child(tm, ogcPropertyNameName)
xml2::xml_text(x = pn) <- propertyName
time <- encodeXML(obj = time, sos = sos, verbose = verbose)
xml2::xml_add_child(tm, time)
return(tm)
}
setMethod(f = "encodeXML",
signature = signature(obj = "OgcBBOX", sos = "SOS"),
definition = function(obj, sos, verbose) {
if (verbose) cat("[encodeXML] OgcBBOX with", toString(obj), "\n")
# FIXME: https://github.com/r-lib/xml2/issues/239
#operation <- xml2::xml_new_root(opName,
# xmlns = ogcNamespace)
bbox <- xml2::read_xml(paste0("<", ogcBBOXName, " xmlns:", ogcNamespacePrefix, "=\"", ogcNamespace, "\" />"))
pN <- .createPropertyName(propertyName = obj@propertyName)
env <- encodeXML(obj = obj@envelope, sos = sos, verbose = verbose)
xml2::xml_add_child(bbox, pN)
xml2::xml_add_child(bbox, env)
return(bbox)
}
)
setMethod(f = "encodeXML",
signature = signature(obj = "OgcContains", sos = "SOS"),
definition = function(obj, sos, verbose) {
if (verbose) cat("[encodeXML] OgcContains with", toString(obj), "\n")
.contains <- .encodeBinarySpatialOp(opName = ogcContainsName,
propertyName = obj@propertyName,
geometry = obj@geometry,
envelope = obj@envelope,
sos = sos)
return(.contains)
}
)
setMethod(f = "encodeXML",
signature = signature(obj = "OgcIntersects", sos = "SOS"),
definition = function(obj, sos, verbose) {
if (verbose) cat("[encodeXML] OgcIntersects with", toString(obj), "\n")
.intersects <- .encodeBinarySpatialOp(opName = ogcIntersectsName,
propertyName = obj@propertyName,
geometry = obj@geometry,
envelope = obj@envelope,
sos = sos)
return(.intersects)
}
)
setMethod(f = "encodeXML",
signature = signature(obj = "OgcOverlaps", sos = "SOS"),
definition = function(obj, sos, verbose) {
if (verbose) cat("[encodeXML] OgcOverlaps with", toString(obj), "\n")
.overlaps <- .encodeBinarySpatialOp(opName = ogcOverlapsName,
propertyName = obj@propertyName, geometry = obj@geometry,
envelope = obj@envelope, sos = sos)
return(.overlaps)
}
)
.encodeBinarySpatialOp <- function(opName,
propertyName,
geometry,
envelope,
sos) {
# switch between geometry and envelope
if (!is.null(geometry)) {
geomOrEnv <- encodeXML(obj = geometry, sos = sos)
}
else if (!is.null(envelope)) {
geomOrEnv <- encodeXML(obj = envelope, sos = sos)
}
else {
stop("At least one of 'geometry' or 'envelope' has to be set.")
}
# FIXME: https://github.com/r-lib/xml2/issues/239
#operation <- xml2::xml_new_root(opName,
# xmlns = ogcNamespace)
spOp <- xml2::read_xml(paste0("<", opName, " xmlns=\"", ogcNamespace, "\" />"))
pN <- .createPropertyName(propertyName = propertyName)
xml2::xml_add_child(spOp, pN)
xml2::xml_add_child(spOp, geomOrEnv)
return(spOp)
}
.createPropertyName <- function(propertyName) {
# FIXME: https://github.com/r-lib/xml2/issues/239
#pN <- xml2::xml_new_root(ogcPropertyNameName, xmlns = ogcNamespace)
pN <- xml2::read_xml(paste0("<", ogcPropertyNameName, " xmlns:ogc=\"", ogcNamespace, "\" />"))
xml2::xml_text(x = pN) <- propertyName
return(pN)
}
setMethod(f = "encodeXML",
signature = signature(obj = "OgcComparisonOps", sos = "SOS"),
definition = function(obj, sos, verbose) {
if (verbose) cat("[encodeXML] OgcComparisonOps with", toString(obj), "\n")
warning("Encoding of OgcComparisonOps not implemented yet! Returning obj as is...")
return(obj)
}
)
#
# see: http://www.oostethys.org/best-practices/best-practices-get
#
setMethod(f = "encodeKVP",
signature = signature(obj = "OgcBinaryTemporalOp", sos = "SOS"),
definition = function(obj, sos, verbose) {
if (verbose) cat("[encodeKVP] temporalOps: ", toString(obj), "\n")
.time <- NULL
.tempOpTime <- obj@time
if (class(.tempOpTime) == "GmlTimeInstant") {
if (verbose)
cat("[encodeKVP] Encoding instant.\n")
.time <- encodeKVP(.tempOpTime@timePosition@time, sos = sos,
verbose = verbose)
}
# ignore type, because temporal operators are not supportded by the
# GET binding
else if (class(.tempOpTime) == "GmlTimePeriod") {
if (!is.null(.tempOpTime@begin) && !is.null(.tempOpTime@end)) {
if (verbose)
cat("[encodeKVP] Encoding period with begin and end.\n")
.begin <- encodeKVP(.tempOpTime@begin@time@timePosition, sos = sos,
verbose = verbose)
.end <- encodeKVP(.tempOpTime@end@time@timePosition, sos = sos,
verbose = verbose)
.time <- paste(.begin, "/", .end, sep = "")
}
else if (!is.null(.tempOpTime@beginPosition)
&& !is.null(.tempOpTime@endPosition)) {
if (verbose)
cat("[encodeKVP] Encoding period with beginPosition and endPosition.\n")
.begin <- encodeKVP(.tempOpTime@beginPosition@time, sos = sos,
verbose = verbose)
.end <- encodeKVP(.tempOpTime@endPosition@time, sos = sos,
verbose = verbose)
.time <- paste(.begin, "/", .end, sep = "")
}
else {
stop(paste("Incomplete gml:TimePeriod:",
toString(.tempOpTime)))
}
}
else {
stop(paste("Cannot encode given object as KVP",
toString(.tempOpTime)))
}
return(.time)
}
)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.