fix #121

eblondel · Feb 13, 2024 · d783f80 · d783f80
1 parent 5fadda4
commit d783f80
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 8 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -14,6 +14,10 @@
 - [#117](https://github.com/eblondel/ows4R/issues/117) Support pretty print of R6 objects
 
 
+**Enhancements**
+
+- [#121](https://github.com/eblondel/ows4R/issues/121) Service exceptions are not always handled in status code 400
+
 ## [ows4R 0.3-6](https://github.com/eblondel/ows4R) | [![CRAN_Status_Badge](https://img.shields.io/badge/CRAN-published-blue.svg)](https://github.com/eblondel/ows4R)
 
 **Corrections**

diff --git a/R/OWSHttpRequest.R b/R/OWSHttpRequest.R
@@ -235,19 +235,27 @@ OWSHttpRequest <- R6Class("OWSHttpRequest",
       private$response <- req$response
 
       #exception handling
-      if(private$status != 200){ #usually a status code 400
+      xmlObj = req$response
+      #service exception is usually returned with a status code 400 but not always!
+      if(is.vector(req$response)){
         exception_tmp_file = tempfile(fileext = ".xml")
         writeBin(req$response, exception_tmp_file)
         xmlObj = try(XML::xmlParse(exception_tmp_file), silent = TRUE)
-        if(!is(xmlObj, "try-error")) if(!is.null(xmlNamespaces(xmlObj)$ows)){
-          exception <- getNodeSet(xmlObj, "//ows:Exception", c(ows = xmlNamespaces(xmlObj)$ows$uri))
-          if(length(exception)>0){
-            exception <- OWSException$new(xmlObj = exception[[1]])
+      }
+      if(!is(xmlObj, "try-error")) if(!is.null(xmlNamespaces(xmlObj)$ows)){
+        exception <- getNodeSet(xmlObj, "//ows:Exception", c(ows = xmlNamespaces(xmlObj)$ows$uri))
+        if(length(exception)>0){
+          exception <- OWSException$new(xmlObj = exception[[1]])
+          if(!is.null(exception$getLocator()) & !is.null(exception$getCode())){
             self$ERROR(sprintf("Exception [locator:'%s' code:'%s']: %s", exception$getLocator(), exception$getCode(), exception$getText()))
-            private$exception <- exception
-            private$response <- NULL
-            self$setResult(FALSE)
+          }else{
+            self$ERROR(sprintf("Exception: %s", exception$getText()))
           }
+          private$exception <- exception
+          private$response <- NULL
+          self$setResult(FALSE)
+        }else{
+          self$setResult(TRUE)
         }
       }else{
         self$setResult(TRUE)