implement #126

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 = "[email protected]", comment = c(ORCID = "0000-0002-5870-5762")),
              person("Alexandre", "Bennici", role = c("ctb"), comment = c(ORCID = "0000-0003-2160-3487")),

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

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()
      }
    )