Add Error handler from within plumb

R/parse-block.R

@@ -16,6 +16,7 @@ parseBlock <- function(lineNum, file){
   paths <- NULL
   preempt <- NULL
   filter <- NULL
+  errorhandler <- NULL
   image <- NULL
   imageAttr <- NULL
   serializer <- NULL
@@ -58,6 +59,18 @@ parseBlock <- function(lineNum, file){
       filter <- f
     }
 
+    errorMat <- stringi::stri_match(line, regex="^#['\\*]\\s*@errorhandler(\\s+(.*)$)?")
+    if (!is.na(errorMat[1,1])){
+      e <- stri_trim_both(errorMat[1,3])
+
+      if (!is.null(errorhandler)){
+        # Must have already assigned.
+        stopOnLine(lineNum, line, "Multiple @errorhandlers specified.")
+      }
+
+      errorhandler <- e
+    }
+
     preemptMat <- stringi::stri_match(line, regex="^#['\\*]\\s*@preempt(\\s+(.*)\\s*$)?")
     if (!is.na(preemptMat[1,1])){
       p <- stri_trim_both(preemptMat[1,3])
@@ -222,6 +235,7 @@ parseBlock <- function(lineNum, file){
     paths = paths,
     preempt = preempt,
     filter = filter,
+    errorhandler = errorhandler,
     image = image,
     imageAttr = imageAttr,
     serializer = serializer,
@@ -236,7 +250,7 @@ parseBlock <- function(lineNum, file){
 #' Evaluate and activate a "block" of code found in a plumber API file.
 #' @include images.R
 #' @noRd
-evaluateBlock <- function(srcref, file, expr, envir, addEndpoint, addFilter, mount) {
+evaluateBlock <- function(srcref, file, expr, envir, addEndpoint, addFilter, setErrorHandler, mount) {
   lineNum <- srcref[1] - 1
 
   block <- parseBlock(lineNum, file)
@@ -273,6 +287,9 @@ evaluateBlock <- function(srcref, file, expr, envir, addEndpoint, addFilter, mou
     filter <- PlumberFilter$new(block$filter, expr, envir, block$serializer, srcref)
     addFilter(filter)
 
+  } else if (!is.null(block$errorhandler)){
+    setErrorHandler(eval(expr))
+
   } else if (!is.null(block$assets)){
     path <- block$assets$path
 

R/plumber.R

@@ -220,7 +220,7 @@ plumber <- R6Class(
           srcref <- attr(e, "srcref")[[1]][c(1,3)]
 
           evaluateBlock(srcref, private$lines, e, private$envir, private$addEndpointInternal,
-                        private$addFilterInternal, self$mount)
+                        private$addFilterInternal, self$setErrorHandler, self$mount)
         }
 
         private$globalSettings <- parseGlobals(private$lines)

tests/testthat/files/errorhandler.R

@@ -0,0 +1,10 @@
+#* @errorhandler
+function(req, res, err){
+  stop("Caught")
+}
+
+#* @get /fail
+function() {
+  stop("fail")
+  return("foo")
+}

tests/testthat/test-errorhandler.R

@@ -0,0 +1,9 @@
+context("errorHandler")
+
+test_that("errorHandler works", {
+  res <- PlumberResponse$new("")
+
+  r <- plumber$new(test_path("files/errorhandler.R"))
+  expect_error(r$serve(make_req("GET", "/fail"), res),
+               regexp = "Caught")
+})

tests/testthat/test-parse-block.R

@@ -11,12 +11,14 @@ test_that("parseBlock works", {
     "#' @get /",
     "#' @post /",
     "#' @filter test",
-    "#' @serializer json")
+    "#' @serializer json",
+    "#' @errorhandler\nfunction(){x}")
   b <- parseBlock(length(lines), lines)
   expect_length(b$path, 2)
   expect_equal(b$path[[1]], list(verb="POST", path="/"))
   expect_equal(b$path[[2]], list(verb="GET", path="/"))
   expect_equal(b$filter, "test")
+  expect_equal(b$errorhandler, "function(){x}")
   expect_equal_functions(b$serializer, serializer_json())
 })