From f3da80a1854fe783ca83c657a78c5e9ccd3e56e0 Mon Sep 17 00:00:00 2001 From: eblondel Date: Sat, 30 Jun 2018 01:58:15 +0200 Subject: [PATCH] #3 CSW implementation, CSW3 GetCapabilities and CSW2 GetRecords, CSW Query --- NAMESPACE | 2 + R/CSWCapabilities.R | 12 ++- R/CSWClient.R | 14 +-- R/CSWConstraint.R | 13 ++- R/CSWDescribeRecord.R | 1 + R/CSWGetRecordById.R | 29 ++++- R/CSWGetRecords.R | 128 ++++++++++++++++++---- R/CSWQuery.R | 40 +++++++ R/CSWTransaction.R | 6 +- R/OGCAbstractObject.R | 14 +-- R/OWSCapabilities.R | 40 ++++--- R/OWSClient.R | 8 +- R/OWSGetCapabilities.R | 31 ++++++ R/OWSOperation.R | 15 ++- R/OWSOperationsMetadata.R | 20 ++-- R/OWSRequest.R | 36 +++++-- R/OWSServiceIdentification.R | 19 ++-- R/OWSServiceProvider.R | 18 ++-- R/OWSUtils.R | 16 ++- R/WFSCapabilities.R | 11 +- R/WFSClient.R | 6 +- R/WFSDescribeFeatureType.R | 1 + R/WFSFeatureType.R | 6 +- R/WFSGetFeature.R | 1 + README.md | 4 +- man/CSWClient.Rd | 4 +- man/CSWQuery.Rd | 27 +++++ man/OWSCapabilities.Rd | 2 +- man/OWSClient.Rd | 4 +- man/OWSGetCapabilities.Rd | 30 ++++++ man/OWSOperation.Rd | 2 +- man/OWSOperationsMetadata.Rd | 2 +- man/OWSServiceIdentification.Rd | 2 +- man/OWSServiceProvider.Rd | 2 +- man/WFSClient.Rd | 2 +- man/WFSFeatureType.Rd | 2 +- tests/testthat/test_CSWClient.R | 181 ++++++++++++++++++++++++++++---- tests/testthat/test_CSWQuery.R | 26 +++++ 38 files changed, 623 insertions(+), 154 deletions(-) create mode 100644 R/CSWQuery.R create mode 100644 R/OWSGetCapabilities.R create mode 100644 man/CSWQuery.Rd create mode 100644 man/OWSGetCapabilities.Rd create mode 100644 tests/testthat/test_CSWQuery.R diff --git a/NAMESPACE b/NAMESPACE index 43f8040..680c114 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,7 @@ export(CSWConstraint) export(CSWDescribeRecord) export(CSWGetRecordById) export(CSWGetRecords) +export(CSWQuery) export(CSWRecordProperty) export(CSWTransaction) export(Not) @@ -18,6 +19,7 @@ export(OGCExpression) export(OGCFilter) export(OWSCapabilities) export(OWSClient) +export(OWSGetCapabilities) export(OWSOperation) export(OWSOperationsMetadata) export(OWSRequest) diff --git a/R/CSWCapabilities.R b/R/CSWCapabilities.R index fc98330..88c446b 100644 --- a/R/CSWCapabilities.R +++ b/R/CSWCapabilities.R @@ -23,15 +23,17 @@ #' CSWCapabilities <- R6Class("CSWCapabilities", inherit = OWSCapabilities, - private = list( - - ), - + private = list(), public = list( #initialize initialize = function(url, version, logger = NULL) { - super$initialize(url, service = "CSW", version, logger = logger) + owsVersion <- switch(version, + "2.0.2" = "1.1", + "3.0" = "2.0" + ) + super$initialize(url, service = "CSW", serviceVersion = version, + owsVersion = owsVersion, logger = logger) xmlObj <- self$getRequest()$getResponse() } ) diff --git a/R/CSWClient.R b/R/CSWClient.R index ff3ef48..ad4d7a7 100644 --- a/R/CSWClient.R +++ b/R/CSWClient.R @@ -9,12 +9,12 @@ #' #' @examples #' \dontrun{ -#' CSWClient$new("http://localhost:8080/geonetwork/srv/eng/csw", version = "2.0.2") +#' CSWClient$new("http://localhost:8080/geonetwork/srv/eng/csw", serviceVersion = "2.0.2") #' } #' #' @section Methods: #' \describe{ -#' \item{\code{new(url, version, user, pwd, logger)}}{ +#' \item{\code{new(url, serviceVersion, user, pwd, logger)}}{ #' This method is used to instantiate a CSWClient with the \code{url} of the #' OGC service. Authentication (\code{user}/\code{pwd}) is not yet supported and will #' be added with the support of service transactional modes. By default, the \code{logger} @@ -45,8 +45,8 @@ CSWClient <- R6Class("CSWClient", ), public = list( #initialize - initialize = function(url, version = NULL, user = NULL, pwd = NULL, logger = NULL) { - super$initialize(url, service = private$serviceName, version, user, pwd, logger) + initialize = function(url, serviceVersion = NULL, user = NULL, pwd = NULL, logger = NULL) { + super$initialize(url, service = private$serviceName, serviceVersion, user, pwd, logger) self$capabilities = CSWCapabilities$new(self$url, self$version, logger = logger) }, @@ -83,7 +83,7 @@ CSWClient <- R6Class("CSWClient", }, #getRecords - getRecords = function(constraint = NULL, ...){ + getRecords = function(query = NULL, ...){ self$INFO("Fetching records ...") operations <- self$capabilities$getOperationsMetadata()$getOperations() op <- operations[sapply(operations,function(x){x$getName()=="GetRecords"})] @@ -95,7 +95,7 @@ CSWClient <- R6Class("CSWClient", stop(errorMsg) } request <- CSWGetRecords$new(op, self$getUrl(), self$getVersion(), - constraint = constraint, logger = self$loggerType, ...) + query = query, logger = self$loggerType, ...) return(request$getResponse()) }, @@ -159,7 +159,7 @@ CSWClient <- R6Class("CSWClient", #deleteRecordById deleteRecordById = function(id){ ogcFilter = OGCFilter$new( PropertyIsEqualTo$new("apiso:Identifier", id) ) - cswConstraint = CSWConstraint$new(ogcFilter) + cswConstraint = CSWConstraint$new(filter = ogcFilter) return(self$deleteRecord(constraint = cswConstraint)) } ) diff --git a/R/CSWConstraint.R b/R/CSWConstraint.R index 235d345..7af7671 100644 --- a/R/CSWConstraint.R +++ b/R/CSWConstraint.R @@ -6,7 +6,7 @@ #' @format \code{\link{R6Class}} object. #' @section Methods: #' \describe{ -#' \item{\code{new(filter, cswVersion)}}{ +#' \item{\code{new(cqlText, filter, cswVersion)}}{ #' This method is used to instantiate an CSWConstraint object. #' } #' } @@ -18,15 +18,20 @@ CSWConstraint <- R6Class("CSWConstraint", ), public = list( wrap = TRUE, + CqlText = NULL, filter = NULL, - initialize = function(filter, cswVersion = "2.0.2"){ + initialize = function(cqlText = NULL, filter = NULL, cswVersion = "2.0.2"){ nsName <- names(private$xmlNamespace) private$xmlNamespace = paste(private$xmlNamespace, cswVersion, sep="/") names(private$xmlNamespace) <- nsName super$initialize(attrs = list(version = "1.1.0")) - if(!is(filter, "OGCFilter")){ - stop("The argument should be an object of class 'OGCFilter'") + if(!is.null(cqlText)) if(!is(cqlText, "character")){ + stop("The argument 'cqlText' should be an object of class 'character'") } + if(!is.null(filter)) if(!is(filter, "OGCFilter")){ + stop("The argument 'filter' should be an object of class 'OGCFilter'") + } + self$CqlText = cqlText self$filter = filter } ) diff --git a/R/CSWDescribeRecord.R b/R/CSWDescribeRecord.R index 7ad164e..6ab35da 100644 --- a/R/CSWDescribeRecord.R +++ b/R/CSWDescribeRecord.R @@ -43,6 +43,7 @@ CSWDescribeRecord <- R6Class("CSWDescribeRecord", super$initialize(op, "GET", url, request = private$name, namedParams = namedParams, mimeType = "text/xml", logger = logger, ...) + self$execute() #binding to XML schema xsdObjs <- getNodeSet(private$response, "//ns:schema", c(ns = "http://www.w3.org/2001/XMLSchema")) diff --git a/R/CSWGetRecordById.R b/R/CSWGetRecordById.R index 745af39..8a36f11 100644 --- a/R/CSWGetRecordById.R +++ b/R/CSWGetRecordById.R @@ -35,6 +35,7 @@ CSWGetRecordById <- R6Class("CSWGetRecordById", super$initialize(op, "GET", url, request = private$name, namedParams = namedParams, mimeType = "text/xml", logger = logger, ...) + self$execute() #check response in case of ISO isoSchemas <- c("http://www.isotc211.org/2005/gmd","http://www.isotc211.org/2005/gfc") @@ -75,8 +76,32 @@ CSWGetRecordById <- R6Class("CSWGetRecordById", out }, "http://www.opengis.net/cat/csw/2.0.2" = { - warnings(sprintf("R binding not yet supported for '%s'", outputSchema)) - private$response + warnMsg <- sprintf("R Dublin Core binding not yet supported for '%s'", outputSchema) + warnings(warnMsg) + self$WARN(warnMsg) + self$WARN("Dublin Core returned as R list...") + recordsXML <- getNodeSet(private$response, "//csw:Record", private$xmlNamespace[1]) + if(length(recordsXML)>0){ + recordXML <- recordsXML[[1]] + children <- xmlChildren(recordXML) + out <- lapply(children, xmlValue) + names(out) <- names(children) + } + out + }, + "http://www.opengis.net/cat/csw/3.0" = { + warnMsg <- sprintf("R Dublin Core binding not yet supported for '%s'", outputSchema) + warnings(warnMsg) + self$WARN(warnMsg) + self$WARN("Dublin Core returned as R list...") + recordsXML <- getNodeSet(private$response, "//csw:Record", private$xmlNamespace[1]) + if(length(recordsXML)>0){ + recordXML <- recordsXML[[1]] + children <- xmlChildren(recordXML) + out <- lapply(children, xmlValue) + names(out) <- names(children) + } + out }, "http://www.w3.org/ns/dcat#" = { warnings(sprintf("R binding not yet supported for '%s'", outputSchema)) diff --git a/R/CSWGetRecords.R b/R/CSWGetRecords.R index 8b33330..71e49b1 100644 --- a/R/CSWGetRecords.R +++ b/R/CSWGetRecords.R @@ -18,38 +18,91 @@ CSWGetRecords <- R6Class("CSWGetRecords", inherit = OWSRequest, private = list( - name = "GetRecords", - defaultOutputSchema = "http://www.opengis.net/cat/csw/2.0.2" + xmlElement = "GetRecords", + xmlNamespace = c(csw = "http://www.opengis.net/cat/csw"), + defaultAttrs = list( + service = "CSW", + version = "2.0.2", + resultType = "results", + startPosition = "1", + maxRecords = "5", + outputFormat="application/xml", + outputSchema= "http://www.opengis.net/cat/csw" + ) ), public = list( - initialize = function(op, url, version, constraint = NULL, logger = NULL, ...) { - namedParams <- list(service = "CSW", version = version) - if(!is.null(constraint)) namedParams <- c(namedParams, constraint = constraint) + Query = NULL, + initialize = function(op, url, version = "2.0.2", query = NULL, logger = NULL, ...) { + super$initialize(op, "POST", url, request = private$xmlElement, + contentType = "text/xml", mimeType = "text/xml", + logger = logger, ...) - #default output schema + nsName <- names(private$xmlNamespace) + private$xmlNamespace = paste(private$xmlNamespace, version, sep="/") + names(private$xmlNamespace) <- nsName + + self$attrs <- private$defaultAttrs + + #version + self$attrs$version = version + + #resultsType + resultType <- list(...)$resultType + if(!is.null(resultType)){ + self$attrs$resultType = resultType + } + + #startPosition + startPosition <- list(...)$startPosition + if(!is.null(startPosition)){ + self$attrs$startPosition = startPosition + } + + #maxRecords + maxRecords <- list(...)$maxRecords + if(!is.null(maxRecords)){ + self$attrs$maxRecords <- maxRecords + } + + #outputFormat + outputFormat <- list(...)$outputFormat + if(!is.null(outputFormat)){ + self$attrs$outputFormat = outputFormat + } + + #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 } - #other default params - typeNames <- switch(outputSchema, + #typeNames value to pass to CSWQuery + typeNames <- switch(self$attrs$outputSchema, "http://www.isotc211.org/2005/gmd" = "gmd:MD_Metadata", "http://www.isotc211.org/2005/gfc" = "gfc:FC_FeatureCatalogue", "http://www.opengis.net/cat/csw/2.0.2" = "csw:Record", + "http://www.opengis.net/cat/csw/3.0" = "csw:Record", "http://www.w3.org/ns/dcat#" = "dcat" ) - namedParams <- c(namedParams, typeNames = typeNames) - namedParams[["resultType"]] <- "results" - namedParams[["CONSTRAINTLANGUAGE"]] <- "CQL_TEXT" + if(typeNames != "csw:Record"){ + private$xmlNamespace = c(private$xmlNamespace, ns = self$attrs$outputSchema) + names(private$xmlNamespace)[2] <- unlist(strsplit(typeNames,":"))[1] + } + + if(!is.null(query)){ + if(!is(query, "CSWQuery")){ + stop("The argument 'query' should be an object of class 'CSWQuery'") + } + query$attrs$typeNames = typeNames + self$Query = query + } - super$initialize(op, "GET", url, request = private$name, - namedParams = namedParams, - mimeType = "text/xml", logger = logger, ...) + #execute + self$execute() #bindings - private$response <- switch(outputSchema, + private$response <- switch(self$attrs$outputSchema, "http://www.isotc211.org/2005/gmd" = { out <- NULL xmlObjs <- getNodeSet(private$response, "//ns:MD_Metadata", c(ns = outputSchema)) @@ -75,8 +128,43 @@ CSWGetRecords <- R6Class("CSWGetRecords", out }, "http://www.opengis.net/cat/csw/2.0.2" = { - warnings(sprintf("R binding not yet supported for '%s'", outputSchema)) - private$response + warnMsg <- sprintf("R Dublin Core binding not yet supported for '%s'", outputSchema) + warnings(warnMsg) + self$WARN(warnMsg) + self$WARN("Dublin Core returned as R lists...") + out <- private$response + if(query$ElementSetName == "full"){ + out <- list() + recordsXML <- getNodeSet(private$response, "//csw:GetRecordsResponse/csw:SearchResults/csw:Record", private$xmlNamespace[1]) + if(length(recordsXML)>0){ + out <- lapply(recordsXML, function(recordXML){ + children <- xmlChildren(recordXML) + out.obj <- lapply(children, xmlValue) + names(out.obj) <- names(children) + return(out.obj) + }) + } + } + out + }, + "http://www.opengis.net/cat/csw/3.0" = { + warnMsg <- sprintf("R Dublin Core binding not yet supported for '%s'", outputSchema) + self$WARN(warnMsg); warnings(warnMsg) + self$WARN("Dublin Core records returned as R lists...") + out <- private$response + if(query$ElementSetName == "full"){ + out <- list() + recordsXML <- getNodeSet(private$response, "//csw:GetRecordsResponse/csw:SearchResults/csw:Record", private$xmlNamespace[1]) + if(length(recordsXML)>0){ + out <- lapply(recordsXML, function(recordXML){ + children <- xmlChildren(recordXML) + out.obj <- lapply(children, xmlValue) + names(out.obj) <- names(children) + return(out.obj) + }) + } + } + out }, "http://www.w3.org/ns/dcat#" = { warnings(sprintf("R binding not yet supported for '%s'", outputSchema)) diff --git a/R/CSWQuery.R b/R/CSWQuery.R new file mode 100644 index 0000000..b99b800 --- /dev/null +++ b/R/CSWQuery.R @@ -0,0 +1,40 @@ +#' CSWQuery +#' @docType class +#' @export +#' @keywords OGC Query +#' @return Object of \code{\link{R6Class}} for modelling an CSW Query +#' @format \code{\link{R6Class}} object. +#' @section Methods: +#' \describe{ +#' \item{\code{new(filter, cswVersion)}}{ +#' This method is used to instantiate an CSWQUery object. +#' } +#' } +CSWQuery <- R6Class("CSWQuery", + inherit = OGCAbstractObject, + private = list( + xmlElement = "Query", + xmlNamespace = c(csw = "http://www.opengis.net/cat/csw") + ), + public = list( + wrap = TRUE, + ElementSetName = "full", + constraint = NULL, + initialize = function(elementSetName = "full", constraint = NULL, + typeNames = "csw:Record", cswVersion = "2.0.2"){ + nsName <- names(private$xmlNamespace) + private$xmlNamespace = paste(private$xmlNamespace, cswVersion, sep="/") + names(private$xmlNamespace) <- nsName + super$initialize(attrs = list(typeNames = typeNames)) + if(!is(elementSetName, "character")){ + stop("The argument 'elementSetName' should be an object of class 'character'") + } + self$ElementSetName = elementSetName + + if(!is.null(constraint)) if(!is(constraint, "CSWConstraint")){ + stop("The argument 'constraint' should be an object of class 'OGCConstraint'") + } + self$constraint = constraint + } + ) +) \ No newline at end of file diff --git a/R/CSWTransaction.R b/R/CSWTransaction.R index 063cf7c..74821f3 100644 --- a/R/CSWTransaction.R +++ b/R/CSWTransaction.R @@ -35,11 +35,11 @@ CSWTransaction <- R6Class("CSWTransaction", recordProperty = recordProperty, constraint = constraint ) - super$initialize(op, "POST", url, - request = private$xmlElement, - attrs = list(service = "CSW", version = version), + super$initialize(op, "POST", url, request = private$xmlElement, contentType = "text/xml", mimeType = "text/xml", logger = logger, ...) + self$attrs <- list(service = "CSW", version = version) + self$execute() } ) diff --git a/R/OGCAbstractObject.R b/R/OGCAbstractObject.R index e43ce67..02824ef 100644 --- a/R/OGCAbstractObject.R +++ b/R/OGCAbstractObject.R @@ -98,14 +98,14 @@ OGCAbstractObject <- R6Class("OGCAbstractObject", if(addNS){ rootXML <- xmlOutputDOM( tag = private$xmlElement, - nameSpace = names(private$xmlNamespace), - nsURI = private$xmlNamespace, + nameSpace = names(private$xmlNamespace)[1], + nsURI = as.list(private$xmlNamespace), attrs = self$attrs ) }else{ rootXML <- xmlOutputDOM( tag = private$xmlElement, - nameSpace = names(private$xmlNamespace), + nameSpace = names(private$xmlNamespace)[1], attrs = self$attrs ) } @@ -127,7 +127,7 @@ OGCAbstractObject <- R6Class("OGCAbstractObject", if(fieldObj$wrap){ wrapperNode <- xmlOutputDOM( tag = field, - nameSpace = names(private$xmlNamespace), + nameSpace = names(private$xmlNamespace)[1], attrs = field$attrs ) if(!fieldObj$isNull) wrapperNode$addNode(fieldObjXml) @@ -144,7 +144,7 @@ OGCAbstractObject <- R6Class("OGCAbstractObject", if(fieldObj$wrap){ wrapperNode <- xmlOutputDOM( tag = field, - nameSpace = names(private$xmlNamespace), + nameSpace = names(private$xmlNamespace)[1], attrs = fieldObj$attrs ) if(!fieldObj$isNull) wrapperNode$addNode(fieldObjXml) @@ -155,7 +155,7 @@ OGCAbstractObject <- R6Class("OGCAbstractObject", }else if(is(fieldObj, "list")){ wrapperNode <- xmlOutputDOM( tag = field, - nameSpace = names(private$xmlNamespace) + nameSpace = names(private$xmlNamespace)[1] ) for(item in fieldObj){ if(!is.null(item)){ @@ -165,7 +165,7 @@ OGCAbstractObject <- R6Class("OGCAbstractObject", } rootXML$addNode(wrapperNode$value()) }else{ - wrapperNode <- xmlOutputDOM(tag = field, nameSpace = names(private$xmlNamespace)) + wrapperNode <- xmlOutputDOM(tag = field, nameSpace = names(private$xmlNamespace)[1]) wrapperNode$addNode(xmlTextNode(fieldObj)) rootXML$addNode(wrapperNode$value()) } diff --git a/R/OWSCapabilities.R b/R/OWSCapabilities.R index 5d25cb1..61be632 100644 --- a/R/OWSCapabilities.R +++ b/R/OWSCapabilities.R @@ -14,7 +14,7 @@ #' #' @section Methods: #' \describe{ -#' \item{\code{new(url, service, version, logger)}}{ +#' \item{\code{new(url, service, serviceVersion, owsVersion, logger)}}{ #' This method is used to instantiate a OWSGetCapabilities object #' } #' \item{\code{getUrl()}}{ @@ -43,7 +43,9 @@ OWSCapabilities <- R6Class("OWSCapabilities", inherit = OGCAbstractObject, private = list( url = NA, - version = NA, + service = NA, + serviceVersion = NA, + owsVersion = NA, request = NA, serviceIdentification = NULL, serviceProvider = NULL, @@ -53,16 +55,18 @@ OWSCapabilities <- R6Class("OWSCapabilities", public = list( #initialize - initialize = function(url, service, version, logger = NULL) { + initialize = function(url, service, serviceVersion, owsVersion, logger = NULL) { super$initialize(logger = logger) - namedParams <- list(service = service, version = version) - private$request <- OWSRequest$new(op = NULL, type = "GET", url, - request = "GetCapabilities", namedParams, - mimeType = "text/xml", logger = logger) + private$url <- url + private$service <- service + private$serviceVersion <- serviceVersion + private$owsVersion <- owsVersion + namedParams <- list(service = service, version = serviceVersion) + private$request <- OWSGetCapabilities$new(op = NULL, url, service, serviceVersion, logger = logger) xmlObj <- private$request$getResponse() - private$serviceIdentification <- OWSServiceIdentification$new(xmlObj, service, version) - private$serviceProvider <- OWSServiceProvider$new(xmlObj, service, version) - private$operationsMetadata <- OWSOperationsMetadata$new(xmlObj, service, version) + private$serviceIdentification <- OWSServiceIdentification$new(xmlObj, owsVersion) + private$serviceProvider <- OWSServiceProvider$new(xmlObj, owsVersion) + private$operationsMetadata <- OWSOperationsMetadata$new(xmlObj, owsVersion) }, #getUrl @@ -70,9 +74,19 @@ OWSCapabilities <- R6Class("OWSCapabilities", return(private$url) }, - #getVersion - getVersion = function(){ - return(private$version) + #getService + getService = function(){ + return(private$service) + }, + + #getServiceVersion + getServiceVersion = function(){ + return(private$serviceVersion) + }, + + #getOWSVersion + getOWSVersion = function(){ + return(private$owsVersion) }, #getRequest diff --git a/R/OWSClient.R b/R/OWSClient.R index 1a4a6e1..1faa744 100644 --- a/R/OWSClient.R +++ b/R/OWSClient.R @@ -15,7 +15,7 @@ #' #' @examples #' \dontrun{ -#' OWSClient$new("http://localhost:8080/geoserver/ows", version = "1.1.0") +#' OWSClient$new("http://localhost:8080/geoserver/ows", serviceVersion = "1.1.0") #' } #' #' @field url the Base url of OWS service @@ -23,7 +23,7 @@ #' #' @section Methods: #' \describe{ -#' \item{\code{new(url, service, version, user, pwd, logger)}}{ +#' \item{\code{new(url, service, serviceVersion, user, pwd, logger)}}{ #' This method is used to instantiate a OWSClient with the \code{url} of the #' OGC service. Authentication (\code{user}/\code{pwd}) is not yet supported and will #' be added with the support of service transactional modes. By default, the \code{logger} @@ -62,7 +62,7 @@ OWSClient <- R6Class("OWSClient", capabilities = NA, #initialize - initialize = function(url, service = NULL, version, + initialize = function(url, service, serviceVersion, user = NULL, pwd = NULL, logger = NULL) { @@ -71,7 +71,7 @@ OWSClient <- R6Class("OWSClient", #fields if (!missing(url)) self$url <- url - if (!missing(version)) self$version <- version + if (!missing(serviceVersion)) self$version <- serviceVersion }, #getUrl diff --git a/R/OWSGetCapabilities.R b/R/OWSGetCapabilities.R new file mode 100644 index 0000000..ccaed10 --- /dev/null +++ b/R/OWSGetCapabilities.R @@ -0,0 +1,31 @@ +#' OWSGetCapabilities +#' +#' @docType class +#' @export +#' @keywords OGC GetCapabilities +#' @return Object of \code{\link{R6Class}} for modelling a GetCapabilities request +#' @format \code{\link{R6Class}} object. +#' +#' @section Methods: +#' \describe{ +#' \item{\code{new(op, url, service, version)}}{ +#' This method is used to instantiate a OWSGetCapabilities object +#' } +#' } +#' +#' @author Emmanuel Blondel +#' +OWSGetCapabilities <- R6Class("OWSGetCapabilities", + inherit = OWSRequest, + private = list( + name = "GetCapabilities" + ), + public = list( + initialize = function(op, url, service, version, ...) { + namedParams <- list(service = service, version = version) + super$initialize(op, "GET", url, request = private$name, + namedParams = namedParams, mimeType = "text/xml", ...) + self$execute() + } + ) +) \ No newline at end of file diff --git a/R/OWSOperation.R b/R/OWSOperation.R index 07a42c0..c755ef3 100644 --- a/R/OWSOperation.R +++ b/R/OWSOperation.R @@ -8,7 +8,7 @@ #' #' @section Methods: #' \describe{ -#' \item{\code{new(xmlObj, service, version)}}{ +#' \item{\code{new(xmlObj, serviceVersion)}}{ #' This method is used to instantiate an OWSOperation object #' } #' \item{\code{getName()}}{ @@ -30,13 +30,20 @@ OWSOperation <- R6Class("OWSOperation", parameters = list() ), public = list( - initialize = function(xmlObj, service, version){ + initialize = function(xmlObj, serviceVersion){ namespaces <- OWSUtils$getNamespaces(xmlDoc(xmlObj)) - ns <- OWSUtils$findNamespace(namespaces, "ows") + namespaces <- as.data.frame(namespaces) + namespaceURI <- paste("http://www.opengis.net/ows", serviceVersion, sep ="/") + ns <- OWSUtils$findNamespace(namespaces, uri = namespaceURI) + if(is.null(ns)) ns <- OWSUtils$findNamespace(namespaces, id = "ows") private$name <- xmlGetAttr(xmlObj, "name") paramXML <- getNodeSet(xmlDoc(xmlObj), "//ns:Parameter", ns) private$parameters <- lapply(paramXML, function(x){ - param <- unique(xpathSApply(xmlDoc(x), "//ns:Value", fun = xmlValue, namespaces = ns)) + valuesXpath <- switch(serviceVersion, + "1.1" = "//ns:Value", + "2.0" = "//ns:AllowedValues/ns:Value" + ) + param <- unique(xpathSApply(xmlDoc(x), valuesXpath, fun = xmlValue, namespaces = ns)) return(param) }) names(private$parameters) <- sapply(paramXML, xmlGetAttr, "name") diff --git a/R/OWSOperationsMetadata.R b/R/OWSOperationsMetadata.R index c5f8a58..b894973 100644 --- a/R/OWSOperationsMetadata.R +++ b/R/OWSOperationsMetadata.R @@ -8,7 +8,7 @@ #' #' @section Methods: #' \describe{ -#' \item{\code{new(xmlObj, service, version)}}{ +#' \item{\code{new(xmlObj, serviceVersion)}}{ #' This method is used to instantiate a OWSOperationsMetadata object #' } #' \item{\code{getOperations()}}{ @@ -23,24 +23,22 @@ OWSOperationsMetadata <- R6Class("OWSOperationsMetadata", operations = list(), #fetchOperations - fetchOperations = function(xmlObj, service, version){ + fetchOperations = function(xmlObj, serviceVersion){ namespaces <- NULL if(all(class(xmlObj) == c("XMLInternalDocument","XMLAbstractDocument"))){ namespaces <- OWSUtils$getNamespaces(xmlObj) } namespaces <- as.data.frame(namespaces) - namespace <- tolower(service) + namespaceURI <- paste("http://www.opengis.net/ows", serviceVersion, sep ="/") opXML <- NULL if(nrow(namespaces) > 0){ - ns <- OWSUtils$findNamespace(namespaces, namespace) + ns <- OWSUtils$findNamespace(namespaces, uri = namespaceURI) if(length(ns)>0){ - if(namespace %in% names(ns)){ - opXML <- getNodeSet(xmlObj, "//ns:OperationsMetadata/ns:Operation", ns) - } + opXML <- getNodeSet(xmlObj, "//ns:OperationsMetadata/ns:Operation", ns) } if(length(opXML)==0){ - ns <- OWSUtils$findNamespace(namespaces, "ows") + ns <- OWSUtils$findNamespace(namespaces, id = "ows") if(length(ns)>0){ opXML <- getNodeSet(xmlObj, "//ns:OperationsMetadata/ns:Operation", ns) } @@ -51,15 +49,15 @@ OWSOperationsMetadata <- R6Class("OWSOperationsMetadata", operations <- list() if(length(opXML)>0){ - operations <- lapply(opXML, function(x){return(OWSOperation$new(x, service, version))}) + operations <- lapply(opXML, function(x){return(OWSOperation$new(x, serviceVersion))}) } return(operations) } ), public = list( - initialize = function(xmlObj, service, version){ - private$operations <- private$fetchOperations(xmlObj, service, version) + initialize = function(xmlObj, serviceVersion){ + private$operations <- private$fetchOperations(xmlObj, serviceVersion) }, #getOperations diff --git a/R/OWSRequest.R b/R/OWSRequest.R index 4783b64..405e703 100644 --- a/R/OWSRequest.R +++ b/R/OWSRequest.R @@ -25,7 +25,12 @@ OWSRequest <- R6Class("OWSRequest", private = list( xmlElement = NULL, xmlNamespace = c(ows = "http://www.opengis.net/ows"), + url = NA, + type = NA, request = NA, + namedParams = list(), + contentType = "text/xml", + mimeType = "text/xml", status = NA, response = NA, exception = NA, @@ -112,6 +117,13 @@ OWSRequest <- R6Class("OWSRequest", contentType = "text/xml", mimeType = "text/xml", logger = NULL, ...) { super$initialize(logger = logger) + private$type = type + private$url = url + private$request = request + private$namedParams = namedParams + private$contentType = contentType + private$mimeType = mimeType + vendorParams <- list(...) #if(!is.null(op)){ # for(param in names(vendorParams)){ @@ -134,24 +146,26 @@ OWSRequest <- R6Class("OWSRequest", vendorParams <- vendorParams[!sapply(vendorParams, is.null)] vendorParams <- lapply(vendorParams, curl::curl_escape) namedParams <- c(namedParams, vendorParams) + }, + + #execute + execute = function(){ - self$attrs = attrs - - req <- switch(type, - "GET" = private$GET(url, request, namedParams, mimeType), - "POST" = private$POST(url, contentType, mimeType) + req <- switch(private$type, + "GET" = private$GET(private$url, private$request, private$namedParams, private$mimeType), + "POST" = private$POST(private$url, private$contentType, private$mimeType) ) - + private$request <- req$request private$status <- req$status private$response <- req$response - if(type == "GET"){ + if(private$type == "GET"){ if(private$status != 200){ private$exception <- sprintf("Error while executing request '%s'", req$request) } } - if(type == "POST"){ + if(private$type == "POST"){ exception <- getNodeSet(req$response, "//ows:ExceptionText", c(ows = xmlNamespaces(req$response)$ows$uri)) if(length(exception)>0){ exception <- exception[[1]] @@ -161,26 +175,32 @@ OWSRequest <- R6Class("OWSRequest", } }, + #getRequest getRequest = function(){ return(private$request) }, + #getStatus getStatus = function(){ return(private$status) }, + #getResponse getResponse = function(){ return(private$response) }, + #getException getException = function(){ return(private$exception) }, + #getResult getResult = function(){ return(private$result) }, + #setResult setResult = function(result){ private$result = result } diff --git a/R/OWSServiceIdentification.R b/R/OWSServiceIdentification.R index e41b477..33c462f 100644 --- a/R/OWSServiceIdentification.R +++ b/R/OWSServiceIdentification.R @@ -8,7 +8,7 @@ #' #' @section Methods: #' \describe{ -#' \item{\code{new(xmlObj, url, service)}}{ +#' \item{\code{new(xmlObj, serviceVersion)}}{ #' This method is used to instantiate a OWSServiceIdentification object #' } #' \item{\code{getName()}}{ @@ -49,26 +49,24 @@ OWSServiceIdentification <- R6Class("OWSServiceIdentification", accessConstraints = NA, #fetchServiceIdentification - fetchServiceIdentification = function(xmlObj, service, version){ + fetchServiceIdentification = function(xmlObj, serviceVersion){ namespaces <- NULL if(all(class(xmlObj) == c("XMLInternalDocument","XMLAbstractDocument"))){ namespaces <- OWSUtils$getNamespaces(xmlObj) } namespaces <- as.data.frame(namespaces) - namespace <- tolower(service) + namespaceURI <- paste("http://www.opengis.net/ows", serviceVersion, sep ="/") serviceXML <- NULL if(nrow(namespaces) > 0){ - ns <- OWSUtils$findNamespace(namespaces, namespace) + ns <- OWSUtils$findNamespace(namespaces, uri = namespaceURI) if(length(ns)>0){ - if(namespace %in% names(ns)){ serviceXML <- getNodeSet(xmlObj, "//ns:Service", ns) if(length(serviceXML)==0) serviceXML <- getNodeSet(xmlObj, "//ns:ServiceIdentification", ns) - } } if(length(serviceXML)==0){ - ns <- OWSUtils$findNamespace(namespaces, "ows") + ns <- OWSUtils$findNamespace(namespaces, id = "ows") if(length(ns)>0){ serviceXML <- getNodeSet(xmlObj, "//ns:Service", ns) if(length(serviceXML)==0) serviceXML <- getNodeSet(xmlObj, "//ns:ServiceIdentification", ns) @@ -123,7 +121,8 @@ OWSServiceIdentification <- R6Class("OWSServiceIdentification", serviceType <- xmlValue(children$ServiceType) } if(!is.null(children$ServiceTypeVersion)){ - serviceTypeVersion <- xmlValue(children$ServiceTypeVersion) + serviceTypeVersions <- getNodeSet(serviceXML, "//ns:ServiceTypeVersion", ns) + serviceTypeVersion <- sapply(serviceTypeVersions, xmlValue) } if(!is.null(children$Fees)){ serviceFees <- xmlValue(children$Fees) @@ -150,8 +149,8 @@ OWSServiceIdentification <- R6Class("OWSServiceIdentification", } ), public = list( - initialize = function(xmlObj, service, version){ - serviceIdentification <- private$fetchServiceIdentification(xmlObj, service, version) + initialize = function(xmlObj, serviceVersion){ + serviceIdentification <- private$fetchServiceIdentification(xmlObj, serviceVersion) private$name <- serviceIdentification$name private$title <- serviceIdentification$title private$abstract <- serviceIdentification$abstract diff --git a/R/OWSServiceProvider.R b/R/OWSServiceProvider.R index e6cfa41..1c2ca13 100644 --- a/R/OWSServiceProvider.R +++ b/R/OWSServiceProvider.R @@ -8,7 +8,7 @@ #' #' @section Methods: #' \describe{ -#' \item{\code{new(xmlObj, url, service)}}{ +#' \item{\code{new(xmlObj, version)}}{ #' This method is used to instantiate a OWSServiceProvider object #' } #' \item{\code{getProviderName()}}{ @@ -32,25 +32,23 @@ OWSServiceProvider <- R6Class("OWSServiceProvider", serviceContact = NA, #fetchServiceProvider - fetchServiceProvider = function(xmlObj, service, version){ + fetchServiceProvider = function(xmlObj, version){ namespaces <- NULL if(all(class(xmlObj) == c("XMLInternalDocument","XMLAbstractDocument"))){ namespaces <- OWSUtils$getNamespaces(xmlObj) } namespaces <- as.data.frame(namespaces) - namespace <- tolower(service) + namespaceURI <- paste("http://www.opengis.net/ows", version, sep ="/") serviceXML <- NULL if(nrow(namespaces) > 0){ - ns <- OWSUtils$findNamespace(namespaces, namespace) + ns <- OWSUtils$findNamespace(namespaces, uri = namespaceURI) if(length(ns)>0){ - if(namespace %in% names(ns)){ - serviceXML <- getNodeSet(xmlObj, "//ns:ServiceProvider", ns) - } + serviceXML <- getNodeSet(xmlObj, "//ns:ServiceProvider", ns) } if(length(serviceXML)==0){ - ns <- OWSUtils$findNamespace(namespaces, "ows") + ns <- OWSUtils$findNamespace(namespaces, id = "ows") if(length(ns)>0){ serviceXML <- getNodeSet(xmlObj, "//ns:ServiceProvider", ns) } @@ -128,8 +126,8 @@ OWSServiceProvider <- R6Class("OWSServiceProvider", } ), public = list( - initialize = function(xmlObj, service, version){ - serviceProvider <- private$fetchServiceProvider(xmlObj, service, version) + initialize = function(xmlObj, version){ + serviceProvider <- private$fetchServiceProvider(xmlObj, version) private$providerName <- serviceProvider$providerName private$providerSite <- serviceProvider$providerSite private$serviceContact <- serviceProvider$serviceContact diff --git a/R/OWSUtils.R b/R/OWSUtils.R index 2641961..786c45c 100644 --- a/R/OWSUtils.R +++ b/R/OWSUtils.R @@ -40,10 +40,18 @@ OWSUtils <- list( #findNamespace #--------------------------------------------------------------- - findNamespace = function(namespaces, identifier){ - namespace <- namespaces[namespaces$id==identifier,] - if(nrow(namespace)==0){ - namespace <- namespaces[grepl(identifier, namespaces$uri),] + findNamespace = function(namespaces, id = NULL, uri = NULL){ + if(!is.null(id)){ + namespace <- namespaces[namespaces$id==id,] + if(nrow(namespace)==0){ + namespace <- namespaces[grepl(id, namespaces$uri),] + } + } + if(!is.null(uri)){ + namespace <- namespaces[namespaces$uri==uri,] + if(nrow(namespace)==0){ + namespace <- namespaces[grepl(uri, namespaces$uri),] + } } ns <- NULL if(nrow(namespace)>0){ diff --git a/R/WFSCapabilities.R b/R/WFSCapabilities.R index f866284..cc60f4e 100644 --- a/R/WFSCapabilities.R +++ b/R/WFSCapabilities.R @@ -34,17 +34,17 @@ WFSCapabilities <- R6Class("WFSCapabilities", featureTypes = NA, #fetchFeatureTypes - fetchFeatureTypes = function(xmlObj, url, version){ + fetchFeatureTypes = function(xmlObj, version){ wfsNs <- NULL if(all(class(xmlObj) == c("XMLInternalDocument","XMLAbstractDocument"))){ namespaces <- OWSUtils$getNamespaces(xmlObj) - wfsNs <- OWSUtils$findNamespace(namespaces, "wfs") + wfsNs <- OWSUtils$findNamespace(namespaces, id = "wfs") } featureTypesXML <- getNodeSet(xmlObj, "//ns:FeatureType", wfsNs) featureTypesList <- lapply(featureTypesXML, function(x){ - WFSFeatureType$new(x, self, url, version, logger = self$loggerType) + WFSFeatureType$new(x, self, version, logger = self$loggerType) }) return(featureTypesList) @@ -56,9 +56,10 @@ WFSCapabilities <- R6Class("WFSCapabilities", #initialize initialize = function(url, version, logger = NULL) { - super$initialize(url, service = "WFS", version, logger = logger) + super$initialize(url, service = "WFS", serviceVersion, + owsVersion = "1.1", logger = logger) xmlObj <- self$getRequest()$getResponse() - private$featureTypes = private$fetchFeatureTypes(xmlObj, url, version) + private$featureTypes = private$fetchFeatureTypes(xmlObj, version) }, #getFeatureTypes diff --git a/R/WFSClient.R b/R/WFSClient.R index b5d6922..b671bd2 100644 --- a/R/WFSClient.R +++ b/R/WFSClient.R @@ -14,7 +14,7 @@ #' #' @section Methods: #' \describe{ -#' \item{\code{new(url, version, user, pwd, logger)}}{ +#' \item{\code{new(url, serviceVersion, user, pwd, logger)}}{ #' This method is used to instantiate a WFSClient with the \code{url} of the #' OGC service. Authentication (\code{user}/\code{pwd}) is not yet supported and will #' be added with the support of service transactional modes. By default, the \code{logger} @@ -41,8 +41,8 @@ WFSClient <- R6Class("WFSClient", ), public = list( #initialize - initialize = function(url, version = NULL, user = NULL, pwd = NULL, logger = NULL) { - super$initialize(url, service = private$serviceName, version, user, pwd, logger) + initialize = function(url, serviceVersion = NULL, user = NULL, pwd = NULL, logger = NULL) { + super$initialize(url, service = private$serviceName, serviceVersion, user, pwd, logger) self$capabilities = WFSCapabilities$new(self$url, self$version, logger = logger) }, diff --git a/R/WFSDescribeFeatureType.R b/R/WFSDescribeFeatureType.R index a94ee58..1efbcc7 100644 --- a/R/WFSDescribeFeatureType.R +++ b/R/WFSDescribeFeatureType.R @@ -25,6 +25,7 @@ WFSDescribeFeatureType <- R6Class("WFSDescribeFeatureType", namedParams <- list(service = "WFS", version = version, typeName = typeName) super$initialize(op, "GET", url, request = private$name, namedParams = namedParams, mimeType = "text/xml", ...) + self$execute() } ) ) \ No newline at end of file diff --git a/R/WFSFeatureType.R b/R/WFSFeatureType.R index 5226067..840ac6d 100644 --- a/R/WFSFeatureType.R +++ b/R/WFSFeatureType.R @@ -10,7 +10,7 @@ #' #' @section Methods: #' \describe{ -#' \item{\code{new(xmlObj, op, url, version)}}{ +#' \item{\code{new(xmlObj, capabilities, version, logger)}}{ #' This method is used to instantiate a \code{WFSFeatureType} object #' } #' \item{\code{getName()}}{ @@ -142,11 +142,11 @@ WFSFeatureType <- R6Class("WFSFeatureType", public = list( description = NULL, features = NULL, - initialize = function(xmlObj, capabilities, url, version, logger = NULL){ + initialize = function(xmlObj, capabilities, version, logger = NULL){ super$initialize(logger = logger) private$capabilities = capabilities - private$url = url + private$url = capabilities$getUrl() private$version = version featureType = private$fetchFeatureType(xmlObj, version) diff --git a/R/WFSGetFeature.R b/R/WFSGetFeature.R index aa970b7..f8b7b77 100644 --- a/R/WFSGetFeature.R +++ b/R/WFSGetFeature.R @@ -25,6 +25,7 @@ WFSGetFeature <- R6Class("WFSGetFeature", namedParams <- list(service = "WFS", version = version, typeName = typeName) super$initialize(op, "GET", url, request = private$name, namedParams = namedParams, mimeType = "text/xml", ...) + self$execute() } ) ) \ No newline at end of file diff --git a/README.md b/README.md index 1449e8b..e48c4c2 100644 --- a/README.md +++ b/README.md @@ -8,7 +8,7 @@ R client for OGC Web-Services ``ows4R`` is a new project that aims to set-up a pure R interface to OGC Web-Services. In a first time (ongoing work), ``ows4R`` will target: -* the Common OGC Web-Services specifications, version ``1.1.0`` +* the Common OGC Web-Services specifications, versions ``1.1`` and ``2.0`` * the Catalogue Service for the Web (CSW), versions ``2.0.2`` and ``3.0`` * the Web Feature Service (WFS), versions ``1.0.0``, ``1.1.0``, and ``2.0.0`` @@ -17,7 +17,7 @@ R client for OGC Web-Services Standard |Description|Supported versions|Supported R bindings|Support ----------|-----------|------------------|--------------------|------| OGC Filter|[Filter Encoding](http://www.opengeospatial.org/standards/filter)|``1.1.0``||ongoing -OGC Common|[Web Service Common](http://www.opengeospatial.org/standards/common)|``1.1.0``||ongoing +OGC Common|[Web Service Common](http://www.opengeospatial.org/standards/common)|``1.1``,``2.0``||ongoing OGC CSW |[Catalogue Service](http://www.opengeospatial.org/standards/cat)|``2.0.2``,``3.0.0``|[geometa](https://github.com/eblondel/geometa) (ISO 19115 / 19119 / 19110)|ongoing / seeking fundings OGC WFS |[Web Feature Service](http://www.opengeospatial.org/standards/wfs)|``1.0.0``,``1.1.0``,``2.0.0``|[sf](https://github.com/r-spatial/sf) (OGC Simple Feature)|ongoing diff --git a/man/CSWClient.Rd b/man/CSWClient.Rd index 5d6cff6..e11844f 100644 --- a/man/CSWClient.Rd +++ b/man/CSWClient.Rd @@ -18,7 +18,7 @@ CSWClient \section{Methods}{ \describe{ - \item{\code{new(url, version, user, pwd, logger)}}{ + \item{\code{new(url, serviceVersion, user, pwd, logger)}}{ This method is used to instantiate a CSWClient with the \code{url} of the OGC service. Authentication (\code{user}/\code{pwd}) is not yet supported and will be added with the support of service transactional modes. By default, the \code{logger} @@ -43,7 +43,7 @@ CSWClient \examples{ \dontrun{ - CSWClient$new("http://localhost:8080/geonetwork/srv/eng/csw", version = "2.0.2") + CSWClient$new("http://localhost:8080/geonetwork/srv/eng/csw", serviceVersion = "2.0.2") } } diff --git a/man/CSWQuery.Rd b/man/CSWQuery.Rd new file mode 100644 index 0000000..e79def1 --- /dev/null +++ b/man/CSWQuery.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CSWQuery.R +\docType{class} +\name{CSWQuery} +\alias{CSWQuery} +\title{CSWQuery} +\format{\code{\link{R6Class}} object.} +\usage{ +CSWQuery +} +\value{ +Object of \code{\link{R6Class}} for modelling an CSW Query +} +\description{ +CSWQuery +} +\section{Methods}{ + +\describe{ + \item{\code{new(filter, cswVersion)}}{ + This method is used to instantiate an CSWQUery object. + } +} +} + +\keyword{OGC} +\keyword{Query} diff --git a/man/OWSCapabilities.Rd b/man/OWSCapabilities.Rd index 119269f..cf45859 100644 --- a/man/OWSCapabilities.Rd +++ b/man/OWSCapabilities.Rd @@ -18,7 +18,7 @@ OWSGetCapabilities \section{Methods}{ \describe{ - \item{\code{new(url, service, version, logger)}}{ + \item{\code{new(url, service, serviceVersion, owsVersion, logger)}}{ This method is used to instantiate a OWSGetCapabilities object } \item{\code{getUrl()}}{ diff --git a/man/OWSClient.Rd b/man/OWSClient.Rd index 04a0959..9bf76ad 100644 --- a/man/OWSClient.Rd +++ b/man/OWSClient.Rd @@ -26,7 +26,7 @@ OWSClient \section{Methods}{ \describe{ - \item{\code{new(url, service, version, user, pwd, logger)}}{ + \item{\code{new(url, service, serviceVersion, user, pwd, logger)}}{ This method is used to instantiate a OWSClient with the \code{url} of the OGC service. Authentication (\code{user}/\code{pwd}) is not yet supported and will be added with the support of service transactional modes. By default, the \code{logger} @@ -47,7 +47,7 @@ OWSClient \examples{ \dontrun{ - OWSClient$new("http://localhost:8080/geoserver/ows", version = "1.1.0") + OWSClient$new("http://localhost:8080/geoserver/ows", serviceVersion = "1.1.0") } } diff --git a/man/OWSGetCapabilities.Rd b/man/OWSGetCapabilities.Rd new file mode 100644 index 0000000..1c1f380 --- /dev/null +++ b/man/OWSGetCapabilities.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/OWSGetCapabilities.R +\docType{class} +\name{OWSGetCapabilities} +\alias{OWSGetCapabilities} +\title{OWSGetCapabilities} +\format{\code{\link{R6Class}} object.} +\usage{ +OWSGetCapabilities +} +\value{ +Object of \code{\link{R6Class}} for modelling a GetCapabilities request +} +\description{ +OWSGetCapabilities +} +\section{Methods}{ + +\describe{ + \item{\code{new(op, url, service, version)}}{ + This method is used to instantiate a OWSGetCapabilities object + } +} +} + +\author{ +Emmanuel Blondel +} +\keyword{GetCapabilities} +\keyword{OGC} diff --git a/man/OWSOperation.Rd b/man/OWSOperation.Rd index c80b530..51f37d5 100644 --- a/man/OWSOperation.Rd +++ b/man/OWSOperation.Rd @@ -17,7 +17,7 @@ OWSOperation \section{Methods}{ \describe{ - \item{\code{new(xmlObj, service, version)}}{ + \item{\code{new(xmlObj, serviceVersion)}}{ This method is used to instantiate an OWSOperation object } \item{\code{getName()}}{ diff --git a/man/OWSOperationsMetadata.Rd b/man/OWSOperationsMetadata.Rd index 7ae8e63..621fdbf 100644 --- a/man/OWSOperationsMetadata.Rd +++ b/man/OWSOperationsMetadata.Rd @@ -17,7 +17,7 @@ OWSOperationsMetadata \section{Methods}{ \describe{ - \item{\code{new(xmlObj, service, version)}}{ + \item{\code{new(xmlObj, serviceVersion)}}{ This method is used to instantiate a OWSOperationsMetadata object } \item{\code{getOperations()}}{ diff --git a/man/OWSServiceIdentification.Rd b/man/OWSServiceIdentification.Rd index 5f905f1..f0d70ae 100644 --- a/man/OWSServiceIdentification.Rd +++ b/man/OWSServiceIdentification.Rd @@ -17,7 +17,7 @@ OWSServiceIdentification \section{Methods}{ \describe{ - \item{\code{new(xmlObj, url, service)}}{ + \item{\code{new(xmlObj, serviceVersion)}}{ This method is used to instantiate a OWSServiceIdentification object } \item{\code{getName()}}{ diff --git a/man/OWSServiceProvider.Rd b/man/OWSServiceProvider.Rd index 845b5a1..76506d2 100644 --- a/man/OWSServiceProvider.Rd +++ b/man/OWSServiceProvider.Rd @@ -17,7 +17,7 @@ OWSServiceProvider \section{Methods}{ \describe{ - \item{\code{new(xmlObj, url, service)}}{ + \item{\code{new(xmlObj, version)}}{ This method is used to instantiate a OWSServiceProvider object } \item{\code{getProviderName()}}{ diff --git a/man/WFSClient.Rd b/man/WFSClient.Rd index 068c314..e658f79 100644 --- a/man/WFSClient.Rd +++ b/man/WFSClient.Rd @@ -18,7 +18,7 @@ WFSClient \section{Methods}{ \describe{ - \item{\code{new(url, version, user, pwd, logger)}}{ + \item{\code{new(url, serviceVersion, user, pwd, logger)}}{ This method is used to instantiate a WFSClient with the \code{url} of the OGC service. Authentication (\code{user}/\code{pwd}) is not yet supported and will be added with the support of service transactional modes. By default, the \code{logger} diff --git a/man/WFSFeatureType.Rd b/man/WFSFeatureType.Rd index 78d13b3..53f5856 100644 --- a/man/WFSFeatureType.Rd +++ b/man/WFSFeatureType.Rd @@ -20,7 +20,7 @@ Class used internally by ows4R. \section{Methods}{ \describe{ - \item{\code{new(xmlObj, op, url, version)}}{ + \item{\code{new(xmlObj, capabilities, version, logger)}}{ This method is used to instantiate a \code{WFSFeatureType} object } \item{\code{getName()}}{ diff --git a/tests/testthat/test_CSWClient.R b/tests/testthat/test_CSWClient.R index 5f54059..5a86367 100644 --- a/tests/testthat/test_CSWClient.R +++ b/tests/testthat/test_CSWClient.R @@ -13,15 +13,16 @@ mdfile <- system.file("extdata/data", "metadata.xml", package = "ows4R") md <- geometa::ISOMetadata$new(xml = xmlParse(mdfile)) #CSW 2.0.2 -#-------------------------------------------------------------------------- -csw <- CSWClient$new("http://localhost:8000/csw", "2.0.2", logger="DEBUG") +#========================================================================== +csw2 <- CSWClient$new("http://localhost:8000/csw", "2.0.2", logger="DEBUG") #CSW 2.0.2 – GetCapabilities #-------------------------------------------------------------------------- #--> pycsw test_that("CSW 2.0.2 - GetCapabilities | pycsw",{ - expect_is(csw, "CSWClient") - caps <- csw$getCapabilities() + expect_is(csw2, "CSWClient") + expect_equal(csw2$getVersion(), "2.0.2") + caps <- csw2$getCapabilities() expect_is(caps, "CSWCapabilities") #service identification @@ -29,7 +30,7 @@ test_that("CSW 2.0.2 - GetCapabilities | pycsw",{ expect_equal(SI$getTitle(), "pycsw Geospatial Catalogue") expect_equal(SI$getAbstract(), "pycsw is an OGC CSW server implementation written in Python") expect_equal(SI$getServiceType(), "CSW") - expect_equal(SI$getServiceTypeVersion(), "2.0.2") + expect_equal(SI$getServiceTypeVersion(), c("2.0.2","3.0.0")) expect_equal(SI$getKeywords(), c("catalogue","discovery","metadata")) expect_equal(SI$getFees(), "None") expect_equal(SI$getAccessConstraints(), "None") @@ -72,7 +73,7 @@ test_that("CSW 2.0.2 - GetCapabilities | pycsw",{ #CSW 2.0.2 – DescribeRecord #-------------------------------------------------------------------------- #test_that("CSW 2.0.2 - DescribeRecord",{ -# xsd <- csw$describeRecord(namespace = "http://www.isotc211.org/2005/gmd") +# xsd <- csw2$describeRecord(namespace = "http://www.isotc211.org/2005/gmd") #}) #CSW 2.0.2 – Transaction @@ -80,14 +81,14 @@ test_that("CSW 2.0.2 - GetCapabilities | pycsw",{ #Insert test_that("CSW 2.0.2 - Transaction - Insert",{ - insert <- csw$insertRecord(record = md) + insert <- csw2$insertRecord(record = md) expect_true(insert$getResult()) }) #Update (Full) test_that("CSW 2.0.2 - Transaction - Update (Full)",{ md$identificationInfo[[1]]$citation$setTitle("a new title") - update <- csw$updateRecord(record = md) + update <- csw2$updateRecord(record = md) expect_true(update$getResult()) }) @@ -95,31 +96,175 @@ 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) - update <- csw$updateRecord(recordProperty = recordProperty, constraint = constraint) + update <- csw2$updateRecord(recordProperty = recordProperty, constraint = constraint) expect_true(update$getResult()) }) #Delete test_that("CSW 2.0.2 - Transaction - Delete",{ - delete <- csw$deleteRecordById(md$fileIdentifier) + delete <- csw2$deleteRecordById(md$fileIdentifier) expect_true(delete$getResult()) }) #CSW 2.0.2 – GetRecordById #-------------------------------------------------------------------------- test_that("CSW 2.0.2 - GetRecordById",{ - insert <- csw$insertRecord(record = md) + insert <- csw2$insertRecord(record = md) if(insert$getResult()){ - md <- csw$getRecordById("my-metadata-identifier", outputSchema = "http://www.isotc211.org/2005/gmd") + md <- csw2$getRecordById("my-metadata-identifier", outputSchema = "http://www.isotc211.org/2005/gmd") expect_is(md, "ISOMetadata") } }) -#CSW 2.0.2 – GetRecords +#CSW 2.0.2 – GetRecords / csw:Record (Dublin Core) #-------------------------------------------------------------------------- -#test_that("CSW 2.0.2 - GetRecords",{ -# csw <- CSWClient$new("http://www.fao.org/geonetwork/srv/en/csw", "2.0.2", logger = "INFO") -# mdlist <- csw$getRecords(constraint = "AnyText+like+%cwp-grid%", outputSchema = "http://www.isotc211.org/2005/gmd") -# expect_equal(unique(sapply(mdlist, is)), "ISOMetadata") -#}) +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) +}) + +test_that("CSW 2.0.2 - GetRecords - full / maxRecords",{ + #as Dublin core records (R lists) + records <- csw2$getRecords(query = CSWQuery$new(), maxRecords = 10L) + expect_equal(length(records), 10L) +}) + +test_that("CSW 2.0.2 - GetRecords - cqlText / dc:title"{ + cons <- CSWConstraint$new(cqlText = "dc:title like '%ips%'") + query <- CSWQuery$new(constraint = cons) + records <- csw2$getRecords(query = query) + expect_equal(length(records), 2L) +}) + +test_that("CSW 2.0.2 - GetRecords - cqlText / dc:title and dc:abstract"{ + cons <- CSWConstraint$new(cqlText = "dc:title like '%ips%' and dct:abstract like '%pharetra%'") + query <- CSWQuery$new(constraint = cons) + records <- csw2$getRecords(query = query) + expect_equal(length(records), 1L) +}) + +test_that("CSW 2.0.2 - GetRecords - cqlText / dc:identifier"{ + cons <- CSWConstraint$new(cqlText = "dc:identifier = 'my-metadata-identifier'") + query <- CSWQuery$new(constraint = cons) + records <- csw2$getRecords(query = query) + expect_equal(length(records), 1L) +}) + +test_that("CSW 2.0.2 - GetRecords - Filter / AnyText"{ + filter <- OGCFilter$new( PropertyIsLike$new("csw:AnyText", "%Physio%")) + cons <- CSWConstraint$new(filter = filter) + query <- CSWQuery$new(constraint = cons) + records <- csw2$getRecords(query = query) + expect_equal(length(records), 2L) +}) + +test_that("CSW 2.0.2 - GetRecords - Filter / AnyText Equal"{ + filter <- OGCFilter$new( PropertyIsEqualTo$new("csw:AnyText", "species")) + cons <- CSWConstraint$new(filter = filter) + query <- CSWQuery$new(constraint = cons) + records <- csw2$getRecords(query = query) + expect_equal(length(records), 0L) +}) + +#CSW 2.0.2 – GetRecords / gmd:MD_Metadata (ISO 19115/19319 - R geometa binding) +#-------------------------------------------------------------------------- + +test_that("CSW 2.0.2 - GetRecords - cqlText / dc:identifier"{ + cons <- CSWConstraint$new(cqlText = "dc:identifier = 'my-metadata-identifier'") + query <- CSWQuery$new(constraint = cons) + records <- csw2$getRecords(query = query, outputSchema = "http://www.isotc211.org/2005/gmd") + expect_equal(length(records), 1L) +}) + +#CSW 3.0 +#========================================================================== +csw3 <- CSWClient$new("http://localhost:8000/csw", "3.0", logger="DEBUG") + +#CSW 3.0 – GetCapabilities +#-------------------------------------------------------------------------- +#--> pycsw +test_that("CSW 3.0 - GetCapabilities | pycsw",{ + expect_is(csw3, "CSWClient") + expect_equal(csw3$getVersion(), "3.0") + caps <- csw3$getCapabilities() + expect_is(caps, "CSWCapabilities") + + #service identification + SI <- caps$getServiceIdentification() + expect_equal(SI$getTitle(), "pycsw Geospatial Catalogue") + expect_equal(SI$getAbstract(), "pycsw is an OGC CSW server implementation written in Python") + expect_equal(SI$getServiceType(), "CSW") + expect_equal(SI$getServiceTypeVersion(), c("2.0.2","3.0.0")) + expect_equal(SI$getKeywords(), c("catalogue","discovery","metadata")) + expect_equal(SI$getFees(), "None") + expect_equal(SI$getAccessConstraints(), "None") + + #service provider + SP <- caps$getServiceProvider() + expect_equal(SP$getProviderName(), "Organization Name") + expect_is(SP$getProviderSite(), "ISOOnlineResource") + expect_equal(SP$getProviderSite()$linkage$value, "http://pycsw.org/") + rp <- SP$getServiceContact() + expect_is(rp, "ISOResponsibleParty") + expect_equal(rp$individualName, "Lastname, Firstname") + expect_equal(rp$positionName, "Position Title") + contact <- rp$contactInfo + expect_is(contact, "ISOContact") + expect_is(contact$phone, "ISOTelephone") + expect_equal(contact$phone$voice, "+xx-xxx-xxx-xxxx") + expect_equal(contact$phone$facsimile, "+xx-xxx-xxx-xxxx") + expect_is(contact$address, "ISOAddress") + expect_equal(contact$address$deliveryPoint, "Mailing Address") + expect_equal(contact$address$city, "City") + expect_equal(contact$address$postalCode, "Zip or Postal Code") + expect_equal(contact$address$country, "Country") + expect_equal(contact$address$electronicMailAddress, "you@example.org") + expect_is(contact$onlineResource, "ISOOnlineResource") + expect_equal(contact$onlineResource$linkage$value, "Contact URL") + + #service operation metadata + OPM <- caps$getOperationsMetadata() + OP <- OPM$getOperations() + expect_is(OP, "list") + expect_equal(length(OP), 7L) + expect_equal(unique(sapply(OP, function(i){class(i)[1]})), "OWSOperation") + operations <- sapply(OP,function(op){op$getName()}) + expect_equal(operations, c("GetCapabilities", "GetDomain", "GetRecords", "GetRecordById", + "GetRepositoryItem", "Transaction", "Harvest")) + +}) + +#CSW 3.0 – Transaction +#-------------------------------------------------------------------------- + +#Insert +test_that("CSW 3.0 - Transaction - Insert",{ + #TBD +}) + +#Update (Full) +test_that("CSW 3.0 - Transaction - Update (Full)",{ + #TBD +}) + +test_that("CSW 3.0 - Transaction - Update (Partial)",{ + #TBD +}) + +#Delete +test_that("CSW 3.0 - Transaction - Delete",{ + #TBD +}) +#CSW 3.0 – GetRecordById +#-------------------------------------------------------------------------- +test_that("CSW 3.0 - GetRecordById",{ + #TBD +}) + +#CSW 3.0 – GetRecords +#-------------------------------------------------------------------------- +test_that("CSW 3.0 - GetRecords",{ + #TBD +}) \ No newline at end of file diff --git a/tests/testthat/test_CSWQuery.R b/tests/testthat/test_CSWQuery.R new file mode 100644 index 0000000..f01b32d --- /dev/null +++ b/tests/testthat/test_CSWQuery.R @@ -0,0 +1,26 @@ +# test_CSWQuery.R +# Author: Emmanuel Blondel +# +# Description: Unit tests for CSW Query +#======================= +require(ows4R, quietly = TRUE) +require(geometa) +require(testthat) +context("CSWQuery") + +test_that("CSWQuery - elementSetName",{ + query_full <- CSWQuery$new() + expect_is(query_full, "CSWQuery") + expect_equal(query_full$ElementSetName, "full") + query_brief <- CSWQuery$new(elementSetName = "brief") + expect_is(query_brief, "CSWQuery") + expect_equal(query_brief$ElementSetName, "brief") + query_summary <- CSWQuery$new(elementSetName = "summary") + expect_is(query_summary, "CSWQuery") + expect_equal(query_summary$ElementSetName, "summary") +}) + +test_that("CSWQuery - cqlText with title"{ + cons <- CSWConstraint$new(cqlText = "dc:title like '%ips%'") + query <- CSWQuery$new(constraint = cons) +})