make url handling better

SimonGreenhill · Apr 22, 2024 · ed2f480 · ed2f480
1 parent 22c46ff
commit ed2f480
Show file tree

Hide file tree

Showing 4 changed files with 18 additions and 8 deletions.
diff --git a/R/resolve_path.R b/R/resolve_path.R
@@ -24,8 +24,14 @@ resolve_path <- function(path, cache_dir=NA) {
         )
     }
 
+    # figure out the filetype, simplify urls first to remove url fragment (?download=x etc)
+    if (is_url(path)) {
+        file_ext <- tools::file_ext(urltools::url_parse(path)$path)
+    } else {
+        file_ext <- tools::file_ext(path)
+    }
+
     # given an archive file
-    file_ext <- tools::file_ext(urltools::url_parse(path)$path) # url_parse to remove ?download etc
     if (tolower(file_ext) %in% c('zip', 'gz', 'bz2')) {
         logger::log_debug("encountered archive file - decompressing")
         staging_dir <- file.path(cache_dir, openssl::md5(basename(path)))
@@ -63,7 +69,7 @@ resolve_path <- function(path, cache_dir=NA) {
         # limit to 10 so we don't risk loading all json files on the computer
         for (m in utils::head(mdfiles, 10)) {
             try({
-                logger::log_debug("passing to csvwr: ", path)
+                logger::log_debug("passing to csvwr: ", m)
                 return(list(path=m, metadata=csvwr::read_metadata(m)))
             }, silent = TRUE)
         }

diff --git a/inst/extdata/huon.zip b/inst/extdata/huon.zip
diff --git a/tests/testthat/test_cldf_loading.R b/tests/testthat/test_cldf_loading.R
@@ -12,19 +12,22 @@ test_that("test cldf loading", {
     o2 <- cldf(system.file("extdata/huon", package = "rcldf"))
     expect_equal(o, o2)
 
+    o3 <- cldf(system.file("extdata/huon.zip", package = "rcldf"))
+    expect_equal(o, patch_base_dir(o3, o$base_dir))
+
     # turn tests off if offline or on CRAN
     skip_if_offline()
     skip_on_cran()
 
     # github
-    o3 <- cldf("https://github.com/SimonGreenhill/huon_test_data/")
-    expect_equal(o, patch_base_dir(o3, o$base_dir))
+    o4 <- cldf("https://github.com/SimonGreenhill/huon_test_data/")
+    expect_equal(o, patch_base_dir(o4, o$base_dir))
 
     # github zip
-    o4 <- cldf("https://github.com/SimonGreenhill/huon_test_data/archive/refs/tags/v0.01.zip")
-    expect_equal(o, patch_base_dir(o4, o$base_dir))
+    o5 <- cldf("https://github.com/SimonGreenhill/huon_test_data/archive/refs/tags/v0.01.zip")
+    expect_equal(o, patch_base_dir(o5, o$base_dir))
 
     # zenodo
-    o5 <- cldf("https://zenodo.org/records/10901700/files/huon_test_data-0.01.zip?download=1")
-    expect_equal(o, patch_base_dir(o5, o$base_dir))
+    o6 <- cldf("https://zenodo.org/records/10901700/files/huon_test_data-0.01.zip?download=1")
+    expect_equal(o, patch_base_dir(o6, o$base_dir))
 })
diff --git a/tests/testthat/test_is_url.R b/tests/testthat/test_is_url.R
@@ -4,6 +4,7 @@ test_that("test is_url", {
     expect_equal(is_url("https://simon.net.nz/something/file.zip"), TRUE)
     expect_equal(is_url("ftp://simon.net.nz/something/file.zip"), TRUE)
     expect_equal(is_url("ssh://simon.net.nz/something/file.zip"), TRUE)
+    expect_equal(is_url("https://zenodo.org/records/10901700/files/huon_test_data-0.01.zip?download=1"), TRUE)
     expect_equal(is_url("gopher://simon.net.nz/something/file.zip"), TRUE)  # why not?
     expect_equal(is_url("/home/simon"), FALSE)
 })