diff --git a/DESCRIPTION b/DESCRIPTION index bd8d72a..2b0fab6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ows4R Version: 0.1-0 -Date: 2018-06-28 +Date: 2018-07-27 Title: interface to OGC Web-Services (OWS) Authors@R: c(person("Emmanuel", "Blondel", role = c("aut", "cre"), email = "emmanuel.blondel1@gmail.om", comment = c(ORCID = "0000-0002-5870-5762")), person("Norbert", "Billet", role = c("ctb"))) diff --git a/R/CSWClient.R b/R/CSWClient.R index 1e39098..36b1c3a 100644 --- a/R/CSWClient.R +++ b/R/CSWClient.R @@ -29,10 +29,13 @@ #' for the CSW records (http://www.opengis.net/cat/csw/2.0.2). For other schemas, specify the #' \code{outputSchema} required, e.g. http://www.isotc211.org/2005/gmd for ISO 19115/19139 schema #' } -#' \item{\code{getRecordById(id, ...)}}{ +#' \item{\code{getRecordById(id, elementSetName, ...)}}{ #' Get a record by Id. By default, the record will be returned following the CSW schema -#' (http://www.opengis.net/cat/csw/2.0.2). For other schemas, specify the -#' \code{outputSchema} required, e.g. http://www.isotc211.org/2005/gmd for ISO 19115/19139 records. +#' (http://www.opengis.net/cat/csw/2.0.2). For other schemas, specify the \code{outputSchema} +#' required, e.g. http://www.isotc211.org/2005/gmd for ISO 19115/19139 records. +#' The parameter \code{elementSetName} should among values "full", "brief", "summary". The default +#' "full" corresponds to the full metadata sheet returned. "brief" and "summary" will contain only +#' a subset of the metadata content. #' } #' } #' @@ -67,7 +70,7 @@ CSWClient <- R6Class("CSWClient", }, #getRecordById - getRecordById = function(id, ...){ + getRecordById = function(id, elementSetName = "full", ...){ self$INFO(sprintf("Fetching record '%s' ...", id)) operations <- self$capabilities$getOperationsMetadata()$getOperations() op <- operations[sapply(operations,function(x){x$getName()=="GetRecordById"})] @@ -78,12 +81,15 @@ CSWClient <- R6Class("CSWClient", self$ERROR(errorMsg) stop(errorMsg) } - request <- CSWGetRecordById$new(op, self$getUrl(), self$getVersion(), id = id, logger = self$loggerType, ...) + request <- CSWGetRecordById$new(op, self$getUrl(), self$getVersion(), + user = self$getUser(), pwd = self$getPwd(), + id = id, elementSetName = elementSetName, + logger = self$loggerType, ...) return(request$getResponse()) }, #getRecords - getRecords = function(query = NULL, ...){ + getRecords = function(query = CSWQuery$new(), ...){ self$INFO("Fetching records ...") operations <- self$capabilities$getOperationsMetadata()$getOperations() op <- operations[sapply(operations,function(x){x$getName()=="GetRecords"})] @@ -95,6 +101,7 @@ CSWClient <- R6Class("CSWClient", stop(errorMsg) } request <- CSWGetRecords$new(op, self$getUrl(), self$getVersion(), + user = self$getUser(), pwd = self$getPwd(), query = query, logger = self$loggerType, ...) return(request$getResponse()) }, @@ -120,7 +127,8 @@ CSWClient <- R6Class("CSWClient", } } #transation - transaction <- CSWTransaction$new(op, cswt_url, self$getVersion(), type = type, user = self$getUser(), pwd = self$getPwd(), + transaction <- CSWTransaction$new(op, cswt_url, self$getVersion(), type = type, + user = self$getUser(), pwd = self$getPwd(), record = record, recordProperty = recordProperty, constraint = constraint, logger = self$loggerType, ...) diff --git a/R/CSWGetRecordById.R b/R/CSWGetRecordById.R index 8a36f11..191b76a 100644 --- a/R/CSWGetRecordById.R +++ b/R/CSWGetRecordById.R @@ -8,7 +8,7 @@ #' #' @section Methods: #' \describe{ -#' \item{\code{new(url, version, id)}}{ +#' \item{\code{new(op, url, version, user, pwd, id, elementSetName, logger, ...)}}{ #' This method is used to instantiate a CSWGetRecordById object #' } #' } @@ -18,26 +18,53 @@ CSWGetRecordById <- R6Class("CSWGetRecordById", inherit = OWSRequest, private = list( - name = "GetRecordById", - defaultOutputSchema = "http://www.opengis.net/cat/csw/2.0.2" + xmlElement = "GetRecordById", + xmlNamespace = c(csw = "http://www.opengis.net/cat/csw"), + defaultAttrs = list( + service = "CSW", + version = "2.0.2", + outputSchema= "http://www.opengis.net/cat/csw" + ) ), public = list( - initialize = function(op, url, version, id, logger = NULL, ...) { - namedParams <- list(service = "CSW", version = version, id = id) + Id = NA, + ElementSetName = "full", + initialize = function(op, url, version, + user = NULL, pwd = NULL, + id, elementSetName = "full", logger = NULL, ...) { + self$Id = id + allowedElementSetNames <- c("full", "brief", "summary") + if(!(elementSetName %in% allowedElementSetNames)){ + stop(sprintf("elementSetName value should be among following values: [%s]", + paste(allowedElementSetNames, collapse=","))) + } + self$ElementSetName = elementSetName + super$initialize(op, "POST", url, request = private$xmlElement, + user = user, pwd = pwd, + contentType = "text/xml", mimeType = "text/xml", + logger = logger, ...) + + nsName <- names(private$xmlNamespace) + private$xmlNamespace = paste(private$xmlNamespace, version, sep="/") + names(private$xmlNamespace) <- nsName + + self$attrs <- private$defaultAttrs - #default output schema + #version + self$attrs$version = version + + #output schema + self$attrs$outputSchema = paste(self$attrs$outputSchema, version, sep="/") outputSchema <- list(...)$outputSchema - if(is.null(outputSchema)){ - outputSchema <- private$defaultOutputSchema - namedParams <- c(namedParams, outputSchema = outputSchema) + if(!is.null(outputSchema)){ + self$attrs$outputSchema = outputSchema } - super$initialize(op, "GET", url, request = private$name, - namedParams = namedParams, - mimeType = "text/xml", logger = logger, ...) + #execute self$execute() #check response in case of ISO + outputSchema <- self$attrs$outputSchema isoSchemas <- c("http://www.isotc211.org/2005/gmd","http://www.isotc211.org/2005/gfc") if(outputSchema %in% isoSchemas){ xmltxt <- as(private$response, "character") @@ -76,6 +103,7 @@ CSWGetRecordById <- R6Class("CSWGetRecordById", out }, "http://www.opengis.net/cat/csw/2.0.2" = { + out <- NULL warnMsg <- sprintf("R Dublin Core binding not yet supported for '%s'", outputSchema) warnings(warnMsg) self$WARN(warnMsg) @@ -90,6 +118,7 @@ CSWGetRecordById <- R6Class("CSWGetRecordById", out }, "http://www.opengis.net/cat/csw/3.0" = { + out <- NULL warnMsg <- sprintf("R Dublin Core binding not yet supported for '%s'", outputSchema) warnings(warnMsg) self$WARN(warnMsg) diff --git a/R/CSWGetRecords.R b/R/CSWGetRecords.R index b887e94..fb73c3f 100644 --- a/R/CSWGetRecords.R +++ b/R/CSWGetRecords.R @@ -8,7 +8,7 @@ #' #' @section Methods: #' \describe{ -#' \item{\code{new(url, version, constraints, ...)}}{ +#' \item{\code{new(op, url, version, user, pwd, query, logger, ...)}}{ #' This method is used to instantiate a CSWGetRecords object #' } #' } @@ -32,8 +32,11 @@ CSWGetRecords <- R6Class("CSWGetRecords", ), public = list( Query = NULL, - initialize = function(op, url, version = "2.0.2", query = NULL, logger = NULL, ...) { + initialize = function(op, url, version = "2.0.2", + user = NULL, pwd = NULL, + query = NULL, logger = NULL, ...) { super$initialize(op, "POST", url, request = private$xmlElement, + user = user, pwd = pwd, contentType = "text/xml", mimeType = "text/xml", logger = logger, ...) diff --git a/R/ows4R.R b/R/ows4R.R index 5e912c4..f342bca 100644 --- a/R/ows4R.R +++ b/R/ows4R.R @@ -15,7 +15,7 @@ #' Type: \tab Package\cr #' Version #' : \tab 0.1-0\cr -#' Date: \tab 2018-07-18\cr +#' Date: \tab 2018-07-27\cr #' License: \tab MIT\cr #' LazyLoad: \tab yes\cr #' } diff --git a/man/CSWClient.Rd b/man/CSWClient.Rd index e11844f..fe2f16a 100644 --- a/man/CSWClient.Rd +++ b/man/CSWClient.Rd @@ -33,10 +33,13 @@ CSWClient for the CSW records (http://www.opengis.net/cat/csw/2.0.2). For other schemas, specify the \code{outputSchema} required, e.g. http://www.isotc211.org/2005/gmd for ISO 19115/19139 schema } - \item{\code{getRecordById(id, ...)}}{ + \item{\code{getRecordById(id, elementSetName, ...)}}{ Get a record by Id. By default, the record will be returned following the CSW schema - (http://www.opengis.net/cat/csw/2.0.2). For other schemas, specify the - \code{outputSchema} required, e.g. http://www.isotc211.org/2005/gmd for ISO 19115/19139 records. + (http://www.opengis.net/cat/csw/2.0.2). For other schemas, specify the \code{outputSchema} + required, e.g. http://www.isotc211.org/2005/gmd for ISO 19115/19139 records. + The parameter \code{elementSetName} should among values "full", "brief", "summary". The default + "full" corresponds to the full metadata sheet returned. "brief" and "summary" will contain only + a subset of the metadata content. } } } diff --git a/man/CSWGetRecordById.Rd b/man/CSWGetRecordById.Rd index f6e50a9..8e16dd8 100644 --- a/man/CSWGetRecordById.Rd +++ b/man/CSWGetRecordById.Rd @@ -17,7 +17,7 @@ CSWGetRecordById \section{Methods}{ \describe{ - \item{\code{new(url, version, id)}}{ + \item{\code{new(op, url, version, user, pwd, id, elementSetName, logger, ...)}}{ This method is used to instantiate a CSWGetRecordById object } } diff --git a/man/CSWGetRecords.Rd b/man/CSWGetRecords.Rd index 24a59af..060db7f 100644 --- a/man/CSWGetRecords.Rd +++ b/man/CSWGetRecords.Rd @@ -17,7 +17,7 @@ CSWGetRecords \section{Methods}{ \describe{ - \item{\code{new(url, version, constraints, ...)}}{ + \item{\code{new(op, url, version, user, pwd, query, logger, ...)}}{ This method is used to instantiate a CSWGetRecords object } } diff --git a/man/ows4R.Rd b/man/ows4R.Rd index 924c8d5..7642475 100644 --- a/man/ows4R.Rd +++ b/man/ows4R.Rd @@ -17,7 +17,7 @@ service specifications such as Web Map Service (WMS), Web Coverage Service, or C Type: \tab Package\cr Version : \tab 0.1-0\cr - Date: \tab 2018-07-18\cr + Date: \tab 2018-07-27\cr License: \tab MIT\cr LazyLoad: \tab yes\cr } diff --git a/tests/testthat/test_CSWClient.R b/tests/testthat/test_CSWClient.R index f569656..7165f69 100644 --- a/tests/testthat/test_CSWClient.R +++ b/tests/testthat/test_CSWClient.R @@ -96,7 +96,7 @@ test_that("CSW 2.0.2 - Transaction - Update (Full)",{ test_that("CSW 2.0.2 - Transaction - Update (Partial)",{ recordProperty <- CSWRecordProperty$new("apiso:Title", "NEW_TITLE") filter = OGCFilter$new(PropertyIsEqualTo$new("apiso:Identifier", md$fileIdentifier)) - constraint <- CSWConstraint$new(filter) + constraint <- CSWConstraint$new(filter = filter) update <- csw2$updateRecord(recordProperty = recordProperty, constraint = constraint) expect_true(update$getResult()) }) @@ -123,6 +123,9 @@ test_that("CSW 2.0.2 - GetRecords - full",{ #as Dublin core records (R lists) records <- csw2$getRecords(query = CSWQuery$new()) expect_equal(length(records), 5L) + #ignoring query param (default is CSWQuery$new()) + records <- csw2$getRecords() + expect_equal(length(records), 5L) }) test_that("CSW 2.0.2 - GetRecords - full / maxRecords",{