From 30fab8f0fdc54290b4b28f573af4ecb455f2fcac Mon Sep 17 00:00:00 2001 From: eblondel Date: Thu, 21 Mar 2024 18:16:18 +0100 Subject: [PATCH] implement #126 --- DESCRIPTION | 2 +- R/OWSHttpRequest.R | 17 ++++++++++------- R/WFSGetFeature.R | 2 +- man/OWSHttpRequest.Rd | 3 +++ 4 files changed, 15 insertions(+), 9 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index bdbffc2..a71dba3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ows4R Version: 0.4 -Date: 2024-02-23 +Date: 2024-03-21 Title: Interface to OGC Web-Services (OWS) Authors@R: c(person("Emmanuel", "Blondel", role = c("aut", "cre"), email = "emmanuel.blondel1@gmail.com", comment = c(ORCID = "0000-0002-5870-5762")), person("Alexandre", "Bennici", role = c("ctb"), comment = c(ORCID = "0000-0003-2160-3487")), diff --git a/R/OWSHttpRequest.R b/R/OWSHttpRequest.R index 3cf2da3..627614e 100644 --- a/R/OWSHttpRequest.R +++ b/R/OWSHttpRequest.R @@ -24,6 +24,7 @@ OWSHttpRequest <- R6Class("OWSHttpRequest", namedParams = list(), contentType = "text/xml", mimeType = "text/xml", + skipXmlComments = TRUE, status = NULL, response = NULL, exception = NULL, @@ -38,7 +39,7 @@ OWSHttpRequest <- R6Class("OWSHttpRequest", #GET #--------------------------------------------------------------- - GET = function(url, request, namedParams, mimeType){ + GET = function(url, request, namedParams, mimeType, skipXmlComments = TRUE){ namedParams <- c(namedParams, request = request) params <- paste(names(namedParams), namedParams, sep = "=", collapse = "&") req <- url @@ -75,7 +76,7 @@ OWSHttpRequest <- R6Class("OWSHttpRequest", }else{ if(regexpr("xml",mimeType)>0){ text <- content(r, type = "text", encoding = "UTF-8") - text <- gsub("", "", text) + if(skipXmlComments) text <- gsub("", "", text) responseContent <- xmlParse(text) }else if(regexpr("json", mimeType)>0){ responseContent <- content(r, type = "text", encoding = "UTF-8") @@ -90,7 +91,7 @@ OWSHttpRequest <- R6Class("OWSHttpRequest", #POST #--------------------------------------------------------------- - POST = function(url, contentType = "text/xml", mimeType = "text/xml"){ + POST = function(url, contentType = "text/xml", mimeType = "text/xml", skipXmlComments = TRUE){ #vendor params geometa_validate <- if(!is.null(private$namedParams$geometa_validate)) as.logical(private$namedParams$geometa_validate) else TRUE @@ -131,7 +132,7 @@ OWSHttpRequest <- R6Class("OWSHttpRequest", }else{ if(regexpr("xml",mimeType)>0){ text <- content(r, type = "text", encoding = "UTF-8") - text <- gsub("", "", text) + if(skipXmlComments) text <- gsub("", "", text) responseContent <- xmlParse(text) }else if(regexpr("json", mimeType)>0){ responseContent <- content(r, type = "text", encoding = "UTF-8") @@ -164,13 +165,14 @@ OWSHttpRequest <- R6Class("OWSHttpRequest", #'@param attrs attributes #'@param contentType content type. Default value is "text/xml" #'@param mimeType mime type. Default value is "text/xml" + #'@param skipXmlComments Skip XML comments from response #'@param logger logger #'@param ... any other parameter initialize = function(element, namespacePrefix, capabilities, op, type, url, request, user = NULL, pwd = NULL, token = NULL, headers = c(), config = httr::config(), namedParams = NULL, attrs = NULL, - contentType = "text/xml", mimeType = "text/xml", + contentType = "text/xml", mimeType = "text/xml", skipXmlComments = TRUE, logger = NULL, ...) { super$initialize(element = element, namespacePrefix = namespacePrefix, logger = logger) private$capabilities = capabilities @@ -180,6 +182,7 @@ OWSHttpRequest <- R6Class("OWSHttpRequest", private$namedParams = namedParams private$contentType = contentType private$mimeType = mimeType + private$skipXmlComments = skipXmlComments #authentication schemes if(!is.null(user) && !is.null(pwd)){ @@ -225,8 +228,8 @@ OWSHttpRequest <- R6Class("OWSHttpRequest", execute = function(){ req <- switch(private$type, - "GET" = private$GET(private$url, private$request, private$namedParams, private$mimeType), - "POST" = private$POST(private$url, private$contentType, private$mimeType) + "GET" = private$GET(private$url, private$request, private$namedParams, private$mimeType, private$skipXmlComments), + "POST" = private$POST(private$url, private$contentType, private$mimeType, private$skipXmlComments) ) private$request <- req$request diff --git a/R/WFSGetFeature.R b/R/WFSGetFeature.R index 304eda9..b763531 100644 --- a/R/WFSGetFeature.R +++ b/R/WFSGetFeature.R @@ -75,7 +75,7 @@ WFSGetFeature <- R6Class("WFSGetFeature", super$initialize(element = private$xmlElement, namespacePrefix = private$namespacePrefix, capabilities, op, "GET", url, request = "GetFeature", user = user, pwd = pwd, token = token, headers = headers, config = config, - namedParams = namedParams, mimeType = mimeType, logger = logger) + namedParams = namedParams, mimeType = mimeType, skipXmlComments = FALSE, logger = logger) self$execute() } ) diff --git a/man/OWSHttpRequest.Rd b/man/OWSHttpRequest.Rd index 865b28d..d1eaf19 100644 --- a/man/OWSHttpRequest.Rd +++ b/man/OWSHttpRequest.Rd @@ -84,6 +84,7 @@ Initializes an OWS HTTP request attrs = NULL, contentType = "text/xml", mimeType = "text/xml", + skipXmlComments = TRUE, logger = NULL, ... )}\if{html}{\out{}} @@ -124,6 +125,8 @@ Initializes an OWS HTTP request \item{\code{mimeType}}{mime type. Default value is "text/xml"} +\item{\code{skipXmlComments}}{Skip XML comments from response} + \item{\code{logger}}{logger} \item{\code{...}}{any other parameter}