#9 add WCS 2.1

eblondel · Feb 24, 2022 · 589a349 · 589a349
1 parent 0116c7f
commit 589a349
Show file tree

Hide file tree

Showing 6 changed files with 57 additions and 11 deletions.
diff --git a/R/WCSCapabilities.R b/R/WCSCapabilities.R
@@ -59,6 +59,7 @@ WCSCapabilities <- R6Class("WCSCapabilities",
                             "1.1.1" = "1.1",
                             "2.0.0" = "2.0",
                             "2.0.1" = "2.0",
+                            "2.1.0" = "2.0",
                             NULL
        )
        if(is.null(owsVersion)){

diff --git a/R/WCSCoverageSummary.R b/R/WCSCoverageSummary.R
@@ -30,7 +30,7 @@ WCSCoverageSummary <- R6Class("WCSCoverageSummary",
         covId <- xmlValue(children$name)
       }else if(substr(serviceVersion,1,3)=="1.1"){
         covId <- xmlValue(children$Identifier)
-      }else if(substr(serviceVersion,1,3)=="2.0"){
+      }else if(substr(serviceVersion,1,1)=="2"){
         covId <- xmlValue(children$CoverageId)
       }
 
@@ -349,15 +349,15 @@ WCSCoverageSummary <- R6Class("WCSCoverageSummary",
             stop(sprintf("Format should be one of the allowed values [%s]",
                          paste0(self$getDescription()$getSupportedFormats())))
           }
-        }else if(substr(private$version,1,3)=="2.0"){
+        }else if(substr(private$version,1,1)=="2"){
           #TODO check format in case of WCS2
         }
       }else{
         if(substr(private$version,1,3)=="1.0"){
           format <- "GeoTIFF"
         }else if(substr(private$version,1,3)=="1.1"){
           format <- "image/tiff"
-        }else if(substr(private$version,1,3)=="2.0"){
+        }else if(substr(private$version,1,1)=="2"){
           format <- "image/tiff"
         }
       }
@@ -374,7 +374,7 @@ WCSCoverageSummary <- R6Class("WCSCoverageSummary",
           if(!(crs %in% domainCRS)){
             stop(sprintf("CRS should be one of the allowed domain CRS [%s]", paste(domainCRS, collapse=",")))
           }
-        }else if(substr(private$version,1,3)=="2.0"){
+        }else if(substr(private$version,1,1)=="2"){
           #TODO check crs in case of WCS2
         }
       }else{
@@ -384,7 +384,7 @@ WCSCoverageSummary <- R6Class("WCSCoverageSummary",
         }else if(substr(private$version,1,3)=="1.1"){
           domainCRS <- sapply(self$getDescription()$getDomain()$getSpatialDomain()$BoundingBox, function(x){x$attrs$crs})
           crs <- domainCRS[domainCRS == self$getDescription()$getSupportedCRS()[1]]
-        }else if(substr(private$version,1,3)=="2.0"){
+        }else if(substr(private$version,1,1)=="2"){
           srsName <- self$getDescription()$boundedBy$attrs[["srsName"]]
           srs_elems <- unlist(strsplit(srsName,"/"))
           srid <- srs_elems[length(srs_elems)]
@@ -425,6 +425,23 @@ WCSCoverageSummary <- R6Class("WCSCoverageSummary",
                env <- OWSUtils$checkEnvelopeDatatypes(env)
              }
              env
+           },
+           "2.1" = {
+             env <- self$getDescription()$boundedBy
+             envattrs <- env$attrs
+             #normalize as Envelope based on bbox matrix
+             if(is(env, "GMLEnvelopeWithTimePeriod")){
+               beginPosition <- env$beginPosition
+               endPosition <- env$endPosition
+               bbox <- matrix(c(
+                 env$lowerCorner, format(env$beginPosition$value,"%Y-%m-%dT%H:%M:%S"), 
+                 env$upperCorner, format(env$endPosition$value,"%Y-%m-%dT%H:%M:%S")
+               ),length(env$lowerCorner)+1,2)
+               env <- GMLEnvelope$new(bbox = bbox)
+               env$attrs <- envattrs
+               env <- OWSUtils$checkEnvelopeDatatypes(env)
+             }
+             env
            }
         )
       }else{
@@ -433,7 +450,7 @@ WCSCoverageSummary <- R6Class("WCSCoverageSummary",
         }else if(substr(private$version,1,3) == "1.1"){
           envelope <- GMLEnvelope$new(bbox = bbox)
         }
-        if(substr(private$version,1,3)=="2.0"){
+        if(substr(private$version,1,1)=="2"){
           refEnvelope <- self$getDescription()$boundedBy
           axisLabels <- unlist(strsplit(refEnvelope$attrs$axisLabels, " "))
           if(axisLabels[1]=="Lat") bbox <- rbind(bbox[2,],bbox[1,])
@@ -539,7 +556,7 @@ WCSCoverageSummary <- R6Class("WCSCoverageSummary",
         coverage_data <- coverage$getData()
       #}else if(substr(private$version,1,3)=="2.0"){
       }else{
-        #for WCS 1.0.x / 2.0.x take directly the data
+        #for WCS 1.0.x / 2.x take directly the data
         tmp <- tempfile()
         writeBin(resp, tmp)
         coverage_data <- raster::raster(tmp)

diff --git a/R/WCSDescribeCoverage.R b/R/WCSDescribeCoverage.R
@@ -30,7 +30,7 @@ WCSDescribeCoverage <- R6Class("WCSDescribeCoverage",
        namedParams <- list(service = "WCS", version = serviceVersion)
        if(startsWith(serviceVersion, "1.0")) namedParams <- c(namedParams, coverage = coverageId)
        if(startsWith(serviceVersion, "1.1")) namedParams <- c(namedParams, identifiers = coverageId)
-       if(startsWith(serviceVersion, "2.0")) namedParams <- c(namedParams, coverageId = coverageId)
+       if(startsWith(serviceVersion, "2")) namedParams <- c(namedParams, coverageId = coverageId)
 
        super$initialize(element = private$xmlElement, namespacePrefix = private$xmlNamespacePrefix,
                         capabilities, op, "GET", url, request = "DescribeCoverage",

diff --git a/R/WCSGetCoverage.R b/R/WCSGetCoverage.R
@@ -43,7 +43,7 @@ WCSGetCoverage <- R6Class("WCSGetCoverage",
       namedParams <- list(service = "WCS", version = serviceVersion)
       if(startsWith(serviceVersion, "1.0")) namedParams <- c(namedParams, coverage = coverageId)
       if(startsWith(serviceVersion, "1.1")) namedParams <- c(namedParams, identifier = coverageId)
-      if(startsWith(serviceVersion, "2.0")) namedParams <- c(namedParams, coverageId = coverageId)
+      if(startsWith(serviceVersion, "2")) namedParams <- c(namedParams, coverageId = coverageId)
 
       if(startsWith(serviceVersion,"1.0")){
         if(!is.null(envelope)) namedParams$BBOX <- paste0(as(envelope, "character"), collapse=",")

diff --git a/tests/testthat/test_WCSClient_v2_0.R b/tests/testthat/test_WCSClient_v2_0.R
@@ -32,11 +32,11 @@ test_that("WCS 2.0.1 - GeoServer",{
 })
 
 test_that("WCS 2.0.1 - Rasdaman",{
-  wcs <- WCSClient$new("http://ows.rasdaman.org/rasdaman/ows", "2.0.1", logger = "DEBUG")
+  wcs <- WCSClient$new("https://ows.rasdaman.org/rasdaman/ows", "2.0.1", logger = "DEBUG")
   expect_is(wcs, "WCSClient")
   caps <- wcs$getCapabilities()
   expect_is(caps, "WCSCapabilities")
-  expect_equal(length(caps$getCoverageSummaries()), 35L)
+  expect_equal(length(caps$getCoverageSummaries()), 26L)
 
   cov1 <- caps$findCoverageSummaryById("AverageChloroColor")
   expect_is(cov1, "WCSCoverageSummary")

diff --git a/tests/testthat/test_WCSClient_v2_1_0.R b/tests/testthat/test_WCSClient_v2_1_0.R
@@ -0,0 +1,28 @@
+# test_WCSClient_v2_1_O.R
+# Author: Emmanuel Blondel <emmanuel.blondel1@gmail.com>
+#
+# Description: Integration tests for WCS Client version 1.0
+#=======================
+require(ows4R, quietly = TRUE)
+require(testthat)
+context("WCS")
+
+test_that("WCS 2.1.0 - Rasdaman",{
+  wcs <- WCSClient$new("https://ows.rasdaman.org/rasdaman/ows", "2.1.0", logger = "DEBUG")
+  expect_is(wcs, "WCSClient")
+  caps <- wcs$getCapabilities()
+  expect_is(caps, "WCSCapabilities")
+  expect_equal(length(caps$getCoverageSummaries()), 26L)
+
+  cov1 <- caps$findCoverageSummaryById("AverageChloroColor")
+  expect_is(cov1, "WCSCoverageSummary")
+  cov1_desc <- cov1$getDescription()
+  expect_is(cov1_desc, "WCSCoverageDescription")
+  expect_is(cov1_desc$domainSet, "GMLReferenceableGridByVectors")
+
+  temp4d <- caps$findCoverageSummaryById("Temperature4D")
+  expect_is(temp4d, "WCSCoverageSummary")
+  temp4d_desc <- temp4d$getDescription()
+  expect_is(temp4d_desc, "WCSCoverageDescription")
+  expect_is(temp4d_desc$domainSet, "GMLReferenceableGridByVectors")
+})