#3 working on CSW3 + start FES 2.0

eblondel · Jul 28, 2018 · 0cb75e3 · 0cb75e3
1 parent 2acf4cf
commit 0cb75e3
Show file tree

Hide file tree

Showing 6 changed files with 82 additions and 19 deletions.
diff --git a/R/CSWClient.R b/R/CSWClient.R
@@ -140,12 +140,13 @@ CSWClient <- R6Class("CSWClient",
          "Delete" = "Deleted"
        )
        transaction$setResult(FALSE)
-
        if(is.null(xmlNamespaces(transaction$getResponse())$csw)){
          return(transaction)
        }else{
-         result <- getNodeSet(transaction$getResponse(),paste0("//csw:total",summaryKey),
-                                c(csw = xmlNamespaces(transaction$getResponse())$csw$uri))
+         ns <- ifelse(self$getVersion()=="3.0.0", "csw30", "csw")
+         nsUri <- xmlNamespaces(transaction$getResponse())[[ns]]$uri
+         names(nsUri) <- ifelse(self$getVersion()=="3.0.0", "csw30", "csw")
+         result <- getNodeSet(transaction$getResponse(),paste0("//",ns,":total",summaryKey), nsUri)
          if(length(result)>0){
            result <- result[[1]]
            if(xmlValue(result)>0) transaction$setResult(TRUE)
@@ -170,18 +171,21 @@ CSWClient <- R6Class("CSWClient",
        if(!is.null(constraint)) if(!is(constraint, "CSWConstraint")){
          stop("The argument constraint should be an object of class 'CSWConstraint'")
        }
+       if(!is.null(constraint)) constraint$setServiceVersion(self$getVersion())
        return(self$transaction("Update", record = record, recordProperty = recordProperty, constraint = constraint, ...))
      },
 
      #deleteRecord
      deleteRecord = function(record = NULL, constraint = NULL, ...){
+       if(!is.null(constraint)) constraint$setServiceVersion(self$getVersion())
        return(self$transaction("Delete", record = record, constraint = constraint, ...))
      },
 
      #deleteRecordById
      deleteRecordById = function(id){
        ogcFilter = OGCFilter$new( PropertyIsEqualTo$new("apiso:Identifier", id) )
        cswConstraint = CSWConstraint$new(filter = ogcFilter)
+       cswConstraint$setServiceVersion(self$getVersion())
        return(self$deleteRecord(constraint = cswConstraint))
      }
    )

diff --git a/R/CSWConstraint.R b/R/CSWConstraint.R
@@ -31,6 +31,7 @@ CSWConstraint <-  R6Class("CSWConstraint",
         stop("The argument 'filter' should be an object of class 'OGCFilter'")
       }
       self$CqlText = cqlText
+      if(!is.null(filter)) filter$setFilterVersion("2.0")
       self$filter = filter
     },
 

diff --git a/R/CSWTransaction.R b/R/CSWTransaction.R
@@ -23,12 +23,12 @@ CSWTransaction <- R6Class("CSWTransaction",
     xmlNamespace = c(csw = "http://www.opengis.net/cat/csw")
   ),
   public = list(
-    initialize = function(op, url, version, type, user = NULL, pwd = NULL,
+    initialize = function(op, url, serviceVersion, type, user = NULL, pwd = NULL,
                           record = NULL, recordProperty = NULL, constraint = NULL,
                           logger = NULL, ...) {
-      nsName <- names(private$xmlNamespace)
-      private$xmlNamespace = paste(private$xmlNamespace, version, sep="/")
-      names(private$xmlNamespace) <- nsName
+      nsVersion <- ifelse(serviceVersion=="3.0.0", "3.0", serviceVersion)
+      private$xmlNamespace = paste(private$xmlNamespace, nsVersion, sep="/")
+      names(private$xmlNamespace) <- ifelse(serviceVersion=="3.0.0", "csw30", "csw")
 
       self[[type]] = list(
         record = record,
@@ -40,7 +40,7 @@ CSWTransaction <- R6Class("CSWTransaction",
                        contentType = "text/xml", mimeType = "text/xml",
                        logger = logger, ...)
       self$wrap <- TRUE
-      self$attrs <- list(service = "CSW", version = version)
+      self$attrs <- list(service = "CSW", version = serviceVersion)
       self$execute()
     }
 

diff --git a/R/OGCExpression.R b/R/OGCExpression.R
@@ -14,11 +14,31 @@
 OGCExpression <-  R6Class("OGCExpression",
    inherit = OGCAbstractObject,
    private = list(
+     exprVersion = "1.1.0",
+     xmlNamespaceBase = "http://www.opengis.net/ogc",
      xmlNamespace = c(ogc = "http://www.opengis.net/ogc")
    ),
    public = list(
-     initialize = function(attrs = NULL, defaults = NULL){
+     initialize = function(attrs = NULL, defaults = NULL, exprVersion = "1.1.0"){
+       self$setExprVersion(exprVersion)
        super$initialize(attrs,defaults)
+     },
+
+     #setExprVersion
+     setExprVersion = function(exprVersion) {
+       private$exprVersion = exprVersion
+       if(exprVersion=="2.0"){
+         private$xmlNamespace = "http://www.opengis.net/fes/2.0"
+         names(private$xmlNamespace) <- "fes"
+       }else{
+         private$xmlNamespace = private$xmlNamepaceBase
+         names(private$xmlNamespace) = "ogc"
+       }
+     },
+
+     #getExprVersion
+     getExprVersion = function(){
+       return(private$exprVersion)
      }
    )
 )
@@ -324,6 +344,14 @@ BinaryLogicOpType <-  R6Class("BinaryLogicOpType",
          stop("Binary operations (And / Or) require a minimum of two operations")
        }
        self$operations = operations
+     },
+
+     #setExprVersion
+     setExprVersion = function(exprVersion){
+       private$exprVersion <- exprVersion
+       for(i in 1:length(self$operations)){
+         self$operations[[i]]$setExprVersion(exprVersion)
+       }
      }
    )
 )
@@ -393,6 +421,14 @@ UnaryLogicOpType <-  R6Class("UnaryLogicOpType",
     operations = list(),
     initialize = function(...){
       self$operations = list(...)
+    },
+
+    #setExprVersion
+    setExprVersion = function(exprVersion){
+      private$exprVersion <- exprVersion
+      for(i in 1:length(self$operations)){
+        self$operations[[i]]$setExprVersion(exprVersion)
+      }
     }
   )
 )

diff --git a/R/OGCFilter.R b/R/OGCFilter.R
@@ -15,16 +15,29 @@ OGCFilter <-  R6Class("OGCFilter",
   inherit = OGCAbstractObject,
   private = list(
     xmlElement = "Filter",
+    xmlNamespaceBase = "http://www.opengis.net/ogc",
     xmlNamespace = c(ogc = "http://www.opengis.net/ogc")
   ),
   public = list(
     expr = NULL,
-    initialize = function(expr){
+    initialize = function(expr, filterVersion = "1.1.0"){
+      self$setFilterVersion(filterVersion)
       super$initialize()
       if(!is(expr, "OGCExpression")){
         stop("The argument should be an object of class 'OGCExpression'")
       }
       self$expr <- expr
+    },
+
+    #setFilterVersion
+    setFilterVersion = function(filterVersion) {
+      if(filterVersion=="2.0"){
+        private$xmlNamespace = "http://www.opengis.net/fes/2.0"
+        names(private$xmlNamespace) <- "fes"
+      }else{
+        private$xmlNamespace = private$xmlNamespaceBase
+        names(private$xmlNamespace) = "ogc"
+      }
     }
   )
 )
diff --git a/tests/testthat/test_CSWClient_v3_0.R b/tests/testthat/test_CSWClient_v3_0.R
@@ -77,22 +77,31 @@ test_that("CSW 3.0 - GetCapabilities | pycsw",{
 
 #Insert
 test_that("CSW 3.0 - Transaction - Insert",{
-  #TBD
+  insert <- csw3$insertRecord(record = md)
+  expect_true(insert$getResult())
 })
 
 #Update (Full)
 test_that("CSW 3.0 - Transaction - Update (Full)",{
-  #TBD
+  md$identificationInfo[[1]]$citation$setTitle("a new title")
+  update <- csw3$updateRecord(record = md)
+  expect_true(update$getResult())
 })
 
-test_that("CSW 3.0 - Transaction - Update (Partial)",{
-  #TBD
-})
+#Update (Partial) - DOES NOT WORK, REQUIRES FES 2.0 implementation
+#test_that("CSW 3.0 - Transaction - Update (Partial)",{
+#  recordProperty <- CSWRecordProperty$new("apiso:Title", "NEW_TITLE")
+#  filter = OGCFilter$new(PropertyIsEqualTo$new("apiso:Identifier", md$fileIdentifier))
+#  constraint <- CSWConstraint$new(filter = filter)
+#  update <- csw3$updateRecord(recordProperty = recordProperty, constraint = constraint)
+#  expect_true(update$getResult())
+#})
 
-#Delete
-test_that("CSW 3.0 - Transaction - Delete",{
-  #TBD
-})
+#Delete - DOES NOT WORK, REQUIRES FES 2.0 implementation
+#test_that("CSW 3.0 - Transaction - Delete",{
+#  delete <- csw3$deleteRecordById(md$fileIdentifier)
+#  expect_true(delete$getResult())
+#})
 
 #CSW 3.0 – GetRecordById
 #--------------------------------------------------------------------------