plumb-block.R at b64ec7c ⋅ rstudio/plumber


# TODO: delete once we require R 3.3.0
trimws <- function(string){
  string <- gsub("^\\s+", "", string)
  gsub("\\s+$", "", string)
}

stopOnLine <- function(lineNum, line, msg){
  stop("Error on line #", lineNum, ": '", line, "' - ", msg)
}

#' @param lineNum The line number just above the function we're documenting
#' @param file A character vector representing all the lines in the file
#' @param envir An environment where to evaluate parsed expressions
#' @noRd
plumbBlock <- function(lineNum, file, envir = parent.frame()){
  paths <- NULL
  preempt <- NULL
  filter <- NULL
  serializer <- NULL
  parsers <- NULL
  assets <- NULL
  params <- NULL
  comments <- ""
  responses <- NULL
  tags <- NULL
  routerModifier <- NULL
  while (lineNum > 0 && (stri_detect_regex(file[lineNum], pattern="^#['\\*]") || stri_trim_both(file[lineNum]) == "")){

    line <- file[lineNum]

    epMat <- stri_match(line, regex="^#['\\*]\\s*@(get|put|post|use|delete|head|options|patch)(\\s+(.*)$)?")
    if (!is.na(epMat[1,2])){
      p <- stri_trim_both(epMat[1,4])

      if (is.na(p) || p == ""){
        stopOnLine(lineNum, line, "No path specified.")
      }

      if (is.null(paths)){
        paths <- list()
      }

      paths[[length(paths)+1]] <- list(verb = enumerateVerbs(epMat[1,2]), path = p)
    }

    filterMat <- stri_match(line, regex="^#['\\*]\\s*@filter(\\s+(.*)$)?")
    if (!is.na(filterMat[1,1])){
      f <- stri_trim_both(filterMat[1,3])

      if (is.na(f) || f == ""){
        stopOnLine(lineNum, line, "No @filter name specified.")
      }

      if (!is.null(filter)){
        # Must have already assigned.
        stopOnLine(lineNum, line, "Multiple @filters specified for one function.")
      }

      filter <- f
    }

    preemptMat <- stri_match(line, regex="^#['\\*]\\s*@preempt(\\s+(.*)\\s*$)?")
    if (!is.na(preemptMat[1,1])){
      p <- stri_trim_both(preemptMat[1,3])
      if (is.na(p) || p == ""){
        stopOnLine(lineNum, line, "No @preempt specified")
      }
      if (!is.null(preempt)){
        # Must have already assigned.
        stopOnLine(lineNum, line, "Multiple @preempts specified for one function.")
      }
      preempt <- p
    }

    assetsMat <- stri_match(line, regex="^#['\\*]\\s*@assets(\\s+(\\S*)(\\s+(\\S+))?\\s*)?$")
    if (!is.na(assetsMat[1,1])){
      dir <- stri_trim_both(assetsMat[1,3])
      if (is.na(dir) || dir == ""){
        stopOnLine(lineNum, line, "No directory specified for @assets")
      }
      prefixPath <- stri_trim_both(assetsMat[1,5])
      if (is.na(prefixPath) || prefixPath == ""){
        prefixPath <- "/public"
      }
      if (!is.null(assets)){
        # Must have already assigned.
        stopOnLine(lineNum, line, "Multiple @assets specified for one entity.")
      }
      assets <- list(dir=dir, path=prefixPath)
    }

    serMat <- stri_match(line, regex="^#['\\*]\\s*@serializer(\\s+([^\\s]+)\\s*(.*)\\s*$)?")
    if (!is.na(serMat[1,1])){
      s <- stri_trim_both(serMat[1,3])
      if (is.na(s) || s == ""){
        stopOnLine(lineNum, line, "No @serializer specified")
      }
      if (!is.null(serializer)){
        # Must have already assigned.
        stopOnLine(lineNum, line, "Multiple @serializers specified for one function.")
      }

      if (!(s %in% registered_serializers())){
        stopOnLine(lineNum, line, paste0("No such @serializer registered: ", s))
      }

      ser <- get_registered_serializer(s)

      if (!is.na(serMat[1, 4]) && serMat[1,4] != ""){
        # We have an arg to pass in to the serializer
        argList <- tryCatch({
          eval(parse(text=serMat[1,4]), envir)
        }, error = function(e) {
          stopOnLine(lineNum, line, e)
        })
      } else {
        argList <- list()
      }
      tryCatch({
        serializer <- do.call(ser, argList)
      }, error = function(e) {
        stopOnLine(lineNum, line, paste0("Error creating serializer: ", s, "\n", e))
      })

    }

    shortSerMat <- stri_match(line, regex="^#['\\*]\\s*@(json|html|jpeg|png|svg)(.*)$")
    if (!is.na(shortSerMat[1,2])) {
      s <- stri_trim_both(shortSerMat[1,2])
      .Deprecated(msg = paste0(
        "Plumber tag `#* @", s, "` is deprecated.\n",
        "Use `#* @serializer ", s, "` instead."
      ))
      if (!is.null(serializer)){
        # Must have already assigned.
        stopOnLine(lineNum, line, "Multiple @serializers specified for one function (shorthand serializers like @json count, too).")
      }

      if (!is.na(s) && !(s %in% registered_serializers())){
        stopOnLine(lineNum, line, paste0("No such @serializer registered: ", s))
      }
      shortSerAttr <- trimws(shortSerMat[1,3])
      if(!identical(shortSerAttr, "") && !grepl("^\\(.*\\)$", shortSerAttr)){
        stopOnLine(lineNum, line, paste0("Supplemental arguments to the serializer must be surrounded by parentheses, as in `#' @", s, "(na='null')`"))
      }

      if (shortSerAttr != "") {
        # We have an arg to pass in to the serializer
        argList <- tryCatch({
          eval(parse(text=paste0("list", shortSerAttr)), envir)
        }, error = function(e) {
          stopOnLine(lineNum, line, e)
        })
      } else {
        argList <- list()
      }
      tryCatch({
        serializer <- do.call(get_registered_serializer(s), argList)
      }, error = function(e) {
        stopOnLine(lineNum, line, paste0("Error creating serializer: ", s, "\n", e))
      })
    }

    parsersMat <- stri_match(line, regex="^#['\\*]\\s*@parser(\\s+([^\\s]+)\\s*(.*)\\s*$)?")
    if (!is.na(parsersMat[1,1])){
      parser_alias <- stri_trim_both(parsersMat[1,3])
      if (is.na(parser_alias) || parser_alias == ""){
        stopOnLine(lineNum, line, "No @parser specified")
      }

      if (!parser_alias %in% registered_parsers()){
        stopOnLine(lineNum, line, paste0("No such @parser registered: ", parser_alias))
      }

      if (!is.na(parsersMat[1, 4]) && parsersMat[1,4] != ""){
        # We have an arg to pass in to the parser
        arg_list <- tryCatch({
          eval(parse(text=parsersMat[1,4]), envir)
        }, error = function(e) {
          stopOnLine(lineNum, line, e)
        })
      } else {
        arg_list <- list()
      }
      if (is.null(parsers)) {
        parsers <- list()
      }
      parsers[[parser_alias]] <- arg_list
    }

    responseMat <- stri_match(line, regex="^#['\\*]\\s*@response\\s+(\\w+)\\s+(\\S.+)\\s*$")
    if (!is.na(responseMat[1,1])){
      resp <- list()
      resp[[responseMat[1,2]]] <- list(description=responseMat[1,3])
      responses <- c(responses, resp)
    }

    paramMat <- stri_match(line, regex="^#['\\*]\\s*@param(\\s+([^\\s:]+):?([^\\s*]+)?(\\*)?(?:\\s+(.*))?\\s*$)?")
    if (!is.na(paramMat[1,2])){
      name <- paramMat[1,3]
      if (is.na(name)){
        stopOnLine(lineNum, line, "No parameter specified.")
      }
      plumberType <- stri_replace_all(paramMat[1,4], "$1", regex = "^\\[([^\\]]*)\\]$")
      apiType <- plumberToApiType(plumberType)
      isArray <- stri_detect_regex(paramMat[1,4], "^\\[[^\\]]*\\]$")
      isArray[is.na(isArray)] <- defaultIsArray
      required <- identical(paramMat[1,5], "*")

      params[[name]] <- list(desc=paramMat[1,6], type=apiType, required=required, isArray=isArray)
    }

    tagMat <- stri_match(line, regex="^#['\\*]\\s*@tag\\s+(\\S.+)\\s*")
    if (!is.na(tagMat[1,1])){
      t <- stri_trim_both(tagMat[1,2])
      if (is.na(t) || t == ""){
        stopOnLine(lineNum, line, "No tag specified.")
      }
      if (t %in% tags){
        stopOnLine(lineNum, line, "Duplicate tag specified.")
      }
      tags <- c(tags, t)
    }

    commentMat <- stri_match(line, regex="^#['\\*]\\s*([^@\\s].*$)")
    if (!is.na(commentMat[1,2])){
      comments <- paste(comments, commentMat[1,2])
    }

    routerModifierMat <- stri_match(line, regex="^#['\\*]\\s*@plumber")
    if (!is.na(routerModifierMat[1,1])) {
      routerModifier <- TRUE
    }

    lineNum <- lineNum - 1
  }

  list(
    paths = paths,
    preempt = preempt,
    filter = filter,
    serializer = serializer,
    parsers = parsers,
    assets = assets,
    params = rev(params),
    comments = comments,
    responses = responses,
    tags = tags,
    routerModifier = routerModifier
  )
}

#' Evaluate and activate a "block" of code found in a plumber API file.
#' @noRd
evaluateBlock <- function(srcref, file, expr, envir, addEndpoint, addFilter, pr) {
  lineNum <- srcref[1] - 1

  block <- plumbBlock(lineNum, file, envir)

  if (sum(!is.null(block$filter), !is.null(block$paths), !is.null(block$assets), !is.null(block$routerModifier)) > 1){
    stopOnLine(lineNum, file[lineNum], "A single function can only be a filter, an API endpoint, an asset or a Plumber object modifier (@filter AND @get, @post, @assets, @plumber, etc.)")
  }

  # ALL if statements possibilities must eventually call eval(expr, envir)
  if (!is.null(block$paths)){
    lapply(block$paths, function(p) {
      ep <- PlumberEndpoint$new(
        verbs = p$verb,
        path = p$path,
        expr = expr,
        envir = envir,
        serializer = block$serializer,
        parsers = block$parsers,
        lines = srcref,
        params = block$params,
        comments = block$comments,
        responses = block$responses,
        tags = block$tags
      )

      addEndpoint(ep, block$preempt)
    })
  } else if (!is.null(block$filter)){
    filter <- PlumberFilter$new(block$filter, expr, envir, block$serializer, srcref)
    addFilter(filter)

  } else if (!is.null(block$assets)){
    path <- block$assets$path

    # Leading slash
    if (substr(path, 1,1) != "/"){
      path <- paste0("/", path)
    }

    stat <- PlumberStatic$new(block$assets$dir, expr)
    pr$mount(path, stat)

  } else if (!is.null(block$routerModifier)) {
    if (is.expression(expr)){
      func <- tryCatch({
        eval(expr, envir)
      }, error = function(e) {
        stopOnLine(lineNum, file[lineNum], e)
      })
      if (is.function(func)) {
        assign(".__plump_block_check__", TRUE, envir = envir)
        on.exit(rm(".__plump_block_check__", envir = envir), add = TRUE)
        fpr <- func(pr)
        if (inherits(fpr, "Plumber") && !isTRUE(fpr$environment[[".__plump_block_check__"]])) {
          stopOnLine(lineNum, file[lineNum], "Plumber object returned is not the same as the one in argument.")
        }
        return()
      }
    }
    stopOnLine(lineNum, file[lineNum], "Invalid expression for @plumber tag, please use the form `function(pr) { }`.")
  } else {
    tryCatch({
      eval(expr, envir)
    }, error = function(e) {
      stopOnLine(lineNum, file[lineNum], e)
    })
  }
}

Read our documentation on viewing source code .

Navigation	Overlay
`t` Navigate files	`h` Toggle hits
`y` Change url to tip of branch	`m` Toggle misses
`b / v` Jump to prev/next hit line	`p` Toggle partial
`z / x` Jump to prev/next missed or partial line	`1..9` Toggle flags
`shift + o` Open current page in GitHub	`a` Toggle all on
`/ or ?` Show keyboard shortcuts dialog	`c` Toggle context lines or commits

1
2		# TODO: delete once we require R 3.3.0
3		trimws <- function(string){
4	1	string <- gsub("^\\s+", "", string)
5	1	gsub("\\s+$", "", string)
6		}
7
8		stopOnLine <- function(lineNum, line, msg){
9	1	stop("Error on line #", lineNum, ": '", line, "' - ", msg)
10		}
11
12		#' @param lineNum The line number just above the function we're documenting
13		#' @param file A character vector representing all the lines in the file
14		#' @param envir An environment where to evaluate parsed expressions
15		#' @noRd
16		plumbBlock <- function(lineNum, file, envir = parent.frame()){
17	1	paths <- NULL
18	1	preempt <- NULL
19	1	filter <- NULL
20	1	serializer <- NULL
21	1	parsers <- NULL
22	1	assets <- NULL
23	1	params <- NULL
24	1	comments <- ""
25	1	responses <- NULL
26	1	tags <- NULL
27	1	routerModifier <- NULL
28	1	while (lineNum > 0 && (stri_detect_regex(file[lineNum], pattern="^#['\\*]") \|\| stri_trim_both(file[lineNum]) == "")){
29
30	1	line <- file[lineNum]
31
32	1	epMat <- stri_match(line, regex="^#['\\]\\s@(get\|put\|post\|use\|delete\|head\|options\|patch)(\\s+(.*)$)?")
33	1	if (!is.na(epMat[1,2])){
34	1	p <- stri_trim_both(epMat[1,4])
35
36	1	if (is.na(p) \|\| p == ""){
37	1	stopOnLine(lineNum, line, "No path specified.")
38		}
39
40	1	if (is.null(paths)){
41	1	paths <- list()
42		}
43
44	1	paths[[length(paths)+1]] <- list(verb = enumerateVerbs(epMat[1,2]), path = p)
45		}
46
47	1	filterMat <- stri_match(line, regex="^#['\\]\\s@filter(\\s+(.*)$)?")
48	1	if (!is.na(filterMat[1,1])){
49	1	f <- stri_trim_both(filterMat[1,3])
50
51	1	if (is.na(f) \|\| f == ""){
52	1	stopOnLine(lineNum, line, "No @filter name specified.")
53		}
54
55	1	if (!is.null(filter)){
56		# Must have already assigned.
57	1	stopOnLine(lineNum, line, "Multiple @filters specified for one function.")
58		}
59
60	1	filter <- f
61		}
62
63	1	preemptMat <- stri_match(line, regex="^#['\\]\\s@preempt(\\s+(.)\\s$)?")
64	1	if (!is.na(preemptMat[1,1])){
65	1	p <- stri_trim_both(preemptMat[1,3])
66	1	if (is.na(p) \|\| p == ""){
67	1	stopOnLine(lineNum, line, "No @preempt specified")
68		}
69	1	if (!is.null(preempt)){
70		# Must have already assigned.
71	1	stopOnLine(lineNum, line, "Multiple @preempts specified for one function.")
72		}
73	1	preempt <- p
74		}
75
76	1	assetsMat <- stri_match(line, regex="^#['\\]\\s@assets(\\s+(\\S)(\\s+(\\S+))?\\s)?$")
77	1	if (!is.na(assetsMat[1,1])){
78	1	dir <- stri_trim_both(assetsMat[1,3])
79	1	if (is.na(dir) \|\| dir == ""){
80	1	stopOnLine(lineNum, line, "No directory specified for @assets")
81		}
82	1	prefixPath <- stri_trim_both(assetsMat[1,5])
83	1	if (is.na(prefixPath) \|\| prefixPath == ""){
84	1	prefixPath <- "/public"
85		}
86	1	if (!is.null(assets)){
87		# Must have already assigned.
88	0	stopOnLine(lineNum, line, "Multiple @assets specified for one entity.")
89		}
90	1	assets <- list(dir=dir, path=prefixPath)
91		}
92
93	1	serMat <- stri_match(line, regex="^#['\\]\\s@serializer(\\s+([^\\s]+)\\s(.)\\s*$)?")
94	1	if (!is.na(serMat[1,1])){
95	1	s <- stri_trim_both(serMat[1,3])
96	1	if (is.na(s) \|\| s == ""){
97	1	stopOnLine(lineNum, line, "No @serializer specified")
98		}
99	1	if (!is.null(serializer)){
100		# Must have already assigned.
101	1	stopOnLine(lineNum, line, "Multiple @serializers specified for one function.")
102		}
103
104	1	if (!(s %in% registered_serializers())){
105	1	stopOnLine(lineNum, line, paste0("No such @serializer registered: ", s))
106		}
107
108	1	ser <- get_registered_serializer(s)
109
110	1	if (!is.na(serMat[1, 4]) && serMat[1,4] != ""){
111		# We have an arg to pass in to the serializer
112	1	argList <- tryCatch({
113	1	eval(parse(text=serMat[1,4]), envir)
114	1	}, error = function(e) {
115	0	stopOnLine(lineNum, line, e)
116		})
117		} else {
118	1	argList <- list()
119		}
120	1	tryCatch({
121	1	serializer <- do.call(ser, argList)
122	1	}, error = function(e) {
123	0	stopOnLine(lineNum, line, paste0("Error creating serializer: ", s, "\n", e))
124		})
125
126		}
127
128	1	shortSerMat <- stri_match(line, regex="^#['\\]\\s@(json\|html\|jpeg\|png\|svg)(.*)$")
129	1	if (!is.na(shortSerMat[1,2])) {
130	1	s <- stri_trim_both(shortSerMat[1,2])
131	1	.Deprecated(msg = paste0(
132	1	"Plumber tag `#* @", s, "` is deprecated.\n",
133	1	"Use `#* @serializer ", s, "` instead."
134		))
135	1	if (!is.null(serializer)){
136		# Must have already assigned.
137	0	stopOnLine(lineNum, line, "Multiple @serializers specified for one function (shorthand serializers like @json count, too).")
138		}
139
140	1	if (!is.na(s) && !(s %in% registered_serializers())){
141	0	stopOnLine(lineNum, line, paste0("No such @serializer registered: ", s))
142		}
143	1	shortSerAttr <- trimws(shortSerMat[1,3])
144	1	if(!identical(shortSerAttr, "") && !grepl("^\\(.*\\)$", shortSerAttr)){
145	1	stopOnLine(lineNum, line, paste0("Supplemental arguments to the serializer must be surrounded by parentheses, as in `#' @", s, "(na='null')`"))
146		}
147
148	1	if (shortSerAttr != "") {
149		# We have an arg to pass in to the serializer
150	1	argList <- tryCatch({
151	1	eval(parse(text=paste0("list", shortSerAttr)), envir)
152	1	}, error = function(e) {
153	0	stopOnLine(lineNum, line, e)
154		})
155		} else {
156	1	argList <- list()
157		}
158	1	tryCatch({
159	1	serializer <- do.call(get_registered_serializer(s), argList)
160	1	}, error = function(e) {
161	0	stopOnLine(lineNum, line, paste0("Error creating serializer: ", s, "\n", e))
162		})
163		}
164
165	1	parsersMat <- stri_match(line, regex="^#['\\]\\s@parser(\\s+([^\\s]+)\\s(.)\\s*$)?")
166	1	if (!is.na(parsersMat[1,1])){
167	1	parser_alias <- stri_trim_both(parsersMat[1,3])
168	1	if (is.na(parser_alias) \|\| parser_alias == ""){
169	0	stopOnLine(lineNum, line, "No @parser specified")
170		}
171
172	1	if (!parser_alias %in% registered_parsers()){
173	0	stopOnLine(lineNum, line, paste0("No such @parser registered: ", parser_alias))
174		}
175
176	1	if (!is.na(parsersMat[1, 4]) && parsersMat[1,4] != ""){
177		# We have an arg to pass in to the parser
178	0	arg_list <- tryCatch({
179	0	eval(parse(text=parsersMat[1,4]), envir)
180	0	}, error = function(e) {
181	0	stopOnLine(lineNum, line, e)
182		})
183		} else {
184	1	arg_list <- list()
185		}
186	1	if (is.null(parsers)) {
187	1	parsers <- list()
188		}
189	1	parsers[[parser_alias]] <- arg_list
190		}
191
192	1	responseMat <- stri_match(line, regex="^#['\\]\\s@response\\s+(\\w+)\\s+(\\S.+)\\s*$")
193	1	if (!is.na(responseMat[1,1])){
194	1	resp <- list()
195	1	resp[[responseMat[1,2]]] <- list(description=responseMat[1,3])
196	1	responses <- c(responses, resp)
197		}
198
199	1	paramMat <- stri_match(line, regex="^#['\\]\\s@param(\\s+([^\\s:]+):?([^\\s]+)?(\\)?(?:\\s+(.))?\\s$)?")
200	1	if (!is.na(paramMat[1,2])){
201	1	name <- paramMat[1,3]
202	1	if (is.na(name)){
203	0	stopOnLine(lineNum, line, "No parameter specified.")
204		}
205	1	plumberType <- stri_replace_all(paramMat[1,4], "$1", regex = "^\\[([^\\]]*)\\]$")
206	1	apiType <- plumberToApiType(plumberType)
207	1	isArray <- stri_detect_regex(paramMat[1,4], "^\\[[^\\]]*\\]$")
208	1	isArray[is.na(isArray)] <- defaultIsArray
209	1	required <- identical(paramMat[1,5], "*")
210
211	1	params[[name]] <- list(desc=paramMat[1,6], type=apiType, required=required, isArray=isArray)
212		}
213
214	1	tagMat <- stri_match(line, regex="^#['\\]\\s@tag\\s+(\\S.+)\\s*")
215	1	if (!is.na(tagMat[1,1])){
216	1	t <- stri_trim_both(tagMat[1,2])
217	1	if (is.na(t) \|\| t == ""){
218	0	stopOnLine(lineNum, line, "No tag specified.")
219		}
220	1	if (t %in% tags){
221	1	stopOnLine(lineNum, line, "Duplicate tag specified.")
222		}
223	1	tags <- c(tags, t)
224		}
225
226	1	commentMat <- stri_match(line, regex="^#['\\]\\s([^@\\s].*$)")
227	1	if (!is.na(commentMat[1,2])){
228	1	comments <- paste(comments, commentMat[1,2])
229		}
230
231	1	routerModifierMat <- stri_match(line, regex="^#['\\]\\s@plumber")
232	1	if (!is.na(routerModifierMat[1,1])) {
233	1	routerModifier <- TRUE
234		}
235
236	1	lineNum <- lineNum - 1
237		}
238
239	1	list(
240	1	paths = paths,
241	1	preempt = preempt,
242	1	filter = filter,
243	1	serializer = serializer,
244	1	parsers = parsers,
245	1	assets = assets,
246	1	params = rev(params),
247	1	comments = comments,
248	1	responses = responses,
249	1	tags = tags,
250	1	routerModifier = routerModifier
251		)
252		}
253
254		#' Evaluate and activate a "block" of code found in a plumber API file.
255		#' @noRd
256		evaluateBlock <- function(srcref, file, expr, envir, addEndpoint, addFilter, pr) {
257	1	lineNum <- srcref[1] - 1
258
259	1	block <- plumbBlock(lineNum, file, envir)
260
261	1	if (sum(!is.null(block$filter), !is.null(block$paths), !is.null(block$assets), !is.null(block$routerModifier)) > 1){
262	1	stopOnLine(lineNum, file[lineNum], "A single function can only be a filter, an API endpoint, an asset or a Plumber object modifier (@filter AND @get, @post, @assets, @plumber, etc.)")
263		}
264
265		# ALL if statements possibilities must eventually call eval(expr, envir)
266	1	if (!is.null(block$paths)){
267	1	lapply(block$paths, function(p) {
268	1	ep <- PlumberEndpoint$new(
269	1	verbs = p$verb,
270	1	path = p$path,
271	1	expr = expr,
272	1	envir = envir,
273	1	serializer = block$serializer,
274	1	parsers = block$parsers,
275	1	lines = srcref,
276	1	params = block$params,
277	1	comments = block$comments,
278	1	responses = block$responses,
279	1	tags = block$tags
280		)
281
282	1	addEndpoint(ep, block$preempt)
283		})
284	1	} else if (!is.null(block$filter)){
285	1	filter <- PlumberFilter$new(block$filter, expr, envir, block$serializer, srcref)
286	1	addFilter(filter)
287
288	1	} else if (!is.null(block$assets)){
289	1	path <- block$assets$path
290
291		# Leading slash
292	1	if (substr(path, 1,1) != "/"){
293	1	path <- paste0("/", path)
294		}
295
296	1	stat <- PlumberStatic$new(block$assets$dir, expr)
297	1	pr$mount(path, stat)
298
299	1	} else if (!is.null(block$routerModifier)) {
300	1	if (is.expression(expr)){
301	1	func <- tryCatch({
302	1	eval(expr, envir)
303	1	}, error = function(e) {
304	0	stopOnLine(lineNum, file[lineNum], e)
305		})
306	1	if (is.function(func)) {
307	1	assign(".__plump_block_check__", TRUE, envir = envir)
308	1	on.exit(rm(".__plump_block_check__", envir = envir), add = TRUE)
309	1	fpr <- func(pr)
310	1	if (inherits(fpr, "Plumber") && !isTRUE(fpr$environment[[".__plump_block_check__"]])) {
311	0	stopOnLine(lineNum, file[lineNum], "Plumber object returned is not the same as the one in argument.")
312		}
313	1	return()
314		}
315		}
316	0	stopOnLine(lineNum, file[lineNum], "Invalid expression for @plumber tag, please use the form `function(pr) { }`.")
317		} else {
318	1	tryCatch({
319	1	eval(expr, envir)
320	1	}, error = function(e) {
321	0	stopOnLine(lineNum, file[lineNum], e)
322		})
323		}
324		}