#2 refactor OWSClient / ServiceIdentification #3 prepare CSW client

.travis.yml

@@ -24,7 +24,7 @@ before_install:
 r:
   - oldrel
   - release
-  - devel
+  #- devel
 
 r_github_packages:
   - hadley/devtools

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+export(CSWCapabilities)
+export(CSWClient)
 export(OWSClient)
 export(OWSRequest)
 export(OWSServiceIdentification)

R/CSWClient.R

@@ -0,0 +1,59 @@
+#' CSWClient
+#'
+#' @docType class
+#' @export
+#' @keywords OGC CSW catalogue service web
+#' @return Object of \code{\link{R6Class}} with methods for interfacing an OGC
+#' Catalogue Service for the Web.
+#' @format \code{\link{R6Class}} object.
+#' 
+#' @examples
+#' \dontrun{
+#'    CSWClient$new("http://localhost:8080/geonetwork/srv/eng/csw", version = "2.0.2")
+#' }
+#'
+#' @section Methods:
+#' \describe{
+#'  \item{\code{new(url, version, user, pwd, logger)}}{
+#'    This method is used to instantiate a CSWClient with the \code{url} of the
+#'    OGC service. Authentication (\code{user}/\code{pwd}) is not yet supported and will
+#'    be added with the support of service transactional modes. By default, the \code{logger}
+#'    argument will be set to \code{NULL} (no logger). This argument accepts two possible 
+#'    values: \code{INFO}: to print only \pkg{ows4R} logs, \code{DEBUG}: to print more verbose logs
+#'  }
+#'  \item{\code{getCapabilities()}}{
+#'    Get service capabilities. Inherited from OWS Client
+#'  }
+#' }
+#' 
+#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
+#'
+CSWClient <- R6Class("CSWClient",
+   inherit = OWSClient,
+   private = list(
+     serviceName = "CSW"
+   ),
+   public = list(
+     #initialize
+     initialize = function(url, version = NULL, user = NULL, pwd = NULL, logger = NULL) {
+       super$initialize(url, service = private$serviceName, version, user, pwd, logger)
+       self$capabilities = CSWCapabilities$new(self$url, self$version)
+     },
+
+     #describeRecord
+     describeRecord = function(){
+       stop("Not yet implemented")
+     },
+
+     #getRecordById
+     getRecordById = function(id, outputSchema){
+       stop("Not yet implemented")
+     },
+
+     #getRecords
+     getRecords = function(outputSchema){
+       stop("Not yet implemented")
+     }
+   )
+)
+

R/CSWGetCapabilities.R

@@ -0,0 +1,58 @@
+#' CSWGetCapabilities
+#'
+#' @docType class
+#' @export
+#' @keywords OGC CSW GetCapabilities
+#' @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{
+#'    CSWGetCapabilities$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
+#'  }
+#'  \item{\code{getServiceIdentification()}}{
+#'    Get the service identification
+#'  }
+#' }
+#' 
+#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
+#'
+CSWCapabilities <- R6Class("CSWCapabilities",
+
+   private = list(
+
+     url = NA,
+     version = NA,
+     request = NA,
+     serviceIdentification = NA,
+
+     #buildRequest
+     buildRequest = function(url, version){
+       namedParams <- list(request = "GetCapabilities", version = version)
+       request <- OWSRequest$new(url, namedParams, "text/xml")
+       return(request)
+     }
+   ),
+
+   public = list(
+
+     #initialize
+     initialize = function(url, version) {
+       private$request <- private$buildRequest(url, version)
+       xmlObj <- private$request$response
+       private$serviceIdentification <- OWSServiceIdentification$new(xmlObj, version, "CSW")
+     },
+
+     #getServiceIdentification
+     getServiceIdentification = function(){
+       return(private$serviceIdentification)
+     }
+   )
+)

R/OWSClient.R

@@ -25,7 +25,7 @@
 #'
 #' @section Methods:
 #' \describe{
-#'  \item{\code{new(url, version, user, pwd, logger)}}{
+#'  \item{\code{new(url, service, version, user, pwd, logger)}}{
 #'    This method is used to instantiate a OWSClient with the \code{url} of the
 #'    OGC service. Authentication (\code{user}/\code{pwd}) is not yet supported and will
 #'    be added with the support of service transactional modes. By default, the \code{logger}
@@ -91,7 +91,9 @@ OWSClient <- R6Class("OWSClient",
     capabilities = NA,
 
     #initialize
-    initialize = function(url, version, user = NULL, pwd = NULL, logger = NULL) {
+    initialize = function(url, service = NULL, version,
+                          user = NULL, pwd = NULL,
+                          logger = NULL) {
 
       #logger
       if(!missing(logger)){
@@ -114,6 +116,12 @@ OWSClient <- R6Class("OWSClient",
       if (substring(self$url, nchar(self$url)) != "?"){
         self$url <- paste(self$url, "?", sep = "")
       }
+      if(!is.null(service)){
+        if(any(attr(regexpr(tolower(service), self$url),"match.length") == -1,
+               attr(regexpr(service, self$url), "match.length") == -1)){
+          self$url <- paste(self$url, "service=", service, sep = "")
+        }
+      }
       if (!missing(version)) self$version <- version
     },
 

R/OWSServiceIdentification.R

@@ -59,30 +59,21 @@ OWSServiceIdentification <-  R6Class("OWSServiceIdentification",
 
        serviceXML <- NULL
        if(nrow(namespaces) > 0){
-
-         ns <- NULL
-         if(service == "WFS"){
-           if(version == "1.0.0"){
-             ns <- OWSUtils$findNamespace(namespaces, namespace)
-             if(!is.null(ns)) serviceXML <- getNodeSet(xmlObj, "//ns:Service", ns)
-           }else{
-             ns <- OWSUtils$findNamespace(namespaces, "ows")
-             if(!is.null(ns)) serviceXML <- getNodeSet(xmlObj, "//ns:ServiceIdentification", ns)
-           }  
-         }else if(service == "WMS"){
-           ns <- OWSUtils$findNamespace(namespaces, namespace)
-           if(!is.null(ns)) serviceXML <- getNodeSet(xmlObj, "//ns:Service", ns)
-         }
+          ns <- OWSUtils$findNamespace(namespaces, namespace)
+          if(!is.null(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")
+              if(!is.null(ns)){
+                serviceXML <- getNodeSet(xmlObj, "//ns:Service", ns)
+                if(length(serviceXML)==0) serviceXML <- getNodeSet(xmlObj, "//ns:ServiceIdentification", ns)
+              }
+            }
+          }
        }else{
-         if(service == "WFS"){
-           if(version == "1.0.0"){
-             serviceXML <- getNodeSet(xmlObj, "//Service")
-           }else{
-             serviceXML <- getNodeSet(xmlObj, "//ServiceIdentification")
-           }
-         }else if(service == "WMS"){
-           serviceXML <- getNodeSet(xmlObj, "//Service")
-         }
+         serviceXML <- getNodeSet(xmlObj, "//Service")
+         if(length(serviceXML)==0) serviceXML <- getNodeSet(xmlObj, "//ServiceIdentification")
        }
 
        serviceName <- NULL
@@ -127,6 +118,9 @@ OWSServiceIdentification <-  R6Class("OWSServiceIdentification",
            serviceTypeVersion <- xmlValue(children$ServiceTypeVersion)
          }
 
+         #TODO fees
+         #TODO accessConstraints
+
        }
 
        serviceIdentification <- list(

R/WFSClient.R

@@ -21,6 +21,9 @@
 #'    argument will be set to \code{NULL} (no logger). This argument accepts two possible 
 #'    values: \code{INFO}: to print only \pkg{ows4R} logs, \code{DEBUG}: to print more verbose logs
 #'  }
+#'  \item{\code{getCapabilities()}}{
+#'    Get service capabilities. Inherited from OWS Client
+#'  }
 #'  \item{\code{describeFeatureType(typeName)}}{
 #'    Get the description of a given featureType
 #'  }
@@ -33,17 +36,21 @@
 #'
 WFSClient <- R6Class("WFSClient",
    inherit = OWSClient,
+   private = list(
+     serviceName = "WFS"
+   ),
    public = list(
      #initialize
      initialize = function(url, version = NULL, user = NULL, pwd = NULL, logger = NULL) {
-       super$initialize(url, version, user, pwd, logger)
-       if(any(attr(regexpr("wfs", self$url),"match.length") == -1,
-              attr(regexpr("WFS", self$url), "match.length") == -1)){
-         self$url <- paste(self$url, "service=WFS", sep = "")
-       }
+       super$initialize(url, service = private$serviceName, version, user, pwd, logger)
        self$capabilities = WFSCapabilities$new(self$url, self$version)
      },
 
+     #getCapabilities
+     getCapabilities = function(){
+       return(self$capabilities)
+     },
+
      #describeFeatureType
      describeFeatureType = function(typeName){
        describeFeatureType <- NULL

tests/testthat/test_CSWClient.R

@@ -0,0 +1,15 @@
+# test_WFS.R
+# Author: Emmanuel Blondel <[email protected]>
+#
+# Description: Integration tests for WFS Client
+#=======================
+require(ows4R, quietly = TRUE)
+require(testthat)
+context("WFS")
+
+test_that("CSW 2.0.2",{
+  csw <- CSWClient$new("http://localhost:8080/geonetwork/srv/eng/csw", "2.0.2")
+  expect_is(csw, "CSWClient")
+  caps <- csw$getCapabilities()
+  expect_is(caps, "CSWCapabilities")
+})