#64 generalize config arg to other OGC services

eblondel · Mar 11, 2022 · 1a9842d · 1a9842d
1 parent 62bc736
commit 1a9842d
Show file tree

Hide file tree

Showing 17 changed files with 78 additions and 47 deletions.
diff --git a/R/CSWClient.R b/R/CSWClient.R
@@ -44,17 +44,18 @@ CSWClient <- R6Class("CSWClient",
       #'@param pwd password
       #'@param token token
       #'@param headers headers
+      #'@param config config
       #'@param cas_url Central Authentication Service (CAS) URL
       #'@param logger logger
      initialize = function(url, serviceVersion = NULL, 
-                           user = NULL, pwd = NULL, token = NULL, headers = c(), cas_url = NULL,
+                           user = NULL, pwd = NULL, token = NULL, headers = c(), config = httr::config(), cas_url = NULL,
                            logger = NULL) {
        if(startsWith(serviceVersion, "3.0")) serviceVersion <- "3.0.0"
        super$initialize(url, service = private$serviceName, serviceVersion = serviceVersion, 
-                        user = user, pwd = pwd, token = token, headers = headers, cas_url = cas_url, 
+                        user = user, pwd = pwd, token = token, headers = headers, config = config, cas_url = cas_url, 
                         logger = logger)
        self$capabilities = CSWCapabilities$new(self$url, self$version, 
-                                               user = user, pwd = pwd, token = token, headers = headers,
+                                               user = user, pwd = pwd, token = token, headers = headers, config = config,
                                                logger = logger)
        self$capabilities$setClient(self)
      },
@@ -68,7 +69,8 @@ CSWClient <- R6Class("CSWClient",
      #'@description Reloads CSW capabilities
      reloadCapabilities = function(){
       self$capabilities = CSWCapabilities$new(self$url, self$version, 
-                                              user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), headers = self$getHeaders(),
+                                              user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), 
+                                              headers = self$getHeaders(), config = self$getConfig(),
                                               logger = self$loggerType)
       self$capabilities$setClient(self)
      },
@@ -91,7 +93,8 @@ CSWClient <- R6Class("CSWClient",
          stop(errorMsg)
        }
        request <- CSWDescribeRecord$new(self$capabilities, op, self$getUrl(), self$getVersion(), 
-                                        user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), headers = self$getHeaders(),
+                                        user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), 
+                                        headers = self$getHeaders(), config = self$getConfig(),
                                         namespace = namespace, logger = self$loggerType, ...)
        return(request$getResponse())
      },
@@ -118,7 +121,8 @@ CSWClient <- R6Class("CSWClient",
          stop(errorMsg)
        }
        request <- CSWGetRecordById$new(self$capabilities, op, self$getUrl(), self$getVersion(),
-                                       user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), headers = self$getHeaders(),
+                                       user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), 
+                                       headers = self$getHeaders(), config = self$getConfig(),
                                        id = id, elementSetName = elementSetName,
                                        logger = self$loggerType, ...)
        return(request$getResponse())
@@ -153,7 +157,8 @@ CSWClient <- R6Class("CSWClient",
        if(hasMaxRecords) if(maxRecords < maxRecordsPerRequest) maxRecordsPerRequest <- maxRecords
 
        firstRequest <- CSWGetRecords$new(self$capabilities, op, self$getUrl(), self$getVersion(),
-                                    user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), headers = self$getHeaders(),
+                                    user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), 
+                                    headers = self$getHeaders(), config = self$getConfig(),
                                     query = query, logger = self$loggerType, 
                                     maxRecords = maxRecordsPerRequest, ...)
        records <- firstRequest$getResponse()
@@ -180,7 +185,8 @@ CSWClient <- R6Class("CSWClient",
            }
          }
          nextRequest <- CSWGetRecords$new(self$capabilities, op, self$getUrl(), self$getVersion(),
-                                          user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), headers = self$getHeaders(),
+                                          user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), 
+                                          headers = self$getHeaders(), config = self$getConfig(),
                                           query = query, logger = self$loggerType, 
                                           startPosition = nextRecord, 
                                           maxRecords = maxRecordsPerRequest, ...)
@@ -222,7 +228,8 @@ CSWClient <- R6Class("CSWClient",
        }
        #transation
        transaction <- CSWTransaction$new(self$capabilities, op, cswt_url, self$getVersion(), type = type,
-                                         user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), headers = self$getHeaders(),
+                                         user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), 
+                                         headers = self$getHeaders(), config = self$getConfig(),
                                          record = record, recordProperty = recordProperty, constraint = constraint, 
                                          logger = self$loggerType, ...)
 
@@ -312,7 +319,8 @@ CSWClient <- R6Class("CSWClient",
        }
        self$INFO(sprintf("Harvesting '%s' ...", sourceUrl))
        harvest <- CSWHarvest$new(self$capabilities, op, self$getUrl(), self$getVersion(),
-                                 user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), headers = self$getHeaders(),
+                                 user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), 
+                                 headers = self$getHeaders(), config = self$getConfig(),
                                  source = sourceUrl, resourceType = resourceType, resourceFormat = "application/xml",
                                  logger = self$loggerType)
 
@@ -349,7 +357,8 @@ CSWClient <- R6Class("CSWClient",
                             sourceBaseUrl){
        nodeHarvest <- NULL
        csw <- CSWClient$new(url = url, serviceVersion = self$getVersion(), 
-                            user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), headers = self$getHeaders(),
+                            user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), 
+                            headers = self$getHeaders(), config = self$getConfig(),
                             logger = self$loggerType)
        if(!is.null(csw)){
          records <- csw$getRecords(query = query)

diff --git a/R/CSWDescribeRecord.R b/R/CSWDescribeRecord.R
@@ -29,10 +29,11 @@ CSWDescribeRecord <- R6Class("CSWDescribeRecord",
      #'@param pwd password
      #'@param token token
      #'@param headers headers
+     #'@param config config
      #'@param logger logger
      #'@param ... any parameter to pass to the service request
      initialize = function(capabilities, op, url, version, namespace = NULL, 
-                           user = NULL, pwd = NULL, token = NULL, headers = c(),
+                           user = NULL, pwd = NULL, token = NULL, headers = c(), config = httr::config(),
                            logger = NULL, ...) {
        namedParams <- list(service = "CSW", version = version)
 
@@ -53,7 +54,7 @@ CSWDescribeRecord <- R6Class("CSWDescribeRecord",
 
        super$initialize(element = private$xmlElement, namespacePrefix = private$xmlNamespacePrefix,
                         capabilities, op, "GET", url, request = private$name,
-                        user = user, pwd = pwd, token = token, headers = headers,
+                        user = user, pwd = pwd, token = token, headers = headers, config = config,
                         namedParams = namedParams,
                         mimeType = "text/xml", logger = logger, ...)
        self$execute()

diff --git a/R/CSWGetRecordById.R b/R/CSWGetRecordById.R
@@ -36,12 +36,13 @@ CSWGetRecordById <- R6Class("CSWGetRecordById",
       #'@param pwd password
       #'@param token token
       #'@param headers headers
+      #'@param config config
       #'@param id record id
       #'@param elementSetName element set name. Default is "full"
       #'@param logger logger
       #'@param ... any parameter to pass to the service request
       initialize = function(capabilities, op, url, serviceVersion = "2.0.2",
-                            user = NULL, pwd = NULL, token = NULL, headers = headers,
+                            user = NULL, pwd = NULL, token = NULL, headers = headers, config = httr::config(),
                             id, elementSetName = "full", logger = NULL, ...) {
         self$Id = id
         allowedElementSetNames <- c("full", "brief", "summary")
@@ -56,7 +57,7 @@ CSWGetRecordById <- R6Class("CSWGetRecordById",
 
         super$initialize(element = private$xmlElement, namespacePrefix = private$xmlNamespacePrefix,
                          capabilities, op, "POST", url, request = "GetRecordById",
-                         user = user, pwd = pwd, token = token, headers = headers,
+                         user = user, pwd = pwd, token = token, headers = headers, config = config,
                          contentType = "text/xml", mimeType = "text/xml",
                          logger = logger, ...)
 

diff --git a/R/CSWGetRecords.R b/R/CSWGetRecords.R
@@ -39,18 +39,19 @@ CSWGetRecords <- R6Class("CSWGetRecords",
     #'@param pwd password
     #'@param token token
     #'@param headers headers
+    #'@param config config
     #'@param query object of class \link{CSWQuery}
     #'@param logger logger
     #'@param ... any parameter to pass to the service request, such as \code{resultType}, \code{startPosition},
     #' \code{maxRecords}, \code{outputFormat}, or \code{outputSchema}
     initialize = function(capabilities, op, url, serviceVersion = "2.0.2", 
-                          user = NULL, pwd = NULL, token = NULL, headers = list(),
+                          user = NULL, pwd = NULL, token = NULL, headers = list(), config = httr::config(),
                           query = NULL, logger = NULL, ...) {
       nsVersion <- ifelse(serviceVersion=="3.0.0", "3.0", serviceVersion)
       private$xmlNamespacePrefix = paste(private$xmlNamespacePrefix, gsub("\\.", "_", nsVersion), sep="_")
       super$initialize(element = private$xmlElement, namespacePrefix = private$xmlNamespacePrefix,
                        capabilities, op, "POST", url, request = private$xmlElement,
-                       user = user, pwd = pwd, token = token, headers = headers,
+                       user = user, pwd = pwd, token = token, headers = headers, config = config,
                        contentType = "text/xml", mimeType = "text/xml",
                        logger = logger, ...)
 

diff --git a/R/CSWHarvest.R b/R/CSWHarvest.R
@@ -37,13 +37,14 @@ CSWHarvest <- R6Class("CSWHarvest",
      #'@param pwd password
      #'@param token token
      #'@param headers headers
+     #'@param config config
      #'@param source source
      #'@param resourceType resource type. Default is "http://www.isotc211.org/schemas/2005/gmd/"
      #'@param resourceFormat resource format. Default is "application/xml"
      #'@param logger logger
      #'@param ... any parameter to pass to the service request
      initialize = function(capabilities, op, url, serviceVersion = "2.0.2", 
-                           user = NULL, pwd = NULL, token = NULL, headers = list(),
+                           user = NULL, pwd = NULL, token = NULL, headers = list(), config = httr::config(),
                            source = NULL,
                            resourceType = "http://www.isotc211.org/schemas/2005/gmd/",
                            resourceFormat = "application/xml",
@@ -52,7 +53,7 @@ CSWHarvest <- R6Class("CSWHarvest",
        private$xmlNamespacePrefix = paste(private$xmlNamespacePrefix, gsub("\\.", "_", nsVersion), sep="_")
        super$initialize(element = private$xmlElement, namespacePrefix = private$xmlNamespacePrefix,
                         capabilities, op, "POST", url, request = private$xmlElement,
-                        user = user, pwd = pwd, token = token, headers = headers,
+                        user = user, pwd = pwd, token = token, headers = headers, config = config,
                         contentType = "text/xml", mimeType = "text/xml",
                         logger = logger, ...)
 

diff --git a/R/WCSClient.R b/R/WCSClient.R
@@ -32,15 +32,18 @@ WCSClient <- R6Class("WCSClient",
      #'@param pwd password
      #'@param token token
      #'@param headers headers
+     #'@param config config
      #'@param cas_url Central Authentication Service (CAS) URL
      #'@param logger logger
      initialize = function(url, serviceVersion = NULL, 
-                           user = NULL, pwd = NULL, token = NULL, headers = c(), cas_url = NULL,
+                           user = NULL, pwd = NULL, token = NULL, headers = c(), config = httr::config(), cas_url = NULL,
                            logger = NULL) {
        super$initialize(url, service = private$serviceName, serviceVersion = serviceVersion, 
-                        user = user, pwd = pwd, token = token, headers = headers, cas_url = cas_url, 
+                        user = user, pwd = pwd, token = token, headers = headers, config = config, cas_url = cas_url, 
                         logger = logger)
-       self$capabilities = WCSCapabilities$new(self$url, serviceVersion, logger = logger)
+       self$capabilities = WCSCapabilities$new(self$url, self$version, 
+                                               user = user, pwd = pwd, token = token, headers = headers, config = config,
+                                               logger = logger)
        self$capabilities$setClient(self)
      },
 
@@ -52,7 +55,10 @@ WCSClient <- R6Class("WCSClient",
 
      #'@description Reloads WCS capabilities
      reloadCapabilities = function(){
-       self$capabilities = WCSCapabilities$new(self$url, self$version, logger = self$loggerType)
+       self$capabilities = WCSCapabilities$new(self$url, self$version, 
+                                               user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), 
+                                               headers = self$getHeaders(), config = self$getConfig(),
+                                               logger = self$loggerType)
      },
 
      #'@description Describes coverage

diff --git a/R/WCSDescribeCoverage.R b/R/WCSDescribeCoverage.R
@@ -26,11 +26,12 @@ WCSDescribeCoverage <- R6Class("WCSDescribeCoverage",
      #'@param pwd password
      #'@param token token
      #'@param headers headers
+     #'@param config config
      #'@param logger logger
      #'@param ... any parameter to pass to the service request
      initialize = function(capabilities, op, url, serviceVersion,
                            coverageId, 
-                           user = NULL, pwd = NULL, token = NULL, headers = c(),
+                           user = NULL, pwd = NULL, token = NULL, headers = c(), config = httr::config(),
                            logger = NULL, ...) {
 
        namedParams <- list(service = "WCS", version = serviceVersion)
@@ -40,7 +41,7 @@ WCSDescribeCoverage <- R6Class("WCSDescribeCoverage",
 
        super$initialize(element = private$xmlElement, namespacePrefix = private$xmlNamespacePrefix,
                         capabilities, op, "GET", url, request = "DescribeCoverage",
-                        user = user, pwd = pwd, token = token, headers = headers,
+                        user = user, pwd = pwd, token = token, headers = headers, config = config,
                         namedParams = namedParams, mimeType = "text/xml",
                         logger = logger, ...)
        self$execute()

diff --git a/R/WCSGetCoverage.R b/R/WCSGetCoverage.R
@@ -37,14 +37,15 @@ WCSGetCoverage <- R6Class("WCSGetCoverage",
     #'@param pwd password
     #'@param token token
     #'@param headers headers
+    #'@param config config
     #'@param logger logger
     #'@param ... any parameter to pass to the service request
     initialize = function(capabilities, op, url, serviceVersion,
                           coverage, envelope = NULL, crs = NULL,
                           time = NULL, elevation = NULL, format = NULL, rangesubset = NULL, 
                           gridbaseCRS = NULL, gridtype = NULL, gridCS = NULL, 
                           gridorigin = NULL, gridoffsets = NULL,
-                          user = NULL, pwd = NULL, token = NULL, headers = c(),
+                          user = NULL, pwd = NULL, token = NULL, headers = c(), config = httr::config(),
                           logger = NULL, ...) {
       namedParams <- list(service = "WCS", version = serviceVersion)
 
@@ -162,7 +163,7 @@ WCSGetCoverage <- R6Class("WCSGetCoverage",
 
       super$initialize(element = private$xmlElement, namespacePrefix = private$xmlNamespacePrefix,
                        capabilities, op, "GET", url, request = "GetCoverage",
-                       user = user, pwd = pwd, token = token, headers = headers,
+                       user = user, pwd = pwd, token = token, headers = headers, config = config,
                        namedParams = namedParams, mimeType = mimeType,
                        logger = logger, ...)
       self$execute()

diff --git a/R/WFSClient.R b/R/WFSClient.R
@@ -68,7 +68,7 @@ WFSClient <- R6Class("WFSClient",
 
      #'@description Reloads WFS capabilities
      reloadCapabilities = function(){
-       self$capabilities = WFSCapabilities$new(self$url, self$version, 
+       self$capabilities = WFSCapabilities$new(self$url, self$version,
                                                user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), 
                                                headers = self$getHeaders(), config = self$getConfig(),
                                                logger = self$loggerType)

diff --git a/R/WFSDescribeFeatureType.R b/R/WFSDescribeFeatureType.R
@@ -28,15 +28,16 @@ WFSDescribeFeatureType <- R6Class("WFSDescribeFeatureType",
     #'@param pwd pwd
     #'@param token token
     #'@param headers headers
+    #'@param config config
     #'@param logger logger
     #'@param ... any parameter to pass to the service request
     initialize = function(capabilities, op, url, version, typeName, 
-                          user = NULL, pwd = NULL, token = NULL, headers = c(),
+                          user = NULL, pwd = NULL, token = NULL, headers = c(), config = httr::config(),
                           logger = NULL, ...) {
       namedParams <- list(service = "WFS", version = version, typeName = typeName)
       super$initialize(element = private$xmlElement, namespacePrefix = private$namespacePrefix,
                        capabilities, op, "GET", url, request = "DescribeFeatureType",
-                       user = user, pwd = pwd, token = token, headers = headers,
+                       user = user, pwd = pwd, token = token, headers = headers, config = config,
                        namedParams = namedParams, mimeType = "text/xml", logger = logger,
                        ...)
       self$execute()