#3 work on CSW Client

eblondel · Jul 27, 2018 · cc71f25 · cc71f25
1 parent 158d916
commit cc71f25
Show file tree

Hide file tree

Showing 10 changed files with 76 additions and 30 deletions.
diff --git 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 = "[email protected]", comment = c(ORCID = "0000-0002-5870-5762")),
              person("Norbert", "Billet", role = c("ctb")))

diff --git 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
@@ -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
@@ -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
@@ -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
diff --git a/man/CSWGetRecordById.Rd b/man/CSWGetRecordById.Rd
diff --git a/man/CSWGetRecords.Rd b/man/CSWGetRecords.Rd
diff --git a/man/ows4R.Rd b/man/ows4R.Rd
diff --git 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",{