#3 CSW work in progress

NAMESPACE

@@ -2,7 +2,9 @@
 
 export(CSWCapabilities)
 export(CSWClient)
+export(CSWDescribeRecord)
 export(CSWGetRecordById)
+export(CSWGetRecords)
 export(OWSCapabilities)
 export(OWSClient)
 export(OWSOperation)

R/CSWClient.R

@@ -24,8 +24,15 @@
 #'  \item{\code{getCapabilities()}}{
 #'    Get service capabilities. Inherited from OWS Client
 #'  }
+#'  \item{\code{describeRecord(namespace, ...)}}{
+#'    Describe records. Retrieves the XML schema for CSW records. By default, returns the XML schema 
+#'    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, ...)}}{
-#'    Get a record by Id.
+#'    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.
 #'  }
 #' }
 #' 
@@ -44,8 +51,19 @@ CSWClient <- R6Class("CSWClient",
      },
 
      #describeRecord
-     describeRecord = function(){
-       stop("Not yet implemented")
+     describeRecord = function(namespace, ...){
+       self$INFO("Fetching schema...")
+       operations <- self$capabilities$getOperationsMetadata()$getOperations()
+       op <- operations[sapply(operations,function(x){x$getName()=="DescribeRecord"})]
+       if(length(op)>0){
+         op <- op[[1]]
+       }else{
+         errorMsg <- "Operation 'DescribeRecord' not supported by this service"
+         self$ERROR(errorMsg)
+         stop(errorMsg)
+       }
+       request <- CSWDescribeRecord$new(op, self$getUrl(), self$getVersion(), namespace = namespace, logger = self$loggerType, ...)
+       return(request$response)
      },
 
      #getRecordById
@@ -65,8 +83,20 @@ CSWClient <- R6Class("CSWClient",
      },
 
      #getRecords
-     getRecords = function(outputSchema){
-       stop("Not yet implemented")
+     getRecords = function(constraint = NULL, ...){
+       self$INFO("Fetching records ...")
+       operations <- self$capabilities$getOperationsMetadata()$getOperations()
+       op <- operations[sapply(operations,function(x){x$getName()=="GetRecords"})]
+       if(length(op)>0){
+         op <- op[[1]]
+       }else{
+         errorMsg <- "Operation 'GetRecords' not supported by this service"
+         self$ERROR(errorMsg)
+         stop(errorMsg)
+       }
+       request <- CSWGetRecords$new(op, self$getUrl(), self$getVersion(),
+                                    constraint = constraint, logger = self$loggerType, ...)
+       return(request$response)
      }
    )
 )

R/CSWDescribeRecord.R

@@ -0,0 +1,58 @@
+#' CSWDescribeRecord
+#'
+#' @docType class
+#' @export
+#' @keywords OGC CSW DescribeRecord
+#' @return Object of \code{\link{R6Class}} for modelling a CSW DescribeRecord request
+#' @format \code{\link{R6Class}} object.
+#'
+#' @section Methods:
+#' \describe{
+#'  \item{\code{new(url, version, namespace, ...)}}{
+#'    This method is used to instantiate a CSWDescribeRecord object
+#'  }
+#' }
+#' 
+#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
+#'
+CSWDescribeRecord <- R6Class("CSWDescribeRecord",
+   inherit = OWSRequest,
+   private = list(
+     name = "DescribeRecord",
+     defaultNamespace = "csw:http://www.opengis.net/cat/csw/2.0.2"
+   ),
+   public = list(
+     initialize = function(op, url, version, namespace = NULL, logger = NULL, ...) {
+       namedParams <- list(request = private$name, version = version)
+
+       #default output schema
+       if(is.null(namespace)){
+         namespace <- private$defaultNamespace
+       }
+
+       #other default params
+       #note: normally typeName not mandatory in DescribeRecord
+       typeName <- switch(namespace,
+                           "gmd:http://www.isotc211.org/2005/gmd" = "gmd:MD_Metadata",
+                           "gfc:http://www.isotc211.org/2005/gfc" = "gfc:FC_FeatureCatalogue",
+                           "csw:http://www.opengis.net/cat/csw/2.0.2" = "csw:Record",
+                           "dcat:http://www.w3.org/ns/dcat#" = "dcat"
+       )
+       namedParams <- c(namedParams, namespace = namespace, typeName = typeName)
+
+       super$initialize(op, url, namedParams, mimeType = "text/xml", logger = logger, ...)
+
+       #binding to XML schema
+       xsdObjs <- getNodeSet(self$response, "//ns:schema", c(ns = "http://www.w3.org/2001/XMLSchema"))
+       if(length(xsdObjs)>0){
+         xsdObj <- xsdObjs[[1]]
+         tempf = tempfile() 
+         destfile = paste(tempf,".xsd",sep='')
+         saveXML(xsdObj, destfile)
+         self$response <- xmlSchemaParse(destfile)
+       }else{
+         self$response <- NULL
+       }
+     }
+   )
+)

R/CSWGetRecordById.R

@@ -11,9 +11,6 @@
 #'  \item{\code{new(url, version, id)}}{
 #'    This method is used to instantiate a CSWGetRecordById object
 #'  }
-#'  \item{\code{getRequest()}}{
-#'    Get GetRecordById request
-#'  }
 #' }
 #' 
 #' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
@@ -27,11 +24,14 @@ CSWGetRecordById <- R6Class("CSWGetRecordById",
     public = list(
       initialize = function(op, url, version, id, logger = NULL, ...) {
         namedParams <- list(request = private$name, version = version, id = id)
+
+        #default output schema
         outputSchema <- list(...)$outputSchema
         if(is.null(outputSchema)){
           outputSchema <- private$defaultOutputSchema
           namedParams <- c(namedParams, outputSchema = outputSchema)
         }
+
         super$initialize(op, url, namedParams, mimeType = "text/xml", logger = logger, ...)
 
         #check response in case of ISO

R/CSWGetRecords.R

@@ -0,0 +1,86 @@
+#' CSWGetRecords
+#'
+#' @docType class
+#' @export
+#' @keywords OGC CSW GetRecords
+#' @return Object of \code{\link{R6Class}} for modelling a CSW GetRecords request
+#' @format \code{\link{R6Class}} object.
+#'
+#' @section Methods:
+#' \describe{
+#'  \item{\code{new(url, version, constraints, ...)}}{
+#'    This method is used to instantiate a CSWGetRecords object
+#'  }
+#' }
+#' 
+#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
+#'
+CSWGetRecords <- R6Class("CSWGetRecords",
+  inherit = OWSRequest,
+  private = list(
+    name = "GetRecords",
+    defaultOutputSchema = "http://www.opengis.net/cat/csw/2.0.2"
+  ),
+  public = list(
+    initialize = function(op, url, version, constraint = NULL, logger = NULL, ...) {
+      namedParams <- list(request = private$name, version = version)
+      if(!is.null(constraint)) namedParams <- c(namedParams, constraint = constraint)
+
+      #default output schema
+      outputSchema <- list(...)$outputSchema
+      if(is.null(outputSchema)){
+        outputSchema <- private$defaultOutputSchema
+        namedParams <- c(namedParams, outputSchema = outputSchema)
+      }
+
+      #other default params
+      typeNames <- switch(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.w3.org/ns/dcat#" = "dcat"
+      )
+      namedParams <- c(namedParams, typeNames = typeNames)
+      namedParams[["resultType"]] <- "results"
+      namedParams[["CONSTRAINTLANGUAGE"]] <- "CQL_TEXT"
+
+      super$initialize(op, url, namedParams, mimeType = "text/xml", logger = logger, ...)
+
+      #bindings
+      self$response <- switch(outputSchema,
+        "http://www.isotc211.org/2005/gmd" = {
+          out <- NULL
+          xmlObjs <- getNodeSet(self$response, "//ns:MD_Metadata", c(ns = outputSchema))
+          if(length(xmlObjs)>0){
+            out <- lapply(xmlObjs,function(xmlObj){
+              out.obj <- geometa::ISOMetadata$new()
+              out.obj$decode(xml = xmlObj)
+              return(out.obj)
+            })
+          }
+          out
+        },
+        "http://www.isotc211.org/2005/gfc" = {
+          out <- NULL
+          xmlObjs <- getNodeSet(self$response, "//ns:FC_FeatureCatalogue", c(ns = outputSchema))
+          if(length(xmlObjs)>0){
+            out <- lapply(xmlObjs,function(xmlObj){
+              out.obj <- geometa::ISOFeatureCatalogue$new()
+              out.obj$decode(xml = xmlObj)
+              return(out.obj)
+            })
+          }
+          out
+        },
+        "http://www.opengis.net/cat/csw/2.0.2" = {
+          warnings(sprintf("R binding not yet supported for '%s'", outputSchema))
+          self$response
+        },
+        "http://www.w3.org/ns/dcat#" = {
+          warnings(sprintf("R binding not yet supported for '%s'", outputSchema))
+          self$response
+        }
+      )
+    }
+  )
+)

R/OWSOperation.R

@@ -36,7 +36,7 @@ OWSOperation <-  R6Class("OWSOperation",
       private$name <- xmlGetAttr(xmlObj, "name")
       paramXML <- getNodeSet(xmlDoc(xmlObj), "//ns:Parameter", ns)
       private$parameters <- lapply(paramXML, function(x){
-        param <- xpathSApply(xmlDoc(x), "//ns:Value", fun = xmlValue, namespaces = ns)
+        param <- unique(xpathSApply(xmlDoc(x), "//ns:Value", fun = xmlValue, namespaces = ns))
         return(param)
       })
       names(private$parameters) <- sapply(paramXML, xmlGetAttr, "name")

R/OWSOperationsMetadata.R

@@ -35,7 +35,9 @@ OWSOperationsMetadata <-  R6Class("OWSOperationsMetadata",
        if(nrow(namespaces) > 0){
          ns <- OWSUtils$findNamespace(namespaces, namespace)
          if(length(ns)>0){
-           opXML <- getNodeSet(xmlObj, "//ns:OperationsMetadata/ns:Operation", ns)
+           if(namespace %in% names(ns)){
+             opXML <- getNodeSet(xmlObj, "//ns:OperationsMetadata/ns:Operation", ns)
+           }
          }
          if(length(opXML)==0){
            ns <- OWSUtils$findNamespace(namespaces, "ows")

R/OWSRequest.R

@@ -39,7 +39,9 @@ OWSRequest <- R6Class("OWSRequest",
         responseContent <- content(r, encoding = "UTF-8")
       }else{
         if(regexpr("xml",mimeType)>0){
-          responseContent <- xmlParse(content(r, type = "text", encoding = "UTF-8"))
+          text <- content(r, type = "text", encoding = "UTF-8")
+          text <- gsub("<!--.*?-->", "", text)
+          responseContent <- xmlParse(text)
         }else{
           responseContent <- content(r, type = mimeType, encoding = "UTF-8")
         }

R/OWSServiceIdentification.R

@@ -62,8 +62,10 @@ OWSServiceIdentification <-  R6Class("OWSServiceIdentification",
        if(nrow(namespaces) > 0){
           ns <- OWSUtils$findNamespace(namespaces, namespace)
           if(length(ns)>0){
-            serviceXML <- getNodeSet(xmlObj, "//ns:Service", ns)
-            if(length(serviceXML)==0) serviceXML <- getNodeSet(xmlObj, "//ns:ServiceIdentification", ns)
+            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")