#5 Filter Encoding + #5 CSW Transactional

eblondel · Jun 27, 2018 · a66fea1 · a66fea1
1 parent 8ac5ee9
commit a66fea1
Show file tree

Hide file tree

Showing 53 changed files with 1,697 additions and 288 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,16 +1,14 @@
 Package: ows4R
 Version: 0.1
-Date: 2018-05-18
+Date: 2018-06-28
 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")))
 Maintainer: Emmanuel Blondel <[email protected]>
 Depends: R (>= 2.15), geometa
 Imports: R6, httr, XML (>= 3.96-1.1), sf, rgdal
 Suggests: testthat
-Description: Provides an interface to OGC Web-Services (OWS). In a first step, the package supports the Common
- OGC Web-Services specifications the Web Feature Service (WFS). ows4R will progressively support other OGC web
- service specifications such as Web Map Service (WMS), Web Coverage Service, or Catalogue Service for the web (CSW).
+Description: Provides an interface to OGC Web-Services (OWS).
 License: MIT + file LICENSE
 URL: https://github.com/eblondel/ows4R
 BugReports: https://github.com/eblondel/ows4R/issues

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,10 +1,21 @@
 # Generated by roxygen2: do not edit by hand
 
+export(And)
+export(BBox)
+export(BinaryComparisonOpType)
+export(BinaryLogicOpType)
 export(CSWCapabilities)
 export(CSWClient)
+export(CSWConstraint)
 export(CSWDescribeRecord)
 export(CSWGetRecordById)
 export(CSWGetRecords)
+export(CSWRecordProperty)
+export(CSWTransaction)
+export(Not)
+export(OGCAbstractObject)
+export(OGCExpression)
+export(OGCFilter)
 export(OWSCapabilities)
 export(OWSClient)
 export(OWSOperation)
@@ -13,6 +24,17 @@ export(OWSRequest)
 export(OWSServiceIdentification)
 export(OWSServiceProvider)
 export(OWSUtils)
+export(Or)
+export(PropertyIsBetween)
+export(PropertyIsEqualTo)
+export(PropertyIsGreaterThan)
+export(PropertyIsGreaterThanOrEqualTo)
+export(PropertyIsLessThan)
+export(PropertyIsLessThanOrEqualTo)
+export(PropertyIsLike)
+export(PropertyIsNotEqualTo)
+export(PropertyIsNull)
+export(UnaryLogicOpType)
 export(WFSCapabilities)
 export(WFSClient)
 export(WFSDescribeFeatureType)

diff --git a/R/CSWCapabilities.R b/R/CSWCapabilities.R
@@ -32,7 +32,7 @@ CSWCapabilities <- R6Class("CSWCapabilities",
      #initialize
      initialize = function(url, version, logger = NULL) {
        super$initialize(url, service = "CSW", version, logger = logger)
-       xmlObj <- self$getRequest()$response
+       xmlObj <- self$getRequest()$getResponse()
      }
    )
 )
diff --git a/R/CSWClient.R b/R/CSWClient.R
@@ -63,7 +63,7 @@ CSWClient <- R6Class("CSWClient",
          stop(errorMsg)
        }
        request <- CSWDescribeRecord$new(op, self$getUrl(), self$getVersion(), namespace = namespace, logger = self$loggerType, ...)
-       return(request$response)
+       return(request$getResponse())
      },
 
      #getRecordById
@@ -79,7 +79,7 @@ CSWClient <- R6Class("CSWClient",
          stop(errorMsg)
        }
        request <- CSWGetRecordById$new(op, self$getUrl(), self$getVersion(), id = id, logger = self$loggerType, ...)
-       return(request$response)
+       return(request$getResponse())
      },
 
      #getRecords
@@ -96,11 +96,11 @@ CSWClient <- R6Class("CSWClient",
        }
        request <- CSWGetRecords$new(op, self$getUrl(), self$getVersion(),
                                     constraint = constraint, logger = self$loggerType, ...)
-       return(request$response)
+       return(request$getResponse())
      },
 
      #transaction
-     transaction = function(type, record, constraint = NULL, ...){
+     transaction = function(type, record = NULL, recordProperty = NULL, constraint = NULL, ...){
        self$INFO(sprintf("Transaction (%s) ...", type))
        operations <- self$capabilities$getOperationsMetadata()$getOperations()
        op <- operations[sapply(operations,function(x){x$getName()=="Transaction"})]
@@ -112,30 +112,23 @@ CSWClient <- R6Class("CSWClient",
          stop(errorMsg)
        }
 
-       transaction <- CSWTransaction$new(op, self$getUrl(), self$getVersion(),
-                                         type = type, record = record, constraint = constraint, 
+       transaction <- CSWTransaction$new(op, self$getUrl(), self$getVersion(), type = type,
+                                         record = record, recordProperty = recordProperty, constraint = constraint, 
                                          logger = self$loggerType, ...)
 
-       exception <- getNodeSet(transaction$response, "//ows:ExceptionText", c(ows = xmlNamespaces(transaction$response)$ows$uri))
-       if(length(exception)>0){
-         exception <- exception[[1]]
-         transaction$exception <- xmlValue(exception)
-         self$ERROR(transaction$exception)
-       }
-
        summaryKey <- switch(type,
          "Insert" = "Inserted",
          "Update" = "Updated",
          "Delete" = "Deleted"
        )
-       transaction[[tolower(summaryKey)]] <- FALSE
-       result <- getNodeSet(transaction$response,paste0("//csw:total",summaryKey),
-                              c(csw = xmlNamespaces(transaction$response)$csw$uri))
+       transaction$setResult(FALSE)
+       result <- getNodeSet(transaction$getResponse(),paste0("//csw:total",summaryKey),
+                              c(csw = xmlNamespaces(transaction$getResponse())$csw$uri))
        if(length(result)>0){
          result <- result[[1]]
-         if(xmlValue(result)>0) transaction[[tolower(summaryKey)]] <- TRUE
+         if(xmlValue(result)>0) transaction$setResult(TRUE)
        }
-       if(transaction[[tolower(summaryKey)]]){
+       if(transaction$getResult()){
          self$INFO(sprintf("Successful transaction (%s)!", type))
        }
 
@@ -148,13 +141,26 @@ CSWClient <- R6Class("CSWClient",
      },
 
      #updateRecord
-     updateRecord = function(record = NULL, constraint = NULL, ...){
-       return(self$transaction("Update", record, constraint, ...))
+     updateRecord = function(record = NULL, recordProperty = NULL, constraint = NULL, ...){
+       if(!is.null(recordProperty)) if(!is(recordProperty, "CSWRecordProperty")){
+         stop("The argument recordProperty should be an object of class 'CSWRecordProperty'")
+       }
+       if(!is.null(constraint)) if(!is(constraint, "CSWConstraint")){
+         stop("The argument constraint should be an object of class 'CSWConstraint'")
+       }
+       return(self$transaction("Update", record, recordProperty, constraint, ...))
      },
 
      #deleteRecord
      deleteRecord = function(record = NULL, constraint = NULL, ...){
        return(self$transaction("Delete", record, constraint, ...))
+     },
+
+     #deleteRecordById
+     deleteRecordById = function(id){
+       ogcFilter = OGCFilter$new( PropertyIsEqualTo$new("apiso:Identifier", id) )
+       cswConstraint = CSWConstraint$new(ogcFilter)
+       return(self$deleteRecord(constraint = cswConstraint))
      }
    )
 )

diff --git a/R/CSWConstraint.R b/R/CSWConstraint.R
@@ -0,0 +1,33 @@
+#' CSWConstraint
+#' @docType class
+#' @export
+#' @keywords OGC Filter
+#' @return Object of \code{\link{R6Class}} for modelling an CSW Constraint
+#' @format \code{\link{R6Class}} object.
+#' @section Methods:
+#' \describe{
+#'  \item{\code{new(filter, cswVersion)}}{
+#'    This method is used to instantiate an CSWConstraint object.
+#'  }
+#' }
+CSWConstraint <-  R6Class("CSWConstraint",
+  inherit = OGCAbstractObject,
+  private = list(
+    xmlElement = "Constraint",
+    xmlNamespace = c(csw = "http://www.opengis.net/cat/csw")
+  ),
+  public = list(
+    wrap = TRUE,
+    filter = NULL,
+    initialize = function(filter, 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'")
+      }
+      self$filter = filter
+    }
+  )
+)
diff --git a/R/CSWDescribeRecord.R b/R/CSWDescribeRecord.R
@@ -23,7 +23,7 @@ CSWDescribeRecord <- R6Class("CSWDescribeRecord",
    ),
    public = list(
      initialize = function(op, url, version, namespace = NULL, logger = NULL, ...) {
-       namedParams <- list(request = private$name, version = version)
+       namedParams <- list(service = "CSW", version = version)
 
        #default output schema
        if(is.null(namespace)){
@@ -40,10 +40,12 @@ CSWDescribeRecord <- R6Class("CSWDescribeRecord",
        )
        namedParams <- c(namedParams, namespace = namespace, typeName = typeName)
 
-       super$initialize(op, "GET", url, namedParams = namedParams, mimeType = "text/xml", logger = logger, ...)
+       super$initialize(op, "GET", url, request = private$name,
+                        namedParams = namedParams,
+                        mimeType = "text/xml", logger = logger, ...)
 
        #binding to XML schema
-       xsdObjs <- getNodeSet(self$response, "//ns:schema", c(ns = "http://www.w3.org/2001/XMLSchema"))
+       xsdObjs <- getNodeSet(private$response, "//ns:schema", c(ns = "http://www.w3.org/2001/XMLSchema"))
        if(length(xsdObjs)>0){
          xsdObj <- xsdObjs[[1]]
          xmlNamespaces(xsdObj) <- c(as.vector(xmlNamespace(xsdObj)), gco = "http://www.isotc211.org/2005/gco")
@@ -73,9 +75,9 @@ CSWDescribeRecord <- R6Class("CSWDescribeRecord",
          tempf = tempfile() 
          destfile = paste(tempf,".xsd",sep='')
          saveXML(xsdObj, destfile)
-         self$response <- xmlSchemaParse(destfile)
+         private$response <- xmlSchemaParse(destfile)
        }else{
-         self$response <- NULL
+         private$response <- NULL
        }
      }
    )

diff --git a/R/CSWGetRecordById.R b/R/CSWGetRecordById.R
@@ -23,7 +23,7 @@ CSWGetRecordById <- R6Class("CSWGetRecordById",
     ),
     public = list(
       initialize = function(op, url, version, id, logger = NULL, ...) {
-        namedParams <- list(request = private$name, version = version, id = id)
+        namedParams <- list(service = "CSW", version = version, id = id)
 
         #default output schema
         outputSchema <- list(...)$outputSchema
@@ -32,12 +32,14 @@ CSWGetRecordById <- R6Class("CSWGetRecordById",
           namedParams <- c(namedParams, outputSchema = outputSchema)
         }
 
-        super$initialize(op, "GET", url, namedParams = namedParams, mimeType = "text/xml", logger = logger, ...)
+        super$initialize(op, "GET", url, request = private$name,
+                         namedParams = namedParams,
+                         mimeType = "text/xml", logger = logger, ...)
 
         #check response in case of ISO
         isoSchemas <- c("http://www.isotc211.org/2005/gmd","http://www.isotc211.org/2005/gfc")
         if(outputSchema %in% isoSchemas){
-          xmltxt <- as(self$response, "character")
+          xmltxt <- as(private$response, "character")
           isMetadata <- regexpr("MD_Metadata", xmltxt)>0
           isFeatureCatalogue <- regexpr("FC_FeatureCatalogue", xmltxt)>0
           if(isMetadata && outputSchema == isoSchemas[2]){
@@ -51,10 +53,10 @@ CSWGetRecordById <- R6Class("CSWGetRecordById",
         }
 
         #bindings
-        self$response <- switch(outputSchema,
+        private$response <- switch(outputSchema,
           "http://www.isotc211.org/2005/gmd" = {
             out <- NULL
-            xmlObjs <- getNodeSet(self$response, "//ns:MD_Metadata", c(ns = outputSchema))
+            xmlObjs <- getNodeSet(private$response, "//ns:MD_Metadata", c(ns = outputSchema))
             if(length(xmlObjs)>0){
               xmlObj <- xmlObjs[[1]]
               out <- geometa::ISOMetadata$new()
@@ -64,7 +66,7 @@ CSWGetRecordById <- R6Class("CSWGetRecordById",
           },
           "http://www.isotc211.org/2005/gfc" = {
             out <- NULL
-            xmlObjs <- getNodeSet(self$response, "//ns:FC_FeatureCatalogue", c(ns = outputSchema))
+            xmlObjs <- getNodeSet(private$response, "//ns:FC_FeatureCatalogue", c(ns = outputSchema))
             if(length(xmlObjs)>0){
               xmlObj <- xmlObjs[[1]]
               out <- geometa::ISOFeatureCatalogue$new()
@@ -74,11 +76,11 @@ CSWGetRecordById <- R6Class("CSWGetRecordById",
           },
           "http://www.opengis.net/cat/csw/2.0.2" = {
             warnings(sprintf("R binding not yet supported for '%s'", outputSchema))
-            self$response
+            private$response
           },
           "http://www.w3.org/ns/dcat#" = {
             warnings(sprintf("R binding not yet supported for '%s'", outputSchema))
-            self$response
+            private$response
           }
         )
       }

diff --git a/R/CSWGetRecords.R b/R/CSWGetRecords.R
@@ -23,7 +23,7 @@ CSWGetRecords <- R6Class("CSWGetRecords",
   ),
   public = list(
     initialize = function(op, url, version, constraint = NULL, logger = NULL, ...) {
-      namedParams <- list(request = private$name, version = version)
+      namedParams <- list(service = "CSW", version = version)
       if(!is.null(constraint)) namedParams <- c(namedParams, constraint = constraint)
 
       #default output schema
@@ -44,13 +44,15 @@ CSWGetRecords <- R6Class("CSWGetRecords",
       namedParams[["resultType"]] <- "results"
       namedParams[["CONSTRAINTLANGUAGE"]] <- "CQL_TEXT"
 
-      super$initialize(op, "GET", url, namedParams = namedParams, mimeType = "text/xml", logger = logger, ...)
+      super$initialize(op, "GET", url, request = private$name,
+                       namedParams = namedParams,
+                       mimeType = "text/xml", logger = logger, ...)
 
       #bindings
-      self$response <- switch(outputSchema,
+      private$response <- switch(outputSchema,
         "http://www.isotc211.org/2005/gmd" = {
           out <- NULL
-          xmlObjs <- getNodeSet(self$response, "//ns:MD_Metadata", c(ns = outputSchema))
+          xmlObjs <- getNodeSet(private$response, "//ns:MD_Metadata", c(ns = outputSchema))
           if(length(xmlObjs)>0){
             out <- lapply(xmlObjs,function(xmlObj){
               out.obj <- geometa::ISOMetadata$new()
@@ -62,7 +64,7 @@ CSWGetRecords <- R6Class("CSWGetRecords",
         },
         "http://www.isotc211.org/2005/gfc" = {
           out <- NULL
-          xmlObjs <- getNodeSet(self$response, "//ns:FC_FeatureCatalogue", c(ns = outputSchema))
+          xmlObjs <- getNodeSet(private$response, "//ns:FC_FeatureCatalogue", c(ns = outputSchema))
           if(length(xmlObjs)>0){
             out <- lapply(xmlObjs,function(xmlObj){
               out.obj <- geometa::ISOFeatureCatalogue$new()
@@ -74,11 +76,11 @@ CSWGetRecords <- R6Class("CSWGetRecords",
         },
         "http://www.opengis.net/cat/csw/2.0.2" = {
           warnings(sprintf("R binding not yet supported for '%s'", outputSchema))
-          self$response
+          private$response
         },
         "http://www.w3.org/ns/dcat#" = {
           warnings(sprintf("R binding not yet supported for '%s'", outputSchema))
-          self$response
+          private$response
         }
       )
     }

diff --git a/R/CSWRecordProperty.R b/R/CSWRecordProperty.R
@@ -0,0 +1,32 @@
+#' CSWRecordProperty
+#' @docType class
+#' @export
+#' @keywords CSW RecordProperty
+#' @return Object of \code{\link{R6Class}} for modelling an CSW RecordProperty
+#' @format \code{\link{R6Class}} object.
+#' @section Methods:
+#' \describe{
+#'  \item{\code{new(name, value)}}{
+#'    This method is used to instantiate an CSWRecordProperty object.
+#'  }
+#' }
+CSWRecordProperty <-  R6Class("CSWRecordProperty",
+  inherit = OGCAbstractObject,
+  private = list(
+    xmlElement = "RecordProperty",
+    xmlNamespace = c(csw = "http://www.opengis.net/cat/csw")
+  ),
+  public = list(
+    wrap = TRUE,
+    Name = NULL,
+    Value = NULL,
+    initialize = function(name, value, cswVersion = "2.0.2"){
+      nsName <- names(private$xmlNamespace)
+      private$xmlNamespace = paste(private$xmlNamespace, cswVersion, sep="/")
+      names(private$xmlNamespace) <- nsName
+      super$initialize()
+      self$Name = name
+      self$Value = value
+    }
+  )
+)