#2 WFSClient #3 CSWClient start #4 OWSCapabilities abstract class

.travis.yml

@@ -20,7 +20,7 @@ before_install:
   - docker run -d --name="postgis" kartoza/postgis
   - docker pull oscarfonts/geoserver
   - docker run --link postgis:postgis --name geoserver -d -p 8080:8080 oscarfonts/geoserver
-  - docker run --name geonetwork -d -p 8282:8282 pobsteta/docker-geonetwork:3.0.5
+  - docker run --name geonetwork -d -p 8282:8080 pobsteta/docker-geonetwork:3.0.5
 
 r:
   - oldrel

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ows4R
 Version: 0.1
-Date: 2018-02-14
+Date: 2018-02-16
 Title: interface to OGC Web-Services (OWS)
 Authors@R: c(person("Emmanuel", "Blondel", role = c("aut", "cre"), email = "[email protected]"),
              person("Norbert", "Billet", role = c("ctb")))

NAMESPACE

@@ -2,7 +2,10 @@
 
 export(CSWCapabilities)
 export(CSWClient)
+export(OWSCapabilities)
 export(OWSClient)
+export(OWSOperation)
+export(OWSOperationsMetadata)
 export(OWSRequest)
 export(OWSServiceIdentification)
 export(OWSUtils)

R/CSWCapabilities.R

@@ -0,0 +1,38 @@
+#' CSWCapabilities
+#'
+#' @docType class
+#' @export
+#' @keywords OGC CSW Capabilities
+#' @return Object of \code{\link{R6Class}} with methods for interfacing an OGC
+#' Catalogue Service for the Web (CSW) Get Capabilities document.
+#' @format \code{\link{R6Class}} object.
+#' 
+#' @examples
+#' \dontrun{
+#'    CSWCapabilities$new("http://localhost:8080/geonetwork/csw", version = "2.0.2")
+#' }
+#'
+#' @section Methods:
+#' \describe{
+#'  \item{\code{new(url, version)}}{
+#'    This method is used to instantiate a WFSGetCapabilities object
+#'  }
+#' }
+#' 
+#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
+#'
+CSWCapabilities <- R6Class("CSWCapabilities",
+   inherit = OWSCapabilities,
+   private = list(
+
+   ),
+
+   public = list(
+
+     #initialize
+     initialize = function(url, version) {
+       super$initialize(url, service = "CSW", version)
+       xmlObj <- self$getRequest()$response
+     }
+   )
+)

R/OWSCapabilities.R

@@ -0,0 +1,92 @@
+#' OWSGetCapabilities
+#'
+#' @docType class
+#' @export
+#' @keywords OGC OWS GetCapabilities
+#' @return Object of \code{\link{R6Class}} with methods for interfacing an abstract
+#' OWS Get Capabilities document.
+#' @format \code{\link{R6Class}} object.
+#' 
+#' @examples
+#' \dontrun{
+#'    OWSCapabilities$new("http://localhost:8080/geoserver/wfs", service = "wfs" version = "1.1.0")
+#' }
+#'
+#' @section Methods:
+#' \describe{
+#'  \item{\code{new(url, service, version)}}{
+#'    This method is used to instantiate a OWSGetCapabilities object
+#'  }
+#'  \item{\code{getUrl()}}{
+#'    Get URL
+#'  }
+#'  \item{\code{getVersion()}}{
+#'    Get version
+#'  }
+#'  \item{\code{getRequest()}}{
+#'    Get request
+#'  }
+#'  \item{\code{getServiceIdentification()}}{
+#'    Get the service identification
+#'  }
+#'  \item{\code{getOperationsMetadata()}}{
+#'    Get the service operations metadata
+#'  }
+#' }
+#' 
+#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
+#'
+OWSCapabilities <- R6Class("OWSCapabilities",
+
+   private = list(
+
+     url = NA,
+     version = NA,
+     request = NA,
+     serviceIdentification = NULL,
+     operationsMetadata = NULL,
+
+     #buildRequest
+     buildRequest = function(url, service, version){
+       namedParams <- list(request = "GetCapabilities", service, version = version)
+       request <- OWSRequest$new(url, namedParams, "text/xml")
+       return(request)
+     }
+   ),
+
+   public = list(
+
+     #initialize
+     initialize = function(url, service, version) {
+       private$request <- private$buildRequest(url, service, version)
+       xmlObj <- private$request$response
+       private$serviceIdentification <- OWSServiceIdentification$new(xmlObj, service, version)
+       private$operationsMetadata <- OWSOperationsMetadata$new(xmlObj, service, version)
+     },
+
+     #getUrl
+     getUrl = function(){
+       return(private$url)
+     },
+
+     #getVersion
+     getVersion = function(){
+       return(private$version)
+     },
+
+     #getRequest
+     getRequest = function(){
+      return(private$request) 
+     },
+
+     #getServiceIdentification
+     getServiceIdentification = function(){
+       return(private$serviceIdentification)
+     },
+
+     #getOperationsMetadata
+     getOperationsMetadata = function(){
+       return(private$operationsMetadata)
+     }
+   )
+)

R/OWSOperation.R

@@ -0,0 +1,44 @@
+#' OWSOperation
+#'
+#' @docType class
+#' @export
+#' @keywords OGC OWS operation
+#' @return Object of \code{\link{R6Class}} for modelling an OGC Operation
+#' @format \code{\link{R6Class}} object.
+#'
+#' @section Methods:
+#' \describe{
+#'  \item{\code{new(xmlObj, service, version)}}{
+#'    This method is used to instantiate an OWSOperation object
+#'  }
+#' }
+#' 
+#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
+#'
+OWSOperation <-  R6Class("OWSOperation",
+  private = list(
+    name = NA,
+    parameters = list()
+  ),
+  public = list(
+    initialize = function(xmlObj, service, version){
+      private$name <- xmlGetAttr(xmlObj, "name")
+      paramXML <- getNodeSet(xmlDoc(xmlObj), "//ns:Parameter", ns)
+      private$parameters <- lapply(paramXML, function(x){
+        param <- xpathSApply(x, "//ns:Value", fun = xmlValue, namespaces = ns)
+        return(param)
+      })
+      names(private$parameters) <- sapply(paramXML, xmlGetAttr, "name")
+    },
+
+    #getName
+    getName = function(){
+      return(private$name)
+    },
+
+    #getParameters
+    getParameters = function(){
+      return(private$parameters)
+    }
+  )
+)

R/OWSOperationsMetadata.R

@@ -0,0 +1,68 @@
+#' OWSOperationsMetadata
+#'
+#' @docType class
+#' @export
+#' @keywords OGC OWS operation metadata
+#' @return Object of \code{\link{R6Class}} for modelling an OGC Operations Metadata
+#' @format \code{\link{R6Class}} object.
+#'
+#' @section Methods:
+#' \describe{
+#'  \item{\code{new(xmlObj, service, version)}}{
+#'    This method is used to instantiate a OWSOperationsMetadata object
+#'  }
+#'  \item{\code{getOperations()}}{
+#'    Get operations
+#'  }
+#' }
+#' 
+#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
+#'
+OWSOperationsMetadata <-  R6Class("OWSOperationsMetadata",
+   private = list(
+     operations = list(),
+
+     #fetchOperations
+     fetchOperations = function(xmlObj, service, version){
+       namespaces <- NULL
+       if(all(class(xmlObj) == c("XMLInternalDocument","XMLAbstractDocument"))){
+         namespaces <- OWSUtils$getNamespaces(xmlObj)
+       }
+       namespaces <- as.data.frame(namespaces)
+       namespace <- tolower(service)
+
+       opXML <- NULL
+       if(nrow(namespaces) > 0){
+         ns <- OWSUtils$findNamespace(namespaces, namespace)
+         if(length(ns)>0){
+           opXML <- getNodeSet(xmlObj, "//ns:OperationsMetadata/ns:Operation", ns)
+         }
+         if(length(opXML)==0){
+           ns <- OWSUtils$findNamespace(namespaces, "ows")
+           if(length(ns)>0){
+             opXML <- getNodeSet(xmlObj, "//ns:OperationsMetadata/ns:Operation", ns)
+           }
+         }
+       }else{
+         opXML <- getNodeSet(xmlObj, "//OperationsMetadata/Operation")
+       }
+
+       operations <- list()
+       if(length(opXML)>0){
+          operations <- lapply(opXML, function(x){return(OWSOperation$new(x, service, version))})
+       }
+       return(operations)
+
+     }
+   ),
+   public = list(
+     initialize = function(xmlObj, service, version){
+       private$operations <- private$fetchOperations(xmlObj, service, version)
+     },
+
+     #getOperations
+     getOperations = function(){
+       return(private$operations)
+     }
+   )
+)