Skip to content

Commit

Permalink
#9 implementation for WCS Coverage descriptions
Browse files Browse the repository at this point in the history
  • Loading branch information
eblondel committed Feb 14, 2022
1 parent e4ea9ad commit a3a728d
Show file tree
Hide file tree
Showing 24 changed files with 1,561 additions and 40 deletions.
10 changes: 5 additions & 5 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: ows4R
Version: 0.2-1
Date: 2022-01-26
Version: 0.3
Date: 2022-02-14
Title: Interface to OGC Web-Services (OWS)
Authors@R: c(person("Emmanuel", "Blondel", role = c("aut", "cre"), email = "emmanuel.blondel1@gmail.com", comment = c(ORCID = "0000-0002-5870-5762")),
person("Alexandre", "Bennici", role = c("ctb"), comment = c(ORCID = "0000-0003-2160-3487")),
Expand All @@ -10,9 +10,9 @@ Depends: R (>= 3.3.0), methods, geometa, keyring
Imports: R6, httr, openssl, XML (>= 3.96-1.1), sf, rgdal, parallel
Suggests: testthat
Description: Provides an Interface to Web-Services defined as standards by the Open Geospatial Consortium (OGC), including Web Feature Service
(WFS) for vector data, Catalogue Service (CSW) for ISO/OGC metadata, and associated standards such as the common web-service specification (OWS) and
OGC Filter Encoding. Partial support is provided for the Web Map Service (WMS) and Web Processing Service (WPS). The purpose is to add support for
additional OGC service standards such as Web Coverage Service (WCS), Web Coverage Processing Service (WCPS) or OGC API.
(WFS) for vector data, Web Coverage Service (WCS), Catalogue Service (CSW) for ISO/OGC metadata, and associated standards such as the common
web-service specification (OWS) and OGC Filter Encoding. Partial support is provided for the Web Map Service (WMS) and Web Processing Service (WPS).
The purpose is to add support for additional OGC service standards such as Web Coverage Processing Service (WCPS) or OGC API.
License: MIT + file LICENSE
URL: https://github.com/eblondel/ows4R, https://www.ogc.org/standards
BugReports: https://github.com/eblondel/ows4R/issues
Expand Down
6 changes: 6 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -45,7 +45,13 @@ export(PropertyIsNull)
export(UnaryLogicOpType)
export(WCSCapabilities)
export(WCSClient)
export(WCSCoverageDescription)
export(WCSCoverageDomain)
export(WCSCoverageSpatialDomain)
export(WCSCoverageSummary)
export(WCSCoverageTemporalDomain)
export(WCSDescribeCoverage)
export(WCSGridCRS)
export(WFSCapabilities)
export(WFSClient)
export(WFSDescribeFeatureType)
Expand Down
13 changes: 13 additions & 0 deletions R/WCSClient.R
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,19 @@ WCSClient <- R6Class("WCSClient",
#'@description Reloads WCS capabilities
reloadCapabilities = function(){
self$capabilities = WCSCapabilities$new(self$url, self$version, logger = self$loggerType)
},

#'@description Describes coverage
#'@param identifier identifier
#'@return an object of class \link{WCSCoverageDescription}
describeCoverage = function(identifier){
self$INFO(sprintf("Fetching coverageSummary description for '%s' ...", identifier))
describeCoverage <- NULL
cov <- self$capabilities$findCoverageSummaryById(identifier, exact = TRUE)
if(is(cov, "WFSCoverageSummary")){
describeCoverage <- cov$getDescription()
}
return(describeCoverage)
}
)
)
Expand Down
128 changes: 128 additions & 0 deletions R/WCSCoverageDescription.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,128 @@
#' WCSCoverageDescription
#'
#' @docType class
#' @export
#' @keywords OGC WCS Coverage
#' @return Object of \code{\link{R6Class}} modelling a WCS coverage summary
#' @format \code{\link{R6Class}} object.
#'
#' @note Class used internally by ows4R.
#'
#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
#'
WCSCoverageDescription <- R6Class("WCSCoverageDescription",
inherit = geometa::GMLCOVAbstractCoverage,
private = list(
version = NA,
owsVersion = NA,
#fetchCoverageDescription (for WCS version 1 elements)
fetchCoverageDescription = function(xmlObj, serviceVersion, owsVersion){
children <- xmlChildren(xmlObj)

covId <- switch(substr(serviceVersion,1,3),
"1.0" = xmlValue(children$name),
"1.1" = xmlValue(children$Identifier)
)

supportedCrs <- list()
if(substr(serviceVersion,1,3)=="1.0"){
crsList <- children[names(children) == "supportedCRSs"][[1]]
supportedCrs <- as.vector(sapply(xmlChildren(crsList), xmlValue))
}else{
supportedCrs <- as.vector(sapply(children[names(children) == "SupportedCRS"], xmlValue))
}

supportedFormats <- list()
if(substr(serviceVersion,1,3)=="1.0"){
formatList <- children[names(children) == "supportedFormats"][[1]]
supportedFormats <- as.vector(sapply(xmlChildren(formatList), xmlValue))
}else{
supportedFormats <- as.vector(sapply(children[names(children) == "SupportedFormat"], xmlValue))
}

domain <- NULL
if(substr(serviceVersion,1,3)=="1.0"){
domain <- WCSCoverageDomain$new(xmlObj = children$domainSet, serviceVersion, owsVersion)
}else if(substr(serviceVersion,1,3)=="1.1"){
domain <- WCSCoverageDomain$new(xmlObj = children$Domain, serviceVersion, owsVersion)
}

range <- children$Range #TODO

covDescription <- list(
CoverageId = covId,
SupportedCRS = supportedCrs,
SupportedFormat = supportedFormats,
Domain = domain,
Range = range
)
return(covDescription)
}
),
public = list(
#'@field CoverageId coverage ID
CoverageId = NULL,
#'@field SupportedCRS supported CRS
SupportedCRS = list(),
#'@field SupportedFormat supported Format
SupportedFormat = list(),
#'@field Domain domain
Domain = list(),
#'@field Range range
Range = list(),
#'@field ServiceParameters service parmaeters
ServiceParameters = list(),

#'@description Initializes an object of class \link{WCSCoverageDescription}
#'@param xmlObj an object of class \link{XMLInternalNode-class} to initialize from XML
#'@param serviceVersion service version
#'@param owsVersion OWS version
#'@param logger logger
initialize = function(xmlObj, serviceVersion, owsVersion, logger = NULL){
super$initialize(xml = xmlObj)
private$version = serviceVersion
private$owsVersion = owsVersion
if(startsWith(serviceVersion, "1")){
covDescription <- private$fetchCoverageDescription(xmlObj, serviceVersion, owsVersion)
self$CoverageId <- covDescription$CoverageId
self$SupportedCRS <- covDescription$SupportedCRS
self$SupportedFormat <- covDescription$SupportedFormat
self$Domain <- covDescription$Domain
self$Range <- covDescription$Range
}
},

#'@description getId
#'@return the coverage id, object of class \code{character}
getId = function(){
id <- NULL
if(startsWith(private$version, "1")){
id <- self$CoverageId
}else if(startsWith(private$version, "2")){
id <- self$attrs[["gml:id"]]
}
return(id)
},

#'@description getSupported CRS. Applies to WCS 1 coverage descriptions
getSupportedCRS = function(){
return(self$SupportedCRS)
},

#'@description get supported formats. Applies to WCS 1 coverage descriptions
getSupportedFormats = function(){
return(self$SupportedFormat)
},

#'@description get domain. Applies to WCS 1 coverage descriptions
getDomain = function(){
return(self$Domain)
},

#'@description get range. Applies to WCS 1.0 coverage descriptions
getRange = function(){
return(self$Range)
}

)
)
100 changes: 100 additions & 0 deletions R/WCSCoverageDomain.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,100 @@
#' WCSCoverageDomain
#'
#' @docType class
#' @export
#' @keywords OGC WCS Coverage domain
#' @return Object of \code{\link{R6Class}} modelling a WCS coverage domain
#' @format \code{\link{R6Class}} object.
#'
#' @note Class used internally by ows4R.
#'
#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
#'
WCSCoverageDomain <- R6Class("WCSCoverageDomain",
inherit = OGCAbstractObject,
private = list(
capabilities = NULL,
url = NA,
version = NA,

#fetchDomain
fetchDomain = function(xmlObj, serviceVersion, owsVersion){

children <- xmlChildren(xmlObj)

#spatialDomain
spatialDomain <- NULL
if(startsWith(serviceVersion, "1.0")){
if("spatialDomain" %in% names(children)){
spatialDomain <- WCSCoverageSpatialDomain$new(
xmlObj = children$spatialDomain,
serviceVersion, owsVersion
)
}
}else if(startsWith(serviceVersion, "1.1")){
if("SpatialDomain" %in% names(children)){
spatialDomain <- WCSCoverageSpatialDomain$new(
xmlObj = children$SpatialDomain,
serviceVersion, owsVersion
)
}
}

#temporalDomain
temporalDomain <- NULL
if(startsWith(serviceVersion, "1.0")){
if("temporalDomain" %in% names(children)){
temporalDomain <- WCSCoverageTemporalDomain$new(
xmlObj = children$temporalDomain,
serviceVersion, owsVersion
)
}
}else if(startsWith(serviceVersion, "1.1")){
if("TemporalDomain" %in% names(children)){
temporalDomain <- WCSCoverageTemporalDomain$new(
xmlObj = children$TemporalDomain,
serviceVersion, owsVersion
)
}
}

domain <- list(
spatialDomain = spatialDomain,
temporalDomain = temporalDomain
)
return(domain)
}

),
public = list(
#'@field spatialDomain spatial domain
spatialDomain = NULL,
#'@field temporalDomain temporal domain
temporalDomain = NULL,

#'@description Initializes an object of class \link{WCSCoverageDomain}
#'@param xmlObj an object of class \link{XMLInternalNode-class} to initialize from XML
#'@param serviceVersion service version
#'@param owsVersion OWS version
#'@param logger logger
initialize = function(xmlObj, serviceVersion, owsVersion, logger = NULL){
super$initialize(logger = logger)
domain = private$fetchDomain(xmlObj, serviceVersion, owsVersion)
self$spatialDomain = domain$spatialDomain
self$temporalDomain = domain$temporalDomain
},

#'@description Get spatial domain
#'@return object of class \link{WCSCoverageSpatialDomain}
getSpatialDomain = function(){
return(self$spatialDomain)
},

#'@description Get spatial domain
#'@return object of class \link{WCSCoverageTemporalDomain}
getTemporalDomain = function(){
return(self$temporalDomain)
}

)
)
Loading

0 comments on commit a3a728d

Please sign in to comment.