From 016f57579229aebd44254234f75f63aeba3c4fc7 Mon Sep 17 00:00:00 2001 From: pachamaltese Date: Thu, 14 Mar 2019 13:13:52 -0300 Subject: [PATCH 1/5] halfway svg render, still downloads instead of showing --- R/content-types.R | 2 +- R/images.R | 10 +++++++--- R/parse-block.R | 4 +++- 3 files changed, 11 insertions(+), 5 deletions(-) diff --git a/R/content-types.R b/R/content-types.R index a3730d0dc..f60c0022f 100644 --- a/R/content-types.R +++ b/R/content-types.R @@ -64,7 +64,7 @@ getCharacterSet <- function(contentType){ as.character( ifelse( charsetStart > -1, - substr(contentType, charsetStart, nchar(contentType)), + substr(contentType, charsetStart, nchar(contentType)), default ) ) diff --git a/R/images.R b/R/images.R index 423e3a58a..db198440b 100644 --- a/R/images.R +++ b/R/images.R @@ -1,6 +1,6 @@ -#' @param imageFun The function to call to setup the image device (e.g. `png`) -#' @param args A list of supplemental arguments to be passed into jpeg() -#' @importFrom grDevices dev.off jpeg png +#' @param imageFun The function to call to setup the image device (`png`, `jpeg` or `svg`) +#' @param args A list of supplemental arguments to be passed into png(), jpeg() or svg() +#' @importFrom grDevices dev.off jpeg png svg #' @noRd render_image <- function(imageFun, contentType, args=NULL){ list( @@ -31,3 +31,7 @@ render_jpeg <- function(args){ render_png <- function(args){ render_image(png, "image/png", args) } + +render_svg <- function(args){ + render_image(svg, "image/svg", args) +} diff --git a/R/parse-block.R b/R/parse-block.R index 4a6c339ad..1a49530b3 100644 --- a/R/parse-block.R +++ b/R/parse-block.R @@ -149,7 +149,7 @@ parseBlock <- function(lineNum, file){ } - imageMat <- stringi::stri_match(line, regex="^#['\\*]\\s*@(jpeg|png)([\\s\\(].*)?\\s*$") + imageMat <- stringi::stri_match(line, regex="^#['\\*]\\s*@(jpeg|png|svg)([\\s\\(].*)?\\s*$") if (!is.na(imageMat[1,1])){ if (!is.null(image)){ # Must have already assigned. @@ -262,6 +262,8 @@ evaluateBlock <- function(srcref, file, expr, envir, addEndpoint, addFilter, mou ep$registerHooks(render_png(imageArgs)) } else if (block$image == "jpeg"){ ep$registerHooks(render_jpeg(imageArgs)) + } else if (block$image == "svg"){ + ep$registerHooks(render_svg(imageArgs)) } else { stop("Image format not found: ", block$image) } From f3a4ac736056bc05c4166533d51bb845d361601d Mon Sep 17 00:00:00 2001 From: pachamaltese Date: Thu, 14 Mar 2019 16:33:50 -0300 Subject: [PATCH 2/5] well rendered svg in firefox --- R/images.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/images.R b/R/images.R index db198440b..42dafdfae 100644 --- a/R/images.R +++ b/R/images.R @@ -33,5 +33,5 @@ render_png <- function(args){ } render_svg <- function(args){ - render_image(svg, "image/svg", args) + render_image(svg, "image/svg+xml", args) } From 70e5974dec27a47cec030604caac19803999be09 Mon Sep 17 00:00:00 2001 From: Pachamaltese Date: Tue, 25 Feb 2020 15:39:04 -0300 Subject: [PATCH 3/5] test for svg --- tests/testthat/test-image.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/testthat/test-image.R b/tests/testthat/test-image.R index 832fdbfb7..0d590753c 100644 --- a/tests/testthat/test-image.R +++ b/tests/testthat/test-image.R @@ -26,6 +26,10 @@ test_that("Images are properly rendered", { expect_equal(resp$headers$`Content-type`, "image/jpeg") expect_gt(length(resp$body), 100) # This changes based on R ver/OS, may not be useful. expect_lt(length(resp$body), fullsizeJPEG) # Should be smaller than the full one + + resp <- r$serve(make_req("GET", "/svg"), PlumberResponse$new()) + expect_equal(resp$status, 200) + expect_equal(resp$headers$`Content-type`, "image/svg+xml") }) test_that("render_image arguments supplement", { From 428b9713bb72b0d9ae4d3223ae8537f4e0bebbc7 Mon Sep 17 00:00:00 2001 From: Pachamaltese Date: Tue, 25 Feb 2020 16:23:44 -0300 Subject: [PATCH 4/5] revert test --- tests/testthat/test-image.R | 4 ---- 1 file changed, 4 deletions(-) diff --git a/tests/testthat/test-image.R b/tests/testthat/test-image.R index 0d590753c..832fdbfb7 100644 --- a/tests/testthat/test-image.R +++ b/tests/testthat/test-image.R @@ -26,10 +26,6 @@ test_that("Images are properly rendered", { expect_equal(resp$headers$`Content-type`, "image/jpeg") expect_gt(length(resp$body), 100) # This changes based on R ver/OS, may not be useful. expect_lt(length(resp$body), fullsizeJPEG) # Should be smaller than the full one - - resp <- r$serve(make_req("GET", "/svg"), PlumberResponse$new()) - expect_equal(resp$status, 200) - expect_equal(resp$headers$`Content-type`, "image/svg+xml") }) test_that("render_image arguments supplement", { From d56ebd1e0a1c9d2ff216dac9ea89c3899df3ea31 Mon Sep 17 00:00:00 2001 From: Pachamaltese Date: Tue, 25 Feb 2020 16:49:59 -0300 Subject: [PATCH 5/5] working svg test --- tests/testthat/files/image.R | 5 +++++ tests/testthat/test-image.R | 4 ++++ 2 files changed, 9 insertions(+) diff --git a/tests/testthat/files/image.R b/tests/testthat/files/image.R index bf0f8ff14..706171cfd 100644 --- a/tests/testthat/files/image.R +++ b/tests/testthat/files/image.R @@ -10,6 +10,11 @@ function() { plot(1:10) } +#* @svg +#* @get /svg +function() { + plot(1:10) +} #' @png (width = 150, height=150) #' @get /littlepng diff --git a/tests/testthat/test-image.R b/tests/testthat/test-image.R index 832fdbfb7..9104ecc6c 100644 --- a/tests/testthat/test-image.R +++ b/tests/testthat/test-image.R @@ -26,6 +26,10 @@ test_that("Images are properly rendered", { expect_equal(resp$headers$`Content-type`, "image/jpeg") expect_gt(length(resp$body), 100) # This changes based on R ver/OS, may not be useful. expect_lt(length(resp$body), fullsizeJPEG) # Should be smaller than the full one + + resp <- r$serve(make_req("GET", "/svg"), PlumberResponse$new()) + expect_equal(resp$status, 200) + expect_equal(resp$headers$`Content-type`, "image/svg+xml") # without +xml doesn't work in firefox }) test_that("render_image arguments supplement", {