Add tests with vcr cassettes

DESCRIPTION

@@ -12,10 +12,12 @@ Encoding: UTF-8
 LazyData: true
 Imports: 
     httr,
-    vcr,
+    vcr (>= 0.3.0.9132),
     magick,
     tibble
+Remotes: ropensci/vcr
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 6.1.1
 Suggests: 
-    testthat (>= 2.1.0)
+    testthat (>= 2.1.0),
+    vcr

R/bi_image.R

@@ -14,18 +14,18 @@
 #'                   to the final image (`0` for no rotation)
 #' @param quality    \[`character(1)`\]\cr{}
 #'
-#'                   * `"native"` for native colors of the image or,
-#'                   * `"color"` for the image in color,
-#'                   * `"gray"` for levels of gray,
-#'                   * `"bitonal"` for only black and white pixels.
+#' * `"native"` for native colors of the image or,
+#' * `"color"` for the image in color,
+#' * `"gray"` for levels of gray,
+#' * `"bitonal"` for only black and white pixels.
 #' @param format     \[`character(1)`\]\cr{}
 #'
-#'                   * `"jpg"` for JPEG image,
-#'                   * `"tif"` for TIFF image,
-#'                   * `"png"` for PNG image,
-#'                   * `"gif"` for GIF image,
-#'                   * `"jp2"` for JP2 image,
-#'                   * `"pdf"` for PDF image.
+#' * `"jpg"` for JPEG image,
+#' * `"tif"` for TIFF image,
+#' * `"png"` for PNG image,
+#' * `"gif"` for GIF image,
+#' * `"jp2"` for JP2 image,
+#' * `"pdf"` for PDF image.
 #'
 #' @return a matrix of the image
 #' @export
@@ -63,8 +63,10 @@ bi_image = function(identifier = NULL, region = c(0L, 0L, 500L, 500L),
 
   bi_query = bi_GET(identifier, region, size, rotation,
                     paste0(quality, ".", format))
-  if (httr::http_error(bi_query)) {
+  if (bi_query$status_code == 503) {
     stop("The API could not be reached, please try again later")
+  } else if (bi_query$status_code == 500) {
+    stop("The query gave no answer. Please try another query")
   }
 
   magick::image_read(bi_query$content)

R/bi_metadata.R

@@ -8,6 +8,17 @@ bi_metadata = function(identifier = NULL) {
   }
 
   bi_query = bi_GET(identifier, "manifest.json")
-  httr::http_error(bi_query)
-  httr::content(bi_query)
+
+  bi_content = httr::content(bi_query, encoding = "UTF-8")
+
+  bi_error = ifelse(!is.null(bi_content$ErrorFragment$contenu), TRUE, FALSE)
+
+  if (bi_query$status_code == 503) {
+    stop("The API could not be reached, please try again later")
+  } else if (bi_query$status_code == 500 |
+             bi_error) {
+    stop("The query gave no answer. Please try another query")
+  }
+
+  return(bi_content)
 }

tests/testthat/helper-bnfimage.R

@@ -0,0 +1,4 @@
+library("vcr")
+invisible(vcr::vcr_configure(
+  dir = "../fixtures"
+))

tests/testthat/test-bi_image.R

@@ -1,4 +1,4 @@
-test_that("bi_image() fails gracefully", {
+test_that("bi_image() fails gracefully on wrong arguments", {
   # Test for identifier
   expect_error(bi_image(NULL),
                "Define an identifier for your image", fixed = TRUE)
@@ -45,3 +45,159 @@ test_that("bi_image() fails gracefully", {
   expect_error(bi_image("a", format = 1),
                "'arg' must be NULL or a character vector", fixed = TRUE)
 })
+
+use_cassette("bi_image", {
+  test_that("bi_image() fails gracefully when sending a wrong query", {
+    expect_error(
+      bi_image(
+        identifier = "ark:/12345",
+        region     = "full",
+        size       = c(150, 75),
+        rotation   = 0,
+        quality    = "native",
+        format     = "png"),
+      "The query gave no answer. Please try another query", fixed = TRUE)
+  })
+
+  test_that("bi_image() works with correct query", {
+
+    # Regular query
+    eiffel_tower = bi_image(
+      identifier = "ark:/12148/btv1b9055204k/f1",
+      region     = "full",
+      size       = c(150, 75),
+      rotation   = 0,
+      quality    = "native",
+      format     = "png")
+
+    expect_is(eiffel_tower, "magick-image")
+
+    eiffel_info = magick::image_info(eiffel_tower)
+
+    expect_equal(eiffel_info,
+                 tibble::tibble(
+                   format = "PNG",
+                   width = 150L,
+                   height = 75L,
+                   colorspace = "Gray",
+                   matte = FALSE,
+                   filesize = 22533L,
+                   density = "157x157"
+                 ))
+
+    # Smaller size
+    eiffel_tower = bi_image(
+      identifier = "ark:/12148/btv1b9055204k/f1",
+      region     = "full",
+      size       = c(15, 7),
+      rotation   = 0,
+      quality    = "native",
+      format     = "png")
+    expect_is(eiffel_tower, "magick-image")
+
+    eiffel_info = magick::image_info(eiffel_tower)
+
+    expect_equal(eiffel_info,
+                 tibble::tibble(
+                   format = "PNG",
+                   width = 15L,
+                   height = 7L,
+                   colorspace = "Gray",
+                   matte = FALSE,
+                   filesize = 306L,
+                   density = "157x157"
+                 ))
+
+
+    # Change image format
+    ## JPEG
+    eiffel_tower = bi_image(
+      identifier = "ark:/12148/btv1b9055204k/f1",
+      region     = "full",
+      size       = c(15, 7),
+      rotation   = 0,
+      quality    = "native",
+      format     = "jpg")
+    expect_is(eiffel_tower, "magick-image")
+
+    eiffel_info = magick::image_info(eiffel_tower)
+
+    expect_equal(eiffel_info,
+                 tibble::tibble(
+                   format = "JPEG",
+                   width = 15L,
+                   height = 7L,
+                   colorspace = "Gray",
+                   matte = FALSE,
+                   filesize = 224L,
+                   density = "400x400"
+                 ))
+    ## TIFF
+    eiffel_tower = bi_image(
+      identifier = "ark:/12148/btv1b9055204k/f1",
+      region     = "full",
+      size       = c(15, 7),
+      rotation   = 0,
+      quality    = "native",
+      format     = "tif")
+    expect_is(eiffel_tower, "magick-image")
+
+    eiffel_info = magick::image_info(eiffel_tower)
+
+    expect_equal(eiffel_info,
+                 tibble::tibble(
+                   format = "TIFF",
+                   width = 15L,
+                   height = 7L,
+                   colorspace = "Gray",
+                   matte = FALSE,
+                   filesize = 525L,
+                   density = "400x400"
+                 ))
+
+    # Color
+    ## Color
+    eiffel_tower = bi_image(
+      identifier = "ark:/12148/btv1b9055204k/f1",
+      region     = "full",
+      size       = c(15, 7),
+      rotation   = 0,
+      quality    = "color",
+      format     = "gif")
+    expect_is(eiffel_tower, "magick-image")
+
+    eiffel_info = magick::image_info(eiffel_tower)
+
+    expect_equal(eiffel_info,
+                 tibble::tibble(
+                   format = "GIF",
+                   width = 15L,
+                   height = 7L,
+                   colorspace = "sRGB",
+                   matte = FALSE,
+                   filesize = 526L,
+                   density = "72x72"))
+    ## Bitonal
+    eiffel_tower = bi_image(
+      identifier = "ark:/12148/btv1b9055204k/f1",
+      region     = "full",
+      size       = c(15, 7),
+      rotation   = 0,
+      quality    = "bitonal",
+      format     = "gif")
+    expect_is(eiffel_tower, "magick-image")
+
+    eiffel_info = magick::image_info(eiffel_tower)
+
+    expect_equal(eiffel_info,
+                 tibble::tibble(
+                   format = "GIF",
+                   width = 15L,
+                   height = 7L,
+                   colorspace = "sRGB",
+                   matte = FALSE,
+                   filesize = 58L,
+                   density = "72x72"))
+
+  })
+})

tests/testthat/test-bi_metadata.R

@@ -0,0 +1,28 @@
+
+test_that("bi_metadata() fails when forgetting id", {
+  expect_error(bi_metadata(NULL),
+               "Define an identifier for your image",
+               fixed = TRUE)
+})
+
+vcr::use_cassette("bi_metadata", {
+  test_that("bi_metadata() fails gracefully", {
+    expect_error(bi_metadata("12345"),
+                 "The query gave no answer. Please try another query",
+                 fixed = TRUE)
+  })
+
+
+  test_that("bi_metadata() works when using good id", {
+    expect_silent(eif  <- bi_metadata("ark:/12148/btv1b9055204k/f1"))
+
+    expect_is(eif, "list")
+    expect_length(eif, 13)
+    expect_equal(eif[["@id"]],
+                 paste0("https://gallica.bnf.fr/iiif/ark:/12148/btv1b9055204k/",
+                        "manifest.json"))
+    expect_equal(eif[["logo"]],
+                 "https://gallica.bnf.fr/mbImage/logos/logo-bnf.png")
+  })
+})
+