These values are default parameters and handling functions for connections and requests to, as well as response processing of ansers from, Sensor Observation Services. These allow to simplify a SOS connection for the most common use cases and non-expert users.

SosDefaultBinding()

SosParsingFunctions(..., include = character(0), exclude = character(0))
SosEncodingFunctions(..., include = character(0), exclude = character(0))
SosDataFieldConvertingFunctions(..., include = character(0), exclude = character(0))

SosDisabledParsers()

SosExampleServices()

SosDefaults()

SosResetParsingFunctions(sos)

SosDefaultDCPs()

SosDefaultParsingOptions()

Arguments

Named references to functions to be used for the respective element during parsing, encoding oder conversion, e.g. "myUnit" = myUnitParser.

include

A list of names of elements whose functions shall be included in the returned list, e.g. include = c("GetObservation", "DescribeSensor"). This inclusion is done after replacing the default functions based on the ... argument.

exclude

A list of names of elements whose functions shall be excluced in the returned list, e.g. exclude = c("DescribeSensor"). This exclusion is done after replacing the default functions based on the ... argument.

sos

An object of class SOS.

Details

The default values are strongly related to what is actually implemented in the package, but also often resemble the (hopefully) most common use cases.

Some defaults are accessed directly, others should be accessed using a function. The latter is required for cases where a runtime evaluation is needed, e.g. for default values of construction functions.

A special case are the functions to access the default functions for specific purposes, which are the parsing functions, the encoding functions and the field converting functions. See the examples on how to use them.

The function SosDisabledParsers can be used to use no parsing at all (despite the parsing for the capabilities response, which is required for establishing a connection to a SOS. This function is helpful to inspect the unprocessed responses from a service.

The function SosResetParsingFunctions can be used to replace the included parsing functions of a SOS object with the default ones. This is even useful for development of the default parsing functions.

The default parameter values are:

sosDefaultCharacterEncoding

\Sexpr[results=verbatim,stage=render]{sosDefaultCharacterEncoding}

% "UTF-8"
sosDefaultDescribeSensorOutputFormat

\Sexpr[results=text,stage=render]{sosDefaultDescribeSensorOutputFormat}

% SosSupportedResponseFormats()[2]
sosDefaultGetCapSections

\Sexpr[results=text,stage=render]{sosDefaultGetCapSections}

% c("All")
sosDefaultGetCapAcceptFormats

\Sexpr[results=text,stage=render]{sosDefaultGetCapAcceptFormats}

% c("text/xml")
sosDefaultGetCapOwsVersion

\Sexpr[results=text,stage=render]{sosDefaultGetCapOwsVersion}

% "1.1.0"
sosDefaultGetObsResponseFormat

\Sexpr[results=text,stage=render]{sosDefaultGetObsResponseFormat}

% SosSupportedResponseFormats()[1]
sosDefaultTimeFormat

\Sexpr[results=text,stage=render]{sosDefaultTimeFormat}

% "%Y-%m-%dT%H:%M:%OS"
sosDefaultFilenameTimeFormat

\Sexpr[results=text,stage=render]{sosDefaultFilenameTimeFormat}

%
sosDefaultTempOpPropertyName

\Sexpr[results=text,stage=render]{sosDefaultTempOpPropertyName}

% "om:samplingTime"
sosDefaultTemporalOperator

\Sexpr[results=text,stage=render]{sosDefaultTemporalOperator}

% SosSupportedTemporalOperators()[[ogcTempOpTMDuringName]]
sosDefaultSpatialOpPropertyName

\Sexpr[results=text,stage=render]{sosDefaultSpatialOpPropertyName}

% "urn:ogc:data:location"

The default parsing functions can be replaced for a variety of XML elements, so that you only need to replace the parts of the parsing that really must be changed. Be aware that inclusion and exclusion are performed after merging the given functions with the defaults!

Example Services: This list contains a few SOS instances that were tested (to different degress) with sos4R. The package authors do not maintain these services, so no guarantee can be given that these are usable.

Value

The default value of the respective setting or parameter. This can be a list, especially a named list of functions.

References

Constants

Examples

# simple default values show(sosDefaultCharacterEncoding)
#> [1] "UTF-8"
show(sosDefaultDescribeSensorOutputFormat)
#> [1] "text/xml;subtype=\"sensorML/1.0.1\""
show(sosDefaultGetCapAcceptFormats)
#> [1] "text/xml"
show(sosDefaultGetCapOwsVersion)
#> [1] "1.1.0"
show(sosDefaultGetCapSections)
#> [1] "All"
show(sosDefaultGetObsResponseFormat)
#> [1] "text/xml;subtype=\"om/1.0.0\""
show(sosDefaultSpatialOpPropertyName)
#> [1] "urn:ogc:data:location"
show(sosDefaultTempOpPropertyName)
#> [1] "om:samplingTime"
show(sosDefaultTemporalOperator)
#> [1] "TM_During"
show(sosDefaultTimeFormat)
#> [1] "%Y-%m-%dT%H:%M:%OS"
SosDefaultBinding()
#> [1] "POX"
# NOT RUN { # usage of defaults in construction method for SOS class sos <- SOS("http://mysos.com/sos", binding = SosDefaultBinding(), timeFormat = sosDefaultTimeFormat) # }
# functions to disable all parsing SosDisabledParsers()
#> $GetCapabilities #> function (obj, sos) #> { #> if (sos@version == sos100_version) { #> .caps <- parseSosCapabilities100(obj, sos) #> } #> else if (sos@version == sos200_version) { #> .caps <- parseSosCapabilities200(obj, sos) #> } #> } #> <environment: namespace:sos4R> #> #> $DescribeSensor #> function (obj) #> { #> return(obj) #> } #> <environment: namespace:sos4R> #> #> $GetObservation #> function (obj) #> { #> return(obj) #> } #> <environment: namespace:sos4R> #> #> $GetObservationById #> function (obj) #> { #> return(obj) #> } #> <environment: namespace:sos4R> #> #> $`ows:ExceptionReport` #> function (obj) #> { #> return(obj) #> } #> <environment: namespace:sos4R> #>
# Replace a parsing function myER <- function(xml) { return("EXCEPTION!!!11") } SosParsingFunctions("ExceptionReport" = myER)
#> $ExceptionReport #> function (xml) #> { #> return("EXCEPTION!!!11") #> } #> <environment: 0xa70fa50> #> #> $GetCapabilities #> function (obj, sos) #> { #> if (sos@version == sos100_version) { #> .caps <- parseSosCapabilities100(obj, sos) #> } #> else if (sos@version == sos200_version) { #> .caps <- parseSosCapabilities200(obj, sos) #> } #> } #> <environment: namespace:sos4R> #> #> $DescribeSensor #> function (obj, sos, verbose = FALSE) #> { #> if (verbose) #> cat("[parseSensorML] Starting... \n") #> .id <- .smlIdentifier(obj, "uniqueID", verbose = verbose) #> .shortName <- .smlIdentifier(obj, "shortName", verbose = verbose) #> .descrNode <- xml2::xml_find_first(x = obj, xpath = .smlXPathDescription, #> ns = SosAllNamespaces()) #> .description <- xml2::xml_text(x = .descrNode) #> if (verbose) #> cat("[parseSensorML] Got ID", .id, "and shortName", .shortName, #> "and description", .description, "\n") #> if (verbose) #> cat("[parseSensorML] Parsing boundedBy from", .smlXPathObservedBBox, #> "\n") #> .observedBBox <- xml2::xml_find_first(x = obj, xpath = .smlXPathObservedBBox, #> ns = SosAllNamespaces()) #> if (!is.na(.observedBBox)) { #> .referenceFrame <- xml2::xml_attr(x = .observedBBox, #> attr = "referenceFrame", ns = SosAllNamespaces()) #> .llVector <- parseSweVector(xml2::xml_child(x = .observedBBox, #> search = paste0(sweUpperCornerName, "/", sweVectorName), #> ns = SosAllNamespaces()), sos = sos, verbose = verbose) #> .uuVector <- parseSweVector(xml2::xml_child(x = .observedBBox, #> search = paste0(sweLowerCornerName, "/", sweVectorName), #> ns = SosAllNamespaces()), sos = sos, verbose = verbose) #> .bb <- matrix(c(.llVector[["x"]][["value"]], .llVector[["y"]][["value"]], #> .uuVector[["x"]][["value"]], .uuVector[["y"]][["value"]]), #> ncol = 2, dimnames = list(c("coords.lon", "coords.lat"), #> c("min", "max"))) #> .oldAttrs <- attributes(.bb) #> attributes(.bb) <- c(.oldAttrs, list(referenceFrame = .referenceFrame)) #> if (verbose) #> cat("[parseSensorML] Parsed bounding box: ", toString(.bb), #> "\n") #> } #> else { #> .bb <- matrix() #> if (verbose) #> cat("[parseSensorML] No boundedBy element found, bbox is ", #> .bb, "\n") #> } #> if (verbose) #> cat("[parseSensorML] Parsing coordinates from", .smlXPathPosition, #> "\n") #> .xmlPosition <- xml2::xml_find_first(x = obj, xpath = .smlXPathPosition, #> ns = SosAllNamespaces()) #> if (!is.na(.xmlPosition)) { #> .position <- parseSwePosition(.xmlPosition, sos = sos, #> verbose = verbose) #> .referenceFrame = attributes(.position)[["referenceFrame"]] #> .uom <- lapply(.position, "[[", "uomCode") #> names(.uom) <- lapply(.position, "[[", "axisID") #> .name <- lapply(.position, "[[", "name") #> names(.name) <- lapply(.position, "[[", "axisID") #> .values <- lapply(.position, "[[", "value") #> names(.values) <- lapply(.position, "[[", "axisID") #> if (any(is.na(names(.values)))) { #> warning("[parseSensorML] No axisID given, cannot name data.frame with them, trying 'name'.") #> names(.values) <- lapply(.position, "[[", "name") #> } #> if (verbose) { #> cat("[parseSensorML] names: ", names(.values), "\n") #> cat("[parseSensorML] values: ", toString(.values), #> "\n") #> } #> .coords <- data.frame(.values) #> .oldAttrs <- attributes(.coords) #> attributes(.coords) <- c(as.list(.oldAttrs), list(referenceFrame = .referenceFrame, #> uom = .uom, name = .name)) #> if (!is.na(.id)) #> row.names(.coords) <- .id #> if (verbose) #> cat("[parseSensorML] row names: ", row.names(.coords), #> "\n") #> } #> else { #> .coords <- data.frame() #> } #> .sml = SensorML(xml = obj, coords = .coords, id = .id, name = .shortName, #> description = .description, boundedBy = .bb) #> if (verbose) #> cat("[parseSensorML] Done: ", toString(.sml), "\n") #> return(.sml) #> } #> <environment: namespace:sos4R> #> #> $GetObservation #> function (obj, sos, verbose = FALSE) #> { #> .om <- NULL #> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) #> .parsingFunction <- sosParsers(sos)[[.name]] #> if (!is.null(.parsingFunction)) { #> if (verbose) #> cat("[parseOM] Matched name for parser is", .name, #> "\n") #> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) #> if (verbose) #> cat("[parseOM] Done parsing\n") #> } #> else { #> warning(paste("[parseOM] No parsing function for given element", #> .name)) #> } #> return(.om) #> } #> <environment: namespace:sos4R> #> #> $GetObservationResponse #> function (obj, sos, verbose = FALSE) #> { #> if (sos@verboseOutput) { #> cat("[parseGetObservationResponse] entering... \n") #> print(obj) #> } #> .observationsXML <- xml2::xml_find_all(x = obj, xpath = "sos20:observationData", #> ns = SosAllNamespaces(version = sos200_version)) #> featureCache <- list() #> .observations <- sapply(.observationsXML, parseObservation_2.0, #> sos = sos, featureCache = featureCache) #> return(.observations) #> } #> <environment: namespace:sos4R> #> #> $GetFeatureOfInterestResponse #> function (obj, sos, verbose = FALSE) #> { #> if (sos@verboseOutput) { #> cat("[parseGetFeatureOfInterestResponse] entering... \n") #> print(obj) #> } #> .featureXML <- xml2::xml_find_all(x = obj, xpath = "sos20:featureMember", #> SosAllNamespaces(version = sos200_version)) #> .foi = sapply(.featureXML, .parseFeatureMember, sos = sos) #> return(.foi) #> } #> <environment: namespace:sos4R> #> #> $GetObservationById #> function (obj, sos, verbose = FALSE) #> { #> .om <- NULL #> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) #> .parsingFunction <- sosParsers(sos)[[.name]] #> if (!is.null(.parsingFunction)) { #> if (verbose) #> cat("[parseOM] Matched name for parser is", .name, #> "\n") #> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) #> if (verbose) #> cat("[parseOM] Done parsing\n") #> } #> else { #> warning(paste("[parseOM] No parsing function for given element", #> .name)) #> } #> return(.om) #> } #> <environment: namespace:sos4R> #> #> $`ows:ExceptionReport` #> function (obj, verbose = FALSE) #> { #> if (verbose) #> cat("[parseOwsExceptionReport] Starting ...\n") #> .docRoot <- xml2::xml_root(x = obj) #> .version <- xml2::xml_attr(x = .docRoot, attr = "version") #> .lang <- xml2::xml_attr(x = .docRoot, attr = "lang", default = NA_character_) #> .exceptionsXML <- xml2::xml_find_all(x = .docRoot, xpath = paste0("//", #> owsExceptionName), ns = SosAllNamespaces()) #> .exceptions = sapply(.exceptionsXML, parseOwsException) #> if (verbose) #> cat("[parseOwsExceptionReport]", length(.exceptions), #> "exceptions.") #> .report <- OwsExceptionReport(version = .version, lang = .lang, #> exceptions = .exceptions) #> return(.report) #> } #> <environment: namespace:sos4R> #> #> $GetDataAvailabilityResponse #> function (obj, sos, verbose = FALSE) #> { #> if (verbose) #> cat("[parseGetDataAvailabilityResponse]") #> if (sos@version != sos200_version) { #> stop(paste0("[parseGetDataAvailabilityResponse] SOS version 2.0 required! Received '", #> sos@version, "'")) #> } #> .gdaMembers <- xml2::xml_find_all(x = obj, xpath = sosGDAMemberName, #> ns = SosAllNamespaces()) #> if (verbose) #> cat("[parseGetDataAvailabilityResponse] with", length(.gdaMembers), #> "element(s).\n") #> phenTimeCache <- list() #> .parsedGDAMembers <- lapply(.gdaMembers, .parseGDAMember, #> sos, phenTimeCache, verbose) #> if (verbose) #> cat("[parseGetDataAvailabilityResponse] Done. Processed", #> length(.parsedGDAMembers), "elements") #> return(.parsedGDAMembers) #> } #> <environment: namespace:sos4R> #> #> $`om:Measurement` #> function (obj, sos, verbose = FALSE) #> { #> if (verbose) #> cat("[parseMeasurement]\n") #> .samplingTimeXml <- xml2::xml_child(x = obj, search = omSamplingTimeName, #> ns = SosAllNamespaces()) #> .samplingTime <- parseTime(obj = .samplingTimeXml, format = sosTimeFormat(sos), #> verbose = verbose) #> .procedure <- xml2::xml_attr(x = xml2::xml_child(x = obj, #> search = omProcedureName, ns = SosAllNamespaces()), attr = "href") #> .observedProperty <- SwePhenomenonProperty(href = xml2::xml_attr(x = xml2::xml_child(x = obj, #> search = omObservedPropertyName, ns = SosAllNamespaces()), #> attr = "href")) #> .featureOfInterest <- parseFOI(xml2::xml_child(x = obj, search = omFeatureOfInterestName, #> ns = SosAllNamespaces()), sos = sos, verbose = verbose) #> .result <- parseMeasure(xml2::xml_child(x = obj, search = omResultName, #> ns = SosAllNamespaces())) #> .measurement <- OmMeasurement(samplingTime = .samplingTime, #> procedure = .procedure, observedProperty = .observedProperty, #> featureOfInterest = .featureOfInterest, result = .result) #> return(.measurement) #> } #> <environment: namespace:sos4R> #> #> $`om:member` #> function (obj, sos, verbose = FALSE) #> { #> if (xml2::xml_length(x = obj) >= 1) { #> .child <- xml2::xml_child(obj) #> if (verbose) #> cat("[parseObservationProperty] Parsing child of member:", #> xml2::xml_name(x = .child, ns = SosAllNamespaces()), #> "\n") #> .mResult <- parseOM(.child, sos, verbose) #> } #> else { #> if (verbose) #> cat("[parseObservationProperty] Member has no direct child!\n") #> .href <- xml2::xml_attr(x = obj, attr = "href", default = NA_character_) #> if (!is.na(.href)) { #> warning("Only reference was returned:", .href) #> .mResult <- OmObservationProperty(href = .href) #> } #> else { #> warning("No observation found!") #> .mResult <- OmObservationProperty() #> } #> } #> return(.mResult) #> } #> <environment: namespace:sos4R> #> #> $`om:Observation` #> function (obj, sos, verbose = FALSE) #> { #> .id <- xml2::xml_attr(x = obj, attr = "id", default = NA_character_) #> if (verbose) #> cat("[parseObservation]", .id, "\n") #> .procedure <- xml2::xml_attr(x = xml2::xml_child(x = obj, #> search = omProcedureName, ns = SosAllNamespaces()), attr = "href", #> default = NA_character_) #> .observedProperty <- parsePhenomenonProperty(xml2::xml_child(x = obj, #> search = omObservedPropertyName, ns = SosAllNamespaces()), #> verbose = verbose) #> if (!is.na(xml2::xml_child(x = obj, search = omSamplingTimeName, #> ns = SosAllNamespaces()))) { #> .samplingTime <- parseTime(obj = xml2::xml_child(x = obj, #> search = omSamplingTimeName, ns = SosAllNamespaces()), #> format = sosTimeFormat(sos = sos), verbose = verbose) #> } #> else { #> warning("om:samplingTime is mandatory in om:Observation, but is missing!") #> .samplingTime <- NULL #> } #> if (!is.na(xml2::xml_child(x = obj, search = omFeatureOfInterestName, #> ns = SosAllNamespaces()))) { #> .featureOfInterest <- parseFOI(xml2::xml_child(x = obj, #> search = omFeatureOfInterestName, ns = SosAllNamespaces()), #> sos = sos, verbose = verbose) #> } #> else { #> warning("om:featureOfInterest is mandatory in om:Observation, but is missing!") #> .featureOfInterest <- NULL #> } #> .resultParsingFunction <- sosParsers(sos)[[omResultName]] #> .result <- .resultParsingFunction(xml2::xml_child(x = obj, #> search = omResultName, ns = SosAllNamespaces()), sos, #> verbose) #> if (!is.na(xml2::xml_child(x = obj, search = omResultTimeName, #> ns = SosAllNamespaces()))) { #> .resultTime <- parseTime(obj = xml2::xml_child(x = obj, #> search = omResultTimeName, ns = SosAllNamespaces()), #> format = sosTimeFormat(sos = sos), verbose = verbose) #> } #> else { #> .resultTime <- NULL #> } #> .obs <- OmObservation(samplingTime = .samplingTime, procedure = .procedure, #> observedProperty = .observedProperty, featureOfInterest = .featureOfInterest, #> result = .result) #> return(.obs) #> } #> <environment: namespace:sos4R> #> #> $`om:ObservationCollection` #> function (obj, sos, verbose = FALSE) #> { #> .members <- xml2::xml_find_all(x = obj, xpath = omMemberName, #> ns = SosAllNamespaces()) #> if (verbose) #> cat("[parseObservationCollection] with ", length(.members), #> "element(s).\n") #> .env <- xml2::xml_child(x = obj, search = paste0(gmlBoundedByName, #> "/", gmlEnvelopeName)) #> if (!is.na(.env)) { #> .boundedBy <- list(srsName = xml2::xml_attr(x = .env, #> attr = "srsName", ns = SosAllNamespaces()), lowerCorner = xml2::xml_text(x = xml2::xml_child(x = .env, #> search = gmlLowerCornerName, ns = SosAllNamespaces())), #> upperCorner = xml2::xml_text(x = xml2::xml_child(x = .env, #> search = gmlUpperCornerName, ns = SosAllNamespaces()))) #> if (verbose) #> cat("[parseObservationCollection] Parsed envelope:", #> toString(.boundedBy), "\n") #> if (sosSwitchCoordinates(sos)) { #> warning("Switching coordinates in envelope of ObservationCollection!") #> .origLC <- strsplit(x = .boundedBy[["lowerCorner"]], #> split = " ") #> .lC <- paste(.origLC[[1]][[2]], .origLC[[1]][[1]]) #> .origUC <- strsplit(x = .boundedBy[["upperCorner"]], #> split = " ") #> .uC <- paste(.origUC[[1]][[2]], .origUC[[1]][[1]]) #> .boundedBy <- list(srsName = xml2::xml_attr(x = .env, #> attr = "srsName"), lowerCorner = .lC, upperCorner = .uC) #> } #> } #> else { #> if (verbose) #> cat("[parseObservationCollection] Empty envelope!\n") #> .boundedBy <- list() #> } #> .resultList <- lapply(X = .members, FUN = parseOM, sos = sos, #> verbose = verbose) #> names(.resultList) <- lapply(X = .members, FUN = function(member) { #> children <- xml2::xml_children(member) #> idOrName <- xml2::xml_attr(children, attr = "id", default = xml2::xml_name(children)) #> if (length(idOrName) < 1) { #> xml2::xml_name(member) #> } #> else { #> idOrName #> } #> }) #> if (is.list(.resultList)) { #> .obsColl <- OmObservationCollection(members = .resultList, #> boundedBy = .boundedBy) #> } #> else { #> .obsColl <- OmObservationCollection(members = list(.resultList), #> boundedBy = .boundedBy) #> } #> if (verbose) #> cat("[parseObservationCollection] Done. Processed", length(.obsColl), #> "elements:", names(.obsColl), "\n") #> return(.obsColl) #> } #> <environment: namespace:sos4R> #> #> $`om:result` #> function (obj, sos, verbose = FALSE) #> { #> if (verbose) #> cat("[parseResult] Starting ...\n") #> .result <- NULL #> .children <- xml2::xml_children(x = obj) #> if (verbose) #> cat("[parseResult]", length(.children), " non-text nodes, names:", #> xml2::xml_name(.children), "\n") #> if (length(.children) == 0) { #> .children <- xml2::xml_children(x = obj) #> stop("Continue implementation here: OM-methods-parsing.R") #> cat("[parseResult] No non-text nodes in result, returning NULL.\n") #> .typeAttributValue <- xml2::xml_attr(x = obj, attr = om20ResultTypeAttributeName, #> default = NA_character_) #> .typeWithQualifiedname <- strsplit(.typeAttributValue, #> ":") #> .type <- NA_character_ #> if (length(.typeWithQualifiedname) > 0) { #> if (length(.typeWithQualifiedname[[1]]) > 1) { #> .type <- .typeWithQualifiedname[[1]][2] #> } #> } #> if (!is.na(.type)) { #> if (.type == om20ResultMeasureTypeName) { #> return(xml2::xml_text(x = obj)) #> } #> } #> return(NULL) #> } #> .name <- xml2::xml_name(x = .children[[1]], ns = SosAllNamespaces()) #> if (.name == sweDataArrayName) { #> if (verbose) #> cat("[parseResult] Parsing result with swe:DataArray.\n") #> .dataArrayParsingFunction <- sosParsers(sos)[[sweDataArrayName]] #> .result <- .dataArrayParsingFunction(.children[[1]], #> sos, verbose) #> } #> else if (.name == xmlTextNodeName) { #> .result <- as.numeric(xml2::xml_text(x = .children)) #> if (is.na(.result)) { #> .result <- xml2::xml_text(x = .children, trim = TRUE) #> } #> } #> else { #> warning(paste("[parseResult] Parsing of given result is NOT supported:", #> xml2::xml_name(x = .children[[1]], ns = SosAllNamespaces()), #> "-- only", sweDataArrayName, " or text nodes containing strings or numbers can be parsed.")) #> } #> if (is.null(.result)) { #> stop("[parseResult] result is null! Given result:\n") #> print(obj) #> } #> if (verbose) #> cat("[parseResult] Done\n") #> return(.result) #> } #> <environment: namespace:sos4R> #> #> $`swe:DataArray` #> function (obj, sos, verbose = FALSE) #> { #> .elementCount <- xml2::xml_text(xml2::xml_find_first(x = obj, #> xpath = "./swe:elementCount/swe:Count/swe:value", ns = SosAllNamespaces())) #> if (verbose) #> cat("[parseDataArray] Parsing DataArray with", .elementCount, #> "elements.\n") #> .elementTypeParser <- sosParsers(sos)[[sweElementTypeName]] #> .elementTypeXml <- xml2::xml_child(x = obj, search = sweElementTypeName, #> ns = SosAllNamespaces()) #> .fields <- .elementTypeParser(obj = .elementTypeXml, sos = sos, #> verbose = verbose) #> if (verbose) #> cat("[parseDataArray] Parsed field descriptions:", toString(.fields), #> "\n") #> .encParser <- sosParsers(sos)[[sweEncodingName]] #> .encodingXml <- xml2::xml_child(x = obj, search = sweEncodingName, #> ns = SosAllNamespaces()) #> .encoding <- .encParser(obj = .encodingXml, sos = sos, verbose = verbose) #> if (verbose) #> cat("[parseDataArray] Parsed encoding description:", #> toString(.encoding), "\n") #> .valParser <- sosParsers(sos)[[sweValuesName]] #> .values <- .valParser(values = xml2::xml_child(x = obj, search = sweValuesName, #> ns = SosAllNamespaces()), fields = .fields, encoding = .encoding, #> sos = sos, verbose = verbose) #> return(.values) #> } #> <environment: namespace:sos4R> #> #> $`swe:elementType` #> function (obj, sos, verbose = FALSE) #> { #> elementTypeHref <- stringr::str_remove_all(xml2::xml_attr(x = obj, #> attr = "href"), "#") #> if (verbose) #> cat("[parseElementType] Got child", xml2::xml_name(xml2::xml_children(obj)), #> "and id", elementTypeHref, "for object", xml2::xml_name(obj), #> "\n") #> if (is.na(elementTypeHref)) { #> elementType <- obj #> } #> else { #> root <- xml2::xml_root(obj) #> elementType <- xml2::xml_parent(xml2::xml_find_first(x = root, #> xpath = paste0("//*[@gml:id='", elementTypeHref, #> "']"))) #> if (is.na(elementType)) { #> stop("Got ", sweElementTypeName, " with a reference (href) but cannot find definition - cannot parse!", #> toString(obj)) #> } #> else { #> if (verbose) #> cat("[parseDataArray] Found elementType via reference", #> elementTypeHref, "\n") #> } #> } #> simpleDataRecord <- xml2::xml_child(x = elementType, search = sweSimpleDataRecordName, #> ns = SosAllNamespaces()) #> dataRecord <- xml2::xml_child(x = elementType, search = sweDataRecordName, #> ns = SosAllNamespaces()) #> if (!is.na(simpleDataRecord) || !is.na(dataRecord)) { #> if (!is.na(simpleDataRecord)) #> dr <- simpleDataRecord #> else dr <- dataRecord #> fields <- xml2::xml_find_all(x = dr, xpath = sweFieldName, #> ns = SosAllNamespaces()) #> if (verbose) #> cat("[parseElementType] Got data record with", length(fields), #> "fields. \n") #> parsedFields <- lapply(fields, parseField, sos = sos, #> verbose = verbose) #> names <- sapply(parsedFields, "[", "name") #> names(parsedFields) <- names #> if (verbose) #> cat("[parseElementType] Names of parsed fields:", #> names(fields), "\n") #> return(parsedFields) #> } #> else { #> stop(paste("Cannot parse swe:elementType, only children of type", #> sweSimpleDataRecordName, "and", sweDataRecordName, #> "are supported!")) #> } #> } #> <environment: namespace:sos4R> #> #> $`swe:encoding` #> function (obj, sos, verbose = FALSE) #> { #> .textBlock <- xml2::xml_child(x = obj, search = sweTextBlockName, #> ns = SosAllNamespaces()) #> .textEncoding <- xml2::xml_child(x = obj, search = sweTextEncodingName, #> ns = SosAllNamespaces()) #> if (!(is.na(.textBlock))) { #> .tb <- parseTextBlock(.textBlock) #> return(.tb) #> } #> else if (!(is.na(.textEncoding))) { #> .tb <- parseTextEncoding(.textEncoding) #> return(.tb) #> } #> else { #> stop(paste("Cannot parse swe:encoding, only", sweTextBlockName, #> "and", sweTextEncodingName, "are supported!")) #> } #> } #> <environment: namespace:sos4R> #> #> $`swe:values` #> function (values, fields, encoding, sos, verbose = FALSE) #> { #> if (verbose) #> cat("[parseValues] Parsing swe:values using", toString(encoding), #> "and", length(fields), "fields:", toString(names(fields)), #> "\n") #> if (!(inherits(encoding, "SweTextBlock") || inherits(encoding, #> "SweTextEncoding"))) { #> stop("Handling for given encoding not implemented!") #> } #> .converters <- sosDataFieldConverters(sos) #> .blockLines <- strsplit(x = xml2::xml_text(x = values), split = encoding@blockSeparator) #> .tokenLines <- sapply(.blockLines, strsplit, split = encoding@tokenSeparator) #> if (verbose) #> cat("[parseValues] Parsing values from lines: ", toString(.tokenLines), #> "\n") #> .tempId = "tempID" #> .data <- data.frame(seq(1, length(.tokenLines))) #> names(.data) <- .tempId #> .fieldCount <- length(fields) #> for (.currentFieldIdx in seq(1, .fieldCount)) { #> if (verbose) #> cat("[parseValues] Processing field index", .currentFieldIdx, #> "of", .fieldCount, "\n") #> .currentValues <- sapply(.tokenLines, "[[", .currentFieldIdx) #> if (verbose) #> cat("[parseValues] Current values: ", toString(.currentValues), #> "\n") #> .currentField <- fields[[.currentFieldIdx]] #> if (verbose) #> cat("[parseValues] Parsing field", paste(.currentField), #> "\n") #> .fieldDefinition <- .currentField[["definition"]] #> .method <- .converters[[.fieldDefinition]] #> if (verbose) { #> cat("[parseValues] Using converter:\n") #> print(.method) #> } #> if (is.null(.method)) { #> if (!is.na(.currentField["uom"])) { #> .method <- .converters[[.currentField[["uom"]]]] #> if (is.null(.method)) { #> warning(paste("No converter for the unit of measurement ", #> .currentField[["uom"]], " with the definition ", #> .currentField[["definition"]], "! Trying a default, but you can add one when creating a SOS using", #> "SosDataFieldConvertingFunctions().\n")) #> .method <- .converters[["fallBack"]] #> } #> } #> else { #> warning(paste("No converter found for the given field", #> toString(.currentField), "using fallBack converter.")) #> .method <- .converters[["fallBack"]] #> } #> } #> if (verbose) { #> cat("[parseValues] Using converter function:\n") #> show(.method) #> } #> .currentValues <- .method(x = .currentValues, sos = sos) #> if (verbose) #> cat("[parseValues] Binding additional data.frame for", #> .currentField[["name"]], "-- value range", toString(range(.currentValues)), #> "\n") #> .newData <- data.frame(.currentValues) #> .newDataName <- .currentField[["name"]] #> names(.newData) <- .cleanupColumnName(.newDataName) #> if (verbose) #> cat("[parseValues] Added column name:", names(.newData), #> "\n") #> .data <- cbind(.data, .newData) #> if (verbose) { #> cat("[parseValues] The new bound data frame (one variable the a temp id):\n") #> str(.data) #> } #> .addAttrs <- as.list(.currentField) #> names(.addAttrs) <- .sosParseFieldReadable[names(.currentField)] #> .lastColumn <- dim(.data)[[2]] #> .oldAttrs <- attributes(.data[, .lastColumn]) #> attributes(.data[, .lastColumn]) <- c(as.list(.oldAttrs), #> .addAttrs) #> if (verbose) #> cat("[parseValues] Added attributes to new data:", #> toString(.addAttrs), "[ names: ", toString(names(.addAttrs)), #> "]", "\n[parseValues] Old attributes list is", #> toString(.oldAttrs), "\n[parseValues] New attributes list is", #> toString(attributes(.data[, .lastColumn])), "\n") #> } #> if (verbose) #> cat("[parseValues] Removing temporary first column\n") #> .data <- .data[, !colnames(.data) %in% .tempId] #> if (verbose) { #> cat("[parseValues] returning final data frame:\n") #> str(.data) #> } #> return(.data) #> } #> <environment: namespace:sos4R> #> #> $`swe:Position` #> function (obj, sos, verbose = FALSE) #> { #> .rF <- xml2::xml_attr(x = obj, attr = "referenceFrame", ns = SosAllNamespaces()) #> if (verbose) #> cat("[parseSwePosition] with referenceFrame", .rF, "\n") #> .location <- xml2::xml_child(x = obj, search = sweLocationName, #> ns = SosAllNamespaces()) #> .parser <- sosParsers(sos)[[sweLocationName]] #> .pos <- .parser(.location, sos = sos, verbose = verbose) #> .oldAttrs <- attributes(.pos) #> attributes(.pos) <- c(.oldAttrs, list(referenceFrame = .rF)) #> return(.pos) #> } #> <environment: namespace:sos4R> #> #> $`swe:location` #> function (obj, sos, verbose = FALSE) #> { #> .vector <- xml2::xml_child(x = obj, search = sweVectorName, #> ns = SosAllNamespaces()) #> .id <- xml2::xml_attr(x = obj, attr = "id") #> if (verbose) #> cat("[parseSweLocation] with id", .id, "\n") #> .parser <- sosParsers(sos)[[sweVectorName]] #> location <- .parser(.vector, sos = sos, verbose = verbose) #> return(location) #> } #> <environment: namespace:sos4R> #> #> $`swe:Vector` #> function (obj, sos, verbose = FALSE) #> { #> .children <- xml2::xml_find_all(x = obj, xpath = sweCoordinateName, #> ns = SosAllNamespaces()) #> .parser <- sosParsers(sos)[[sweCoordinateName]] #> .vector <- lapply(X = .children, FUN = .parser, sos = sos, #> verbose = verbose) #> names(.vector) <- sapply(.vector, function(current) { #> return(current$axisID) #> }) #> if (verbose) #> cat("[parseSweVector] parsed vector with coordinates: ", #> toString(names(.vector)), "\n") #> return(.vector) #> } #> <environment: namespace:sos4R> #> #> $`swe:coordinate` #> function (obj, sos, verbose = FALSE) #> { #> .name <- xml2::xml_attr(x = obj, attr = "name") #> if (verbose) #> cat("[parseSweCoordinate] with name", .name, "\n") #> .quantity <- xml2::xml_child(x = obj, search = sweQuantityName, #> ns = SosAllNamespaces()) #> .axisID <- xml2::xml_attr(x = .quantity, attr = "axisID") #> if (verbose) #> cat("[parseSweCoordinate] axisID: ", .axisID, "\n") #> .uomNode <- xml2::xml_child(x = .quantity, search = sweUomName, #> ns = SosAllNamespaces()) #> .uomCode <- xml2::xml_attr(x = .uomNode, attr = "code", ns = SosAllNamespaces()) #> if (verbose) #> cat("[parseSweCoordinate] uomCode: ", .uomCode, "\n") #> .valueNode <- xml2::xml_child(x = .quantity, search = sweValueName, #> ns = SosAllNamespaces()) #> .value <- as.double(xml2::xml_text(x = .valueNode)) #> if (verbose) #> cat("[parseSweCoordinate] value: ", .value, "\n") #> return(list(name = .name, axisID = .axisID, uomCode = .uomCode, #> value = .value)) #> } #> <environment: namespace:sos4R> #> #> $`om:GeometryObservation` #> function (obj, sos, verbose = FALSE) #> { #> warning("Parsing of om:GeometryObservation is not implemented!") #> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:CategoryObservation` #> function (obj, sos, verbose = FALSE) #> { #> warning("Parsing of om:CategoryObservation is not implemented!") #> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:CountObservation` #> function (obj, sos, verbose = FALSE) #> { #> warning("Parsing of om:CountObservation is not implemented!") #> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:TruthObservation` #> function (obj, sos, verbose = FALSE) #> { #> warning("Parsing of om:TruthObservation is not implemented!") #> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:TemporalObservation` #> function (obj, sos, verbose = FALSE) #> { #> warning("Parsing of om:TemporalObservatio is not implemented!") #> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:ComplexObservation` #> function (obj, sos, verbose = FALSE) #> { #> warning("Parsing of om:ComplexObservation is not implemented!") #> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`text/csv` #> function (obj, verbose = FALSE) #> { #> if (verbose) #> cat("[parseCSV] Parsing CSV...\n") #> if (inherits(x = obj, what = "data.frame")) { #> if (verbose) #> cat("[parseCSV] Already a data.frame, returning object\n") #> return(obj) #> } #> .lines <- strsplit(x = obj, split = "\n")[[1]] #> .data <- do.call(what = "strsplit", args = list(.lines, split = ",")) #> .names <- .data[[1]] #> .newNames <- c() #> for (.n in .names) { #> .newNames <- c(.newNames, gsub(pattern = "\"", replacement = "", #> x = .n)) #> } #> .names <- .newNames #> .rows <- length(.data) #> if (verbose) #> cat("[parseCSV] Got", .rows, "lines of data.\n") #> .df <- NULL #> for (.r in seq(2, .rows)) { #> if (verbose) #> cat("[parseCSV] Processing row in CSV:", .data[[.r]], #> "\n") #> .row.df <- as.data.frame(.data[[.r]][1]) #> names(.row.df) <- .names[[1]] #> for (i in seq(2, length(.names))) { #> .df <- as.data.frame(.data[[.r]][i]) #> names(.df) <- .names[[i]] #> .row.df <- cbind(.row.df, .df) #> } #> if (is.null(.df)) #> .df <- .row.df #> else .df <- do.call(rbind, list(.df, .row.df)) #> } #> if (verbose) #> cat("[parseCSV] Done.\n") #> return(.df) #> } #> <environment: namespace:sos4R> #> #> $`text/xml;subtype="om/1.0.0"` #> function (obj, sos, verbose = FALSE) #> { #> .om <- NULL #> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) #> .parsingFunction <- sosParsers(sos)[[.name]] #> if (!is.null(.parsingFunction)) { #> if (verbose) #> cat("[parseOM] Matched name for parser is", .name, #> "\n") #> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) #> if (verbose) #> cat("[parseOM] Done parsing\n") #> } #> else { #> warning(paste("[parseOM] No parsing function for given element", #> .name)) #> } #> return(.om) #> } #> <environment: namespace:sos4R> #> #> $`application/vnd.google-earth.kml+xml` #> function (obj, sos, verbose = FALSE) #> { #> if (verbose) #> cat("[parseKML] Processing KML... returning raw object!\n") #> return(obj) #> } #> <environment: namespace:sos4R> #> #> $kml #> function (obj, sos, verbose = FALSE) #> { #> if (verbose) #> cat("[parseKML] Processing KML... returning raw object!\n") #> return(obj) #> } #> <environment: namespace:sos4R> #> #> $`text/xml` #> function (obj, sos, verbose = FALSE) #> { #> .om <- NULL #> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) #> .parsingFunction <- sosParsers(sos)[[.name]] #> if (!is.null(.parsingFunction)) { #> if (verbose) #> cat("[parseOM] Matched name for parser is", .name, #> "\n") #> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) #> if (verbose) #> cat("[parseOM] Done parsing\n") #> } #> else { #> warning(paste("[parseOM] No parsing function for given element", #> .name)) #> } #> return(.om) #> } #> <environment: namespace:sos4R> #>
# use inclusion and exclusion, important: even the just added function needs to # be included manually! SosParsingFunctions("ExceptionReport" = myER, include = c("GetObservation", "DescribeSensor", "ExceptionReport"))
#> $GetObservation #> function (obj, sos, verbose = FALSE) #> { #> .om <- NULL #> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) #> .parsingFunction <- sosParsers(sos)[[.name]] #> if (!is.null(.parsingFunction)) { #> if (verbose) #> cat("[parseOM] Matched name for parser is", .name, #> "\n") #> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) #> if (verbose) #> cat("[parseOM] Done parsing\n") #> } #> else { #> warning(paste("[parseOM] No parsing function for given element", #> .name)) #> } #> return(.om) #> } #> <environment: namespace:sos4R> #> #> $DescribeSensor #> function (obj, sos, verbose = FALSE) #> { #> if (verbose) #> cat("[parseSensorML] Starting... \n") #> .id <- .smlIdentifier(obj, "uniqueID", verbose = verbose) #> .shortName <- .smlIdentifier(obj, "shortName", verbose = verbose) #> .descrNode <- xml2::xml_find_first(x = obj, xpath = .smlXPathDescription, #> ns = SosAllNamespaces()) #> .description <- xml2::xml_text(x = .descrNode) #> if (verbose) #> cat("[parseSensorML] Got ID", .id, "and shortName", .shortName, #> "and description", .description, "\n") #> if (verbose) #> cat("[parseSensorML] Parsing boundedBy from", .smlXPathObservedBBox, #> "\n") #> .observedBBox <- xml2::xml_find_first(x = obj, xpath = .smlXPathObservedBBox, #> ns = SosAllNamespaces()) #> if (!is.na(.observedBBox)) { #> .referenceFrame <- xml2::xml_attr(x = .observedBBox, #> attr = "referenceFrame", ns = SosAllNamespaces()) #> .llVector <- parseSweVector(xml2::xml_child(x = .observedBBox, #> search = paste0(sweUpperCornerName, "/", sweVectorName), #> ns = SosAllNamespaces()), sos = sos, verbose = verbose) #> .uuVector <- parseSweVector(xml2::xml_child(x = .observedBBox, #> search = paste0(sweLowerCornerName, "/", sweVectorName), #> ns = SosAllNamespaces()), sos = sos, verbose = verbose) #> .bb <- matrix(c(.llVector[["x"]][["value"]], .llVector[["y"]][["value"]], #> .uuVector[["x"]][["value"]], .uuVector[["y"]][["value"]]), #> ncol = 2, dimnames = list(c("coords.lon", "coords.lat"), #> c("min", "max"))) #> .oldAttrs <- attributes(.bb) #> attributes(.bb) <- c(.oldAttrs, list(referenceFrame = .referenceFrame)) #> if (verbose) #> cat("[parseSensorML] Parsed bounding box: ", toString(.bb), #> "\n") #> } #> else { #> .bb <- matrix() #> if (verbose) #> cat("[parseSensorML] No boundedBy element found, bbox is ", #> .bb, "\n") #> } #> if (verbose) #> cat("[parseSensorML] Parsing coordinates from", .smlXPathPosition, #> "\n") #> .xmlPosition <- xml2::xml_find_first(x = obj, xpath = .smlXPathPosition, #> ns = SosAllNamespaces()) #> if (!is.na(.xmlPosition)) { #> .position <- parseSwePosition(.xmlPosition, sos = sos, #> verbose = verbose) #> .referenceFrame = attributes(.position)[["referenceFrame"]] #> .uom <- lapply(.position, "[[", "uomCode") #> names(.uom) <- lapply(.position, "[[", "axisID") #> .name <- lapply(.position, "[[", "name") #> names(.name) <- lapply(.position, "[[", "axisID") #> .values <- lapply(.position, "[[", "value") #> names(.values) <- lapply(.position, "[[", "axisID") #> if (any(is.na(names(.values)))) { #> warning("[parseSensorML] No axisID given, cannot name data.frame with them, trying 'name'.") #> names(.values) <- lapply(.position, "[[", "name") #> } #> if (verbose) { #> cat("[parseSensorML] names: ", names(.values), "\n") #> cat("[parseSensorML] values: ", toString(.values), #> "\n") #> } #> .coords <- data.frame(.values) #> .oldAttrs <- attributes(.coords) #> attributes(.coords) <- c(as.list(.oldAttrs), list(referenceFrame = .referenceFrame, #> uom = .uom, name = .name)) #> if (!is.na(.id)) #> row.names(.coords) <- .id #> if (verbose) #> cat("[parseSensorML] row names: ", row.names(.coords), #> "\n") #> } #> else { #> .coords <- data.frame() #> } #> .sml = SensorML(xml = obj, coords = .coords, id = .id, name = .shortName, #> description = .description, boundedBy = .bb) #> if (verbose) #> cat("[parseSensorML] Done: ", toString(.sml), "\n") #> return(.sml) #> } #> <environment: namespace:sos4R> #> #> $ExceptionReport #> function (xml) #> { #> return("EXCEPTION!!!11") #> } #> <environment: 0xa70fa50> #>
SosParsingFunctions(exclude = c("GetObservation", "DescribeSensor"))
#> $GetCapabilities #> function (obj, sos) #> { #> if (sos@version == sos100_version) { #> .caps <- parseSosCapabilities100(obj, sos) #> } #> else if (sos@version == sos200_version) { #> .caps <- parseSosCapabilities200(obj, sos) #> } #> } #> <environment: namespace:sos4R> #> #> $GetObservationResponse #> function (obj, sos, verbose = FALSE) #> { #> if (sos@verboseOutput) { #> cat("[parseGetObservationResponse] entering... \n") #> print(obj) #> } #> .observationsXML <- xml2::xml_find_all(x = obj, xpath = "sos20:observationData", #> ns = SosAllNamespaces(version = sos200_version)) #> featureCache <- list() #> .observations <- sapply(.observationsXML, parseObservation_2.0, #> sos = sos, featureCache = featureCache) #> return(.observations) #> } #> <environment: namespace:sos4R> #> #> $GetFeatureOfInterestResponse #> function (obj, sos, verbose = FALSE) #> { #> if (sos@verboseOutput) { #> cat("[parseGetFeatureOfInterestResponse] entering... \n") #> print(obj) #> } #> .featureXML <- xml2::xml_find_all(x = obj, xpath = "sos20:featureMember", #> SosAllNamespaces(version = sos200_version)) #> .foi = sapply(.featureXML, .parseFeatureMember, sos = sos) #> return(.foi) #> } #> <environment: namespace:sos4R> #> #> $GetObservationById #> function (obj, sos, verbose = FALSE) #> { #> .om <- NULL #> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) #> .parsingFunction <- sosParsers(sos)[[.name]] #> if (!is.null(.parsingFunction)) { #> if (verbose) #> cat("[parseOM] Matched name for parser is", .name, #> "\n") #> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) #> if (verbose) #> cat("[parseOM] Done parsing\n") #> } #> else { #> warning(paste("[parseOM] No parsing function for given element", #> .name)) #> } #> return(.om) #> } #> <environment: namespace:sos4R> #> #> $`ows:ExceptionReport` #> function (obj, verbose = FALSE) #> { #> if (verbose) #> cat("[parseOwsExceptionReport] Starting ...\n") #> .docRoot <- xml2::xml_root(x = obj) #> .version <- xml2::xml_attr(x = .docRoot, attr = "version") #> .lang <- xml2::xml_attr(x = .docRoot, attr = "lang", default = NA_character_) #> .exceptionsXML <- xml2::xml_find_all(x = .docRoot, xpath = paste0("//", #> owsExceptionName), ns = SosAllNamespaces()) #> .exceptions = sapply(.exceptionsXML, parseOwsException) #> if (verbose) #> cat("[parseOwsExceptionReport]", length(.exceptions), #> "exceptions.") #> .report <- OwsExceptionReport(version = .version, lang = .lang, #> exceptions = .exceptions) #> return(.report) #> } #> <environment: namespace:sos4R> #> #> $GetDataAvailabilityResponse #> function (obj, sos, verbose = FALSE) #> { #> if (verbose) #> cat("[parseGetDataAvailabilityResponse]") #> if (sos@version != sos200_version) { #> stop(paste0("[parseGetDataAvailabilityResponse] SOS version 2.0 required! Received '", #> sos@version, "'")) #> } #> .gdaMembers <- xml2::xml_find_all(x = obj, xpath = sosGDAMemberName, #> ns = SosAllNamespaces()) #> if (verbose) #> cat("[parseGetDataAvailabilityResponse] with", length(.gdaMembers), #> "element(s).\n") #> phenTimeCache <- list() #> .parsedGDAMembers <- lapply(.gdaMembers, .parseGDAMember, #> sos, phenTimeCache, verbose) #> if (verbose) #> cat("[parseGetDataAvailabilityResponse] Done. Processed", #> length(.parsedGDAMembers), "elements") #> return(.parsedGDAMembers) #> } #> <environment: namespace:sos4R> #> #> $`om:Measurement` #> function (obj, sos, verbose = FALSE) #> { #> if (verbose) #> cat("[parseMeasurement]\n") #> .samplingTimeXml <- xml2::xml_child(x = obj, search = omSamplingTimeName, #> ns = SosAllNamespaces()) #> .samplingTime <- parseTime(obj = .samplingTimeXml, format = sosTimeFormat(sos), #> verbose = verbose) #> .procedure <- xml2::xml_attr(x = xml2::xml_child(x = obj, #> search = omProcedureName, ns = SosAllNamespaces()), attr = "href") #> .observedProperty <- SwePhenomenonProperty(href = xml2::xml_attr(x = xml2::xml_child(x = obj, #> search = omObservedPropertyName, ns = SosAllNamespaces()), #> attr = "href")) #> .featureOfInterest <- parseFOI(xml2::xml_child(x = obj, search = omFeatureOfInterestName, #> ns = SosAllNamespaces()), sos = sos, verbose = verbose) #> .result <- parseMeasure(xml2::xml_child(x = obj, search = omResultName, #> ns = SosAllNamespaces())) #> .measurement <- OmMeasurement(samplingTime = .samplingTime, #> procedure = .procedure, observedProperty = .observedProperty, #> featureOfInterest = .featureOfInterest, result = .result) #> return(.measurement) #> } #> <environment: namespace:sos4R> #> #> $`om:member` #> function (obj, sos, verbose = FALSE) #> { #> if (xml2::xml_length(x = obj) >= 1) { #> .child <- xml2::xml_child(obj) #> if (verbose) #> cat("[parseObservationProperty] Parsing child of member:", #> xml2::xml_name(x = .child, ns = SosAllNamespaces()), #> "\n") #> .mResult <- parseOM(.child, sos, verbose) #> } #> else { #> if (verbose) #> cat("[parseObservationProperty] Member has no direct child!\n") #> .href <- xml2::xml_attr(x = obj, attr = "href", default = NA_character_) #> if (!is.na(.href)) { #> warning("Only reference was returned:", .href) #> .mResult <- OmObservationProperty(href = .href) #> } #> else { #> warning("No observation found!") #> .mResult <- OmObservationProperty() #> } #> } #> return(.mResult) #> } #> <environment: namespace:sos4R> #> #> $`om:Observation` #> function (obj, sos, verbose = FALSE) #> { #> .id <- xml2::xml_attr(x = obj, attr = "id", default = NA_character_) #> if (verbose) #> cat("[parseObservation]", .id, "\n") #> .procedure <- xml2::xml_attr(x = xml2::xml_child(x = obj, #> search = omProcedureName, ns = SosAllNamespaces()), attr = "href", #> default = NA_character_) #> .observedProperty <- parsePhenomenonProperty(xml2::xml_child(x = obj, #> search = omObservedPropertyName, ns = SosAllNamespaces()), #> verbose = verbose) #> if (!is.na(xml2::xml_child(x = obj, search = omSamplingTimeName, #> ns = SosAllNamespaces()))) { #> .samplingTime <- parseTime(obj = xml2::xml_child(x = obj, #> search = omSamplingTimeName, ns = SosAllNamespaces()), #> format = sosTimeFormat(sos = sos), verbose = verbose) #> } #> else { #> warning("om:samplingTime is mandatory in om:Observation, but is missing!") #> .samplingTime <- NULL #> } #> if (!is.na(xml2::xml_child(x = obj, search = omFeatureOfInterestName, #> ns = SosAllNamespaces()))) { #> .featureOfInterest <- parseFOI(xml2::xml_child(x = obj, #> search = omFeatureOfInterestName, ns = SosAllNamespaces()), #> sos = sos, verbose = verbose) #> } #> else { #> warning("om:featureOfInterest is mandatory in om:Observation, but is missing!") #> .featureOfInterest <- NULL #> } #> .resultParsingFunction <- sosParsers(sos)[[omResultName]] #> .result <- .resultParsingFunction(xml2::xml_child(x = obj, #> search = omResultName, ns = SosAllNamespaces()), sos, #> verbose) #> if (!is.na(xml2::xml_child(x = obj, search = omResultTimeName, #> ns = SosAllNamespaces()))) { #> .resultTime <- parseTime(obj = xml2::xml_child(x = obj, #> search = omResultTimeName, ns = SosAllNamespaces()), #> format = sosTimeFormat(sos = sos), verbose = verbose) #> } #> else { #> .resultTime <- NULL #> } #> .obs <- OmObservation(samplingTime = .samplingTime, procedure = .procedure, #> observedProperty = .observedProperty, featureOfInterest = .featureOfInterest, #> result = .result) #> return(.obs) #> } #> <environment: namespace:sos4R> #> #> $`om:ObservationCollection` #> function (obj, sos, verbose = FALSE) #> { #> .members <- xml2::xml_find_all(x = obj, xpath = omMemberName, #> ns = SosAllNamespaces()) #> if (verbose) #> cat("[parseObservationCollection] with ", length(.members), #> "element(s).\n") #> .env <- xml2::xml_child(x = obj, search = paste0(gmlBoundedByName, #> "/", gmlEnvelopeName)) #> if (!is.na(.env)) { #> .boundedBy <- list(srsName = xml2::xml_attr(x = .env, #> attr = "srsName", ns = SosAllNamespaces()), lowerCorner = xml2::xml_text(x = xml2::xml_child(x = .env, #> search = gmlLowerCornerName, ns = SosAllNamespaces())), #> upperCorner = xml2::xml_text(x = xml2::xml_child(x = .env, #> search = gmlUpperCornerName, ns = SosAllNamespaces()))) #> if (verbose) #> cat("[parseObservationCollection] Parsed envelope:", #> toString(.boundedBy), "\n") #> if (sosSwitchCoordinates(sos)) { #> warning("Switching coordinates in envelope of ObservationCollection!") #> .origLC <- strsplit(x = .boundedBy[["lowerCorner"]], #> split = " ") #> .lC <- paste(.origLC[[1]][[2]], .origLC[[1]][[1]]) #> .origUC <- strsplit(x = .boundedBy[["upperCorner"]], #> split = " ") #> .uC <- paste(.origUC[[1]][[2]], .origUC[[1]][[1]]) #> .boundedBy <- list(srsName = xml2::xml_attr(x = .env, #> attr = "srsName"), lowerCorner = .lC, upperCorner = .uC) #> } #> } #> else { #> if (verbose) #> cat("[parseObservationCollection] Empty envelope!\n") #> .boundedBy <- list() #> } #> .resultList <- lapply(X = .members, FUN = parseOM, sos = sos, #> verbose = verbose) #> names(.resultList) <- lapply(X = .members, FUN = function(member) { #> children <- xml2::xml_children(member) #> idOrName <- xml2::xml_attr(children, attr = "id", default = xml2::xml_name(children)) #> if (length(idOrName) < 1) { #> xml2::xml_name(member) #> } #> else { #> idOrName #> } #> }) #> if (is.list(.resultList)) { #> .obsColl <- OmObservationCollection(members = .resultList, #> boundedBy = .boundedBy) #> } #> else { #> .obsColl <- OmObservationCollection(members = list(.resultList), #> boundedBy = .boundedBy) #> } #> if (verbose) #> cat("[parseObservationCollection] Done. Processed", length(.obsColl), #> "elements:", names(.obsColl), "\n") #> return(.obsColl) #> } #> <environment: namespace:sos4R> #> #> $`om:result` #> function (obj, sos, verbose = FALSE) #> { #> if (verbose) #> cat("[parseResult] Starting ...\n") #> .result <- NULL #> .children <- xml2::xml_children(x = obj) #> if (verbose) #> cat("[parseResult]", length(.children), " non-text nodes, names:", #> xml2::xml_name(.children), "\n") #> if (length(.children) == 0) { #> .children <- xml2::xml_children(x = obj) #> stop("Continue implementation here: OM-methods-parsing.R") #> cat("[parseResult] No non-text nodes in result, returning NULL.\n") #> .typeAttributValue <- xml2::xml_attr(x = obj, attr = om20ResultTypeAttributeName, #> default = NA_character_) #> .typeWithQualifiedname <- strsplit(.typeAttributValue, #> ":") #> .type <- NA_character_ #> if (length(.typeWithQualifiedname) > 0) { #> if (length(.typeWithQualifiedname[[1]]) > 1) { #> .type <- .typeWithQualifiedname[[1]][2] #> } #> } #> if (!is.na(.type)) { #> if (.type == om20ResultMeasureTypeName) { #> return(xml2::xml_text(x = obj)) #> } #> } #> return(NULL) #> } #> .name <- xml2::xml_name(x = .children[[1]], ns = SosAllNamespaces()) #> if (.name == sweDataArrayName) { #> if (verbose) #> cat("[parseResult] Parsing result with swe:DataArray.\n") #> .dataArrayParsingFunction <- sosParsers(sos)[[sweDataArrayName]] #> .result <- .dataArrayParsingFunction(.children[[1]], #> sos, verbose) #> } #> else if (.name == xmlTextNodeName) { #> .result <- as.numeric(xml2::xml_text(x = .children)) #> if (is.na(.result)) { #> .result <- xml2::xml_text(x = .children, trim = TRUE) #> } #> } #> else { #> warning(paste("[parseResult] Parsing of given result is NOT supported:", #> xml2::xml_name(x = .children[[1]], ns = SosAllNamespaces()), #> "-- only", sweDataArrayName, " or text nodes containing strings or numbers can be parsed.")) #> } #> if (is.null(.result)) { #> stop("[parseResult] result is null! Given result:\n") #> print(obj) #> } #> if (verbose) #> cat("[parseResult] Done\n") #> return(.result) #> } #> <environment: namespace:sos4R> #> #> $`swe:DataArray` #> function (obj, sos, verbose = FALSE) #> { #> .elementCount <- xml2::xml_text(xml2::xml_find_first(x = obj, #> xpath = "./swe:elementCount/swe:Count/swe:value", ns = SosAllNamespaces())) #> if (verbose) #> cat("[parseDataArray] Parsing DataArray with", .elementCount, #> "elements.\n") #> .elementTypeParser <- sosParsers(sos)[[sweElementTypeName]] #> .elementTypeXml <- xml2::xml_child(x = obj, search = sweElementTypeName, #> ns = SosAllNamespaces()) #> .fields <- .elementTypeParser(obj = .elementTypeXml, sos = sos, #> verbose = verbose) #> if (verbose) #> cat("[parseDataArray] Parsed field descriptions:", toString(.fields), #> "\n") #> .encParser <- sosParsers(sos)[[sweEncodingName]] #> .encodingXml <- xml2::xml_child(x = obj, search = sweEncodingName, #> ns = SosAllNamespaces()) #> .encoding <- .encParser(obj = .encodingXml, sos = sos, verbose = verbose) #> if (verbose) #> cat("[parseDataArray] Parsed encoding description:", #> toString(.encoding), "\n") #> .valParser <- sosParsers(sos)[[sweValuesName]] #> .values <- .valParser(values = xml2::xml_child(x = obj, search = sweValuesName, #> ns = SosAllNamespaces()), fields = .fields, encoding = .encoding, #> sos = sos, verbose = verbose) #> return(.values) #> } #> <environment: namespace:sos4R> #> #> $`swe:elementType` #> function (obj, sos, verbose = FALSE) #> { #> elementTypeHref <- stringr::str_remove_all(xml2::xml_attr(x = obj, #> attr = "href"), "#") #> if (verbose) #> cat("[parseElementType] Got child", xml2::xml_name(xml2::xml_children(obj)), #> "and id", elementTypeHref, "for object", xml2::xml_name(obj), #> "\n") #> if (is.na(elementTypeHref)) { #> elementType <- obj #> } #> else { #> root <- xml2::xml_root(obj) #> elementType <- xml2::xml_parent(xml2::xml_find_first(x = root, #> xpath = paste0("//*[@gml:id='", elementTypeHref, #> "']"))) #> if (is.na(elementType)) { #> stop("Got ", sweElementTypeName, " with a reference (href) but cannot find definition - cannot parse!", #> toString(obj)) #> } #> else { #> if (verbose) #> cat("[parseDataArray] Found elementType via reference", #> elementTypeHref, "\n") #> } #> } #> simpleDataRecord <- xml2::xml_child(x = elementType, search = sweSimpleDataRecordName, #> ns = SosAllNamespaces()) #> dataRecord <- xml2::xml_child(x = elementType, search = sweDataRecordName, #> ns = SosAllNamespaces()) #> if (!is.na(simpleDataRecord) || !is.na(dataRecord)) { #> if (!is.na(simpleDataRecord)) #> dr <- simpleDataRecord #> else dr <- dataRecord #> fields <- xml2::xml_find_all(x = dr, xpath = sweFieldName, #> ns = SosAllNamespaces()) #> if (verbose) #> cat("[parseElementType] Got data record with", length(fields), #> "fields. \n") #> parsedFields <- lapply(fields, parseField, sos = sos, #> verbose = verbose) #> names <- sapply(parsedFields, "[", "name") #> names(parsedFields) <- names #> if (verbose) #> cat("[parseElementType] Names of parsed fields:", #> names(fields), "\n") #> return(parsedFields) #> } #> else { #> stop(paste("Cannot parse swe:elementType, only children of type", #> sweSimpleDataRecordName, "and", sweDataRecordName, #> "are supported!")) #> } #> } #> <environment: namespace:sos4R> #> #> $`swe:encoding` #> function (obj, sos, verbose = FALSE) #> { #> .textBlock <- xml2::xml_child(x = obj, search = sweTextBlockName, #> ns = SosAllNamespaces()) #> .textEncoding <- xml2::xml_child(x = obj, search = sweTextEncodingName, #> ns = SosAllNamespaces()) #> if (!(is.na(.textBlock))) { #> .tb <- parseTextBlock(.textBlock) #> return(.tb) #> } #> else if (!(is.na(.textEncoding))) { #> .tb <- parseTextEncoding(.textEncoding) #> return(.tb) #> } #> else { #> stop(paste("Cannot parse swe:encoding, only", sweTextBlockName, #> "and", sweTextEncodingName, "are supported!")) #> } #> } #> <environment: namespace:sos4R> #> #> $`swe:values` #> function (values, fields, encoding, sos, verbose = FALSE) #> { #> if (verbose) #> cat("[parseValues] Parsing swe:values using", toString(encoding), #> "and", length(fields), "fields:", toString(names(fields)), #> "\n") #> if (!(inherits(encoding, "SweTextBlock") || inherits(encoding, #> "SweTextEncoding"))) { #> stop("Handling for given encoding not implemented!") #> } #> .converters <- sosDataFieldConverters(sos) #> .blockLines <- strsplit(x = xml2::xml_text(x = values), split = encoding@blockSeparator) #> .tokenLines <- sapply(.blockLines, strsplit, split = encoding@tokenSeparator) #> if (verbose) #> cat("[parseValues] Parsing values from lines: ", toString(.tokenLines), #> "\n") #> .tempId = "tempID" #> .data <- data.frame(seq(1, length(.tokenLines))) #> names(.data) <- .tempId #> .fieldCount <- length(fields) #> for (.currentFieldIdx in seq(1, .fieldCount)) { #> if (verbose) #> cat("[parseValues] Processing field index", .currentFieldIdx, #> "of", .fieldCount, "\n") #> .currentValues <- sapply(.tokenLines, "[[", .currentFieldIdx) #> if (verbose) #> cat("[parseValues] Current values: ", toString(.currentValues), #> "\n") #> .currentField <- fields[[.currentFieldIdx]] #> if (verbose) #> cat("[parseValues] Parsing field", paste(.currentField), #> "\n") #> .fieldDefinition <- .currentField[["definition"]] #> .method <- .converters[[.fieldDefinition]] #> if (verbose) { #> cat("[parseValues] Using converter:\n") #> print(.method) #> } #> if (is.null(.method)) { #> if (!is.na(.currentField["uom"])) { #> .method <- .converters[[.currentField[["uom"]]]] #> if (is.null(.method)) { #> warning(paste("No converter for the unit of measurement ", #> .currentField[["uom"]], " with the definition ", #> .currentField[["definition"]], "! Trying a default, but you can add one when creating a SOS using", #> "SosDataFieldConvertingFunctions().\n")) #> .method <- .converters[["fallBack"]] #> } #> } #> else { #> warning(paste("No converter found for the given field", #> toString(.currentField), "using fallBack converter.")) #> .method <- .converters[["fallBack"]] #> } #> } #> if (verbose) { #> cat("[parseValues] Using converter function:\n") #> show(.method) #> } #> .currentValues <- .method(x = .currentValues, sos = sos) #> if (verbose) #> cat("[parseValues] Binding additional data.frame for", #> .currentField[["name"]], "-- value range", toString(range(.currentValues)), #> "\n") #> .newData <- data.frame(.currentValues) #> .newDataName <- .currentField[["name"]] #> names(.newData) <- .cleanupColumnName(.newDataName) #> if (verbose) #> cat("[parseValues] Added column name:", names(.newData), #> "\n") #> .data <- cbind(.data, .newData) #> if (verbose) { #> cat("[parseValues] The new bound data frame (one variable the a temp id):\n") #> str(.data) #> } #> .addAttrs <- as.list(.currentField) #> names(.addAttrs) <- .sosParseFieldReadable[names(.currentField)] #> .lastColumn <- dim(.data)[[2]] #> .oldAttrs <- attributes(.data[, .lastColumn]) #> attributes(.data[, .lastColumn]) <- c(as.list(.oldAttrs), #> .addAttrs) #> if (verbose) #> cat("[parseValues] Added attributes to new data:", #> toString(.addAttrs), "[ names: ", toString(names(.addAttrs)), #> "]", "\n[parseValues] Old attributes list is", #> toString(.oldAttrs), "\n[parseValues] New attributes list is", #> toString(attributes(.data[, .lastColumn])), "\n") #> } #> if (verbose) #> cat("[parseValues] Removing temporary first column\n") #> .data <- .data[, !colnames(.data) %in% .tempId] #> if (verbose) { #> cat("[parseValues] returning final data frame:\n") #> str(.data) #> } #> return(.data) #> } #> <environment: namespace:sos4R> #> #> $`swe:Position` #> function (obj, sos, verbose = FALSE) #> { #> .rF <- xml2::xml_attr(x = obj, attr = "referenceFrame", ns = SosAllNamespaces()) #> if (verbose) #> cat("[parseSwePosition] with referenceFrame", .rF, "\n") #> .location <- xml2::xml_child(x = obj, search = sweLocationName, #> ns = SosAllNamespaces()) #> .parser <- sosParsers(sos)[[sweLocationName]] #> .pos <- .parser(.location, sos = sos, verbose = verbose) #> .oldAttrs <- attributes(.pos) #> attributes(.pos) <- c(.oldAttrs, list(referenceFrame = .rF)) #> return(.pos) #> } #> <environment: namespace:sos4R> #> #> $`swe:location` #> function (obj, sos, verbose = FALSE) #> { #> .vector <- xml2::xml_child(x = obj, search = sweVectorName, #> ns = SosAllNamespaces()) #> .id <- xml2::xml_attr(x = obj, attr = "id") #> if (verbose) #> cat("[parseSweLocation] with id", .id, "\n") #> .parser <- sosParsers(sos)[[sweVectorName]] #> location <- .parser(.vector, sos = sos, verbose = verbose) #> return(location) #> } #> <environment: namespace:sos4R> #> #> $`swe:Vector` #> function (obj, sos, verbose = FALSE) #> { #> .children <- xml2::xml_find_all(x = obj, xpath = sweCoordinateName, #> ns = SosAllNamespaces()) #> .parser <- sosParsers(sos)[[sweCoordinateName]] #> .vector <- lapply(X = .children, FUN = .parser, sos = sos, #> verbose = verbose) #> names(.vector) <- sapply(.vector, function(current) { #> return(current$axisID) #> }) #> if (verbose) #> cat("[parseSweVector] parsed vector with coordinates: ", #> toString(names(.vector)), "\n") #> return(.vector) #> } #> <environment: namespace:sos4R> #> #> $`swe:coordinate` #> function (obj, sos, verbose = FALSE) #> { #> .name <- xml2::xml_attr(x = obj, attr = "name") #> if (verbose) #> cat("[parseSweCoordinate] with name", .name, "\n") #> .quantity <- xml2::xml_child(x = obj, search = sweQuantityName, #> ns = SosAllNamespaces()) #> .axisID <- xml2::xml_attr(x = .quantity, attr = "axisID") #> if (verbose) #> cat("[parseSweCoordinate] axisID: ", .axisID, "\n") #> .uomNode <- xml2::xml_child(x = .quantity, search = sweUomName, #> ns = SosAllNamespaces()) #> .uomCode <- xml2::xml_attr(x = .uomNode, attr = "code", ns = SosAllNamespaces()) #> if (verbose) #> cat("[parseSweCoordinate] uomCode: ", .uomCode, "\n") #> .valueNode <- xml2::xml_child(x = .quantity, search = sweValueName, #> ns = SosAllNamespaces()) #> .value <- as.double(xml2::xml_text(x = .valueNode)) #> if (verbose) #> cat("[parseSweCoordinate] value: ", .value, "\n") #> return(list(name = .name, axisID = .axisID, uomCode = .uomCode, #> value = .value)) #> } #> <environment: namespace:sos4R> #> #> $`om:GeometryObservation` #> function (obj, sos, verbose = FALSE) #> { #> warning("Parsing of om:GeometryObservation is not implemented!") #> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:CategoryObservation` #> function (obj, sos, verbose = FALSE) #> { #> warning("Parsing of om:CategoryObservation is not implemented!") #> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:CountObservation` #> function (obj, sos, verbose = FALSE) #> { #> warning("Parsing of om:CountObservation is not implemented!") #> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:TruthObservation` #> function (obj, sos, verbose = FALSE) #> { #> warning("Parsing of om:TruthObservation is not implemented!") #> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:TemporalObservation` #> function (obj, sos, verbose = FALSE) #> { #> warning("Parsing of om:TemporalObservatio is not implemented!") #> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:ComplexObservation` #> function (obj, sos, verbose = FALSE) #> { #> warning("Parsing of om:ComplexObservation is not implemented!") #> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`text/csv` #> function (obj, verbose = FALSE) #> { #> if (verbose) #> cat("[parseCSV] Parsing CSV...\n") #> if (inherits(x = obj, what = "data.frame")) { #> if (verbose) #> cat("[parseCSV] Already a data.frame, returning object\n") #> return(obj) #> } #> .lines <- strsplit(x = obj, split = "\n")[[1]] #> .data <- do.call(what = "strsplit", args = list(.lines, split = ",")) #> .names <- .data[[1]] #> .newNames <- c() #> for (.n in .names) { #> .newNames <- c(.newNames, gsub(pattern = "\"", replacement = "", #> x = .n)) #> } #> .names <- .newNames #> .rows <- length(.data) #> if (verbose) #> cat("[parseCSV] Got", .rows, "lines of data.\n") #> .df <- NULL #> for (.r in seq(2, .rows)) { #> if (verbose) #> cat("[parseCSV] Processing row in CSV:", .data[[.r]], #> "\n") #> .row.df <- as.data.frame(.data[[.r]][1]) #> names(.row.df) <- .names[[1]] #> for (i in seq(2, length(.names))) { #> .df <- as.data.frame(.data[[.r]][i]) #> names(.df) <- .names[[i]] #> .row.df <- cbind(.row.df, .df) #> } #> if (is.null(.df)) #> .df <- .row.df #> else .df <- do.call(rbind, list(.df, .row.df)) #> } #> if (verbose) #> cat("[parseCSV] Done.\n") #> return(.df) #> } #> <environment: namespace:sos4R> #> #> $`text/xml;subtype="om/1.0.0"` #> function (obj, sos, verbose = FALSE) #> { #> .om <- NULL #> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) #> .parsingFunction <- sosParsers(sos)[[.name]] #> if (!is.null(.parsingFunction)) { #> if (verbose) #> cat("[parseOM] Matched name for parser is", .name, #> "\n") #> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) #> if (verbose) #> cat("[parseOM] Done parsing\n") #> } #> else { #> warning(paste("[parseOM] No parsing function for given element", #> .name)) #> } #> return(.om) #> } #> <environment: namespace:sos4R> #> #> $`application/vnd.google-earth.kml+xml` #> function (obj, sos, verbose = FALSE) #> { #> if (verbose) #> cat("[parseKML] Processing KML... returning raw object!\n") #> return(obj) #> } #> <environment: namespace:sos4R> #> #> $kml #> function (obj, sos, verbose = FALSE) #> { #> if (verbose) #> cat("[parseKML] Processing KML... returning raw object!\n") #> return(obj) #> } #> <environment: namespace:sos4R> #> #> $`text/xml` #> function (obj, sos, verbose = FALSE) #> { #> .om <- NULL #> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) #> .parsingFunction <- sosParsers(sos)[[.name]] #> if (!is.null(.parsingFunction)) { #> if (verbose) #> cat("[parseOM] Matched name for parser is", .name, #> "\n") #> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) #> if (verbose) #> cat("[parseOM] Done parsing\n") #> } #> else { #> warning(paste("[parseOM] No parsing function for given element", #> .name)) #> } #> return(.om) #> } #> <environment: namespace:sos4R> #>
# NOT RUN { # Replace an encoding function myEncoding <- function(object, v) { return(str(object)) } sos = SOS(url = "http://mysos.com/sos", encoders = SosEncodingFunctions("POST" = myPostEncoding)) # Use custom converting function and connection method. This mechanism works the # same for encoders and decoders. myConverters <- SosDataFieldConvertingFunctions( "myNumericUnit" = sosConvertDouble, mySos <- SOS(sos.url, binding = "KVP", dataFieldConverters = myConverters) sosDataFieldConverters(mySos) # inspecting XML using dummy parsing function sos = SOS(url = "http://mysos.com/sos", parsers = SosDisabledParsers) describeSensor(sos, sosProcedures(sos)[[1]]) # }
# a list of example services SosExampleServices()
#> $`NOAA National Data Buoy Center` #> [1] "https://sdf.ndbc.noaa.gov/sos/server.php" #> #> $`WSV PegelOnline` #> [1] "www.pegelonline.wsv.de/webservices/gis/sos" #>
# a named list of all defaults SosDefaults()
#> $sosDefaultCharacterEncoding #> [1] "UTF-8" #> #> $sosDefaultDescribeSensorOutputFormat #> [1] "text/xml;subtype=\"sensorML/1.0.1\"" #> #> $sosDefaultGetCapSections #> [1] "All" #> #> $sosDefaultGetCapAcceptFormats #> [1] "text/xml" #> #> $sosDefaultGetCapOwsVersion #> [1] "1.1.0" #> #> $sosDefaultGetObsResponseFormat #> [1] "text/xml;subtype=\"om/1.0.0\"" #> #> $sosDefaultTimeFormat #> [1] "%Y-%m-%dT%H:%M:%OS" #> #> $sosDefaultFilenameTimeFormat #> [1] "%Y-%m-%d_%H-%M-%OS" #> #> $sosDefaultTempOpPropertyName #> [1] "om:samplingTime" #> #> $sosDefaultTemporalOperator #> [1] "TM_During" #> #> $sosDefaultSpatialOpPropertyName #> [1] "urn:ogc:data:location" #> #> $sosDefaultColumnNameFeatureIdentifier #> [1] "feature" #> #> $sosDefaultColumnNameLat #> [1] "lat" #> #> $sosDefaultColumnNameLon #> [1] "lon" #> #> $sosDefaultColumnNameSRS #> [1] "SRS" #> #> $sosDefaultReferenceFrameSensorDescription #> [1] "urn:ogc:def:crs:EPSG:4326" #>
# replace the parsing functions with the default ones
# NOT RUN { sos <- SosResetParsingFunctions(sos) # }
# parsing options used by xml2 SosDefaultParsingOptions()
#> [1] "RECOVER"