From 589a349c3ae03a3165e215db0d94c2f8f5e1e3d8 Mon Sep 17 00:00:00 2001 From: eblondel Date: Thu, 24 Feb 2022 14:51:39 +0100 Subject: [PATCH] #9 add WCS 2.1 --- R/WCSCapabilities.R | 1 + R/WCSCoverageSummary.R | 31 ++++++++++++++++++++------ R/WCSDescribeCoverage.R | 2 +- R/WCSGetCoverage.R | 2 +- tests/testthat/test_WCSClient_v2_0.R | 4 ++-- tests/testthat/test_WCSClient_v2_1_0.R | 28 +++++++++++++++++++++++ 6 files changed, 57 insertions(+), 11 deletions(-) create mode 100644 tests/testthat/test_WCSClient_v2_1_0.R diff --git a/R/WCSCapabilities.R b/R/WCSCapabilities.R index 86040e8..a41d6df 100644 --- 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 index 3b48476..8ece51d 100644 --- 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,7 +349,7 @@ 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{ @@ -357,7 +357,7 @@ WCSCoverageSummary <- R6Class("WCSCoverageSummary", 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 index 225feaa..9b81a39 100644 --- 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 index 2ea7cfa..7c68a80 100644 --- 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 index e7346ab..530a87c 100644 --- 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 new file mode 100644 index 0000000..619fd40 --- /dev/null +++ b/tests/testthat/test_WCSClient_v2_1_0.R @@ -0,0 +1,28 @@ +# test_WCSClient_v2_1_O.R +# Author: Emmanuel Blondel +# +# 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") +})