Merge pull request #11 from pepijn-devries/7-motu-download-page-is-no…

…t-always-html-can-also-be-xml

several minor fixes

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: CopernicusMarine
 Type: Package
 Title: Search Download and Handle Data from Copernicus Marine Service Information
-Version: 0.0.7
+Version: 0.0.8
 Date: 2023-02-10
 Authors@R: c(person("Pepijn", "de Vries", role = c("aut", "cre", "dtc"),
     email = "[email protected]",
@@ -37,6 +37,6 @@ BugReports: https://github.com/pepijn-devries/CopernicusMarine/issues
 License: GPL (>= 3)
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.3
 Config/testthat/edition: 3
 Roxygen: list(markdown = TRUE)

R/CopernicusMarine-package.r

@@ -0,0 +1,3 @@
+#' @keywords internal 
+"_PACKAGE"
+NULL

R/copernicus_download_motu.r

@@ -33,7 +33,7 @@
 #' \dontrun{
 #' destination <- tempfile("copernicus", fileext = ".nc")
 #'
-#' ## Assuming that Copernicus account details are provided as `options`
+#' ## Assuming that Copernicus account details are provided as `option`
 #' copernicus_download_motu(
 #'   destination   = destination,
 #'   product       = "GLOBAL_ANALYSISFORECAST_PHY_001_024",
@@ -98,10 +98,13 @@ copernicus_download_motu <- function(
   }
 
   message(crayon::white("Preparing download..."))
+
+  product_services <- copernicus_product_services(product) %>% dplyr::filter(layer == {{layer}})
 
-  product_services <- copernicus_product_services(product) %>% dplyr::filter(layer == {{layer}}) %>% dplyr::pull("motu")
+  if (!"motu" %in% names(product_services) || is.na(product_services$motu))
+    return(invisible(FALSE))
 
-  if (is.null(product_services) || is.na(product_services)) return(invisible(FALSE))
+  product_services <- product_services %>% dplyr::pull("motu")
 
   if (missing(timerange)) timerange <- NULL else timerange <- format(as.POSIXct(timerange), "%Y-%m-%d+%H%%3A%M%%3A%S")
   prepare_url <-
@@ -138,7 +141,6 @@ copernicus_download_motu <- function(
       message(errors)
       return(invisible(FALSE))
     }
-
     message(crayon::white("Downloading file..."))
 
     download_url <-

R/copernicus_product_details.r

@@ -60,6 +60,9 @@ copernicus_product_details <- function(product, layer, variable) {
 #' @export
 copernicus_product_services <- function(product) {
   services <- copernicus_product_details(product)
-  services <- services$services %>% purrr::map_dfr(dplyr::as_tibble) %>% dplyr::mutate(layer = names(services$services))
+  services <- services$services %>% purrr::map_dfr(dplyr::as_tibble) %>%
+    dplyr::mutate(layer = {
+      nms <- names(services$services)
+      nms[nms != ""] })
   return(services)
 }

R/copernicus_product_metadata.r

@@ -4,7 +4,7 @@
 #' for specific Copernicus marine products
 #'
 #' @inheritParams copernicus_download_motu
-#' @return Returns a named `list` with info about the requested `product`. Returns `NULL`
+#' @returns Returns a named `list` with info about the requested `product`. Returns `NULL`
 #' when contacting Copernicus fails.
 #' @rdname copernicus_product_metadata
 #' @name copernicus_product_metadata

R/copernicus_products_list.r

@@ -7,7 +7,7 @@
 #' When omitted, the full list of products is returned.
 #' @param info_type One of `"list"` (default) or `"meta"`. `"list"` returns the actual list
 #' whereas `"meta"` returns meta information for the executed query (e.g. number of hits).
-#' @return Returns a `tibble` of products available from <https://data.marine.copernicus.eu> or
+#' @returns Returns a `tibble` of products available from <https://data.marine.copernicus.eu> or
 #' a named `list` when `info_type = "meta"`. Returns `NULL` in case on-line services are
 #' unavailable.
 #' @rdname copernicus_products_list

R/ftp.r

@@ -8,11 +8,13 @@
 #' [`copernicus_ftp_list`].
 #' @param show_progress A `logical` value. When `TRUE` (default) the download progress will be shown.
 #' This can be useful for large files.
+#' @param recursive A `logical` value. When `TRUE` all nested files will be listed.
 #' @param overwrite A `logical` value. When `FALSE` (default), files at the `destination` won't be
 #' overwritten when the exist. Instead an error will be thrown if this is the case. When set to
 #' `TRUE`, existing files will be overwritten.
+#' @param subdir A `character` string of a subdir which will be appended to the obtained ftp address.
 #' @inheritParams copernicus_download_motu
-#' @return In case of `copernicus_ftp_list` a `tibble` is returned containing available URLs
+#' @returns In case of `copernicus_ftp_list` a `tibble` is returned containing available URLs
 #' (for the specified product and layer) and some meta information is returned.
 #' In case of `copernicus_ftp_get` an invisible `logical` value is returned, indicating whether
 #' the requested file is successfully stored at the `destination` path.
@@ -31,8 +33,10 @@
 #' @export
 copernicus_ftp_list <- function(
     product, layer,
-    username = getOption("CopernicusMarine_uid", ""),
-    password = getOption("CopernicusMarine_pwd", "")) {
+    username  = getOption("CopernicusMarine_uid", ""),
+    password  = getOption("CopernicusMarine_pwd", ""),
+    recursive = TRUE,
+    subdir    = NULL) {
   name <- NULL # workaround for 'no visible binding global for global variable'
   dirlist <- function(url){
     dir_result <-
@@ -43,19 +47,19 @@ copernicus_ftp_list <- function(
           dirlistonly = TRUE)
       }, "Copernicus")
     if (is.null(dir_result)) return(NULL)
-    
+
     dir_result <-
       dir_result %>%
       `[[`("content") %>%
       rawToChar() %>%
-      readr::read_fwf(
-        name_repair = ~c("flags", "len", "protocol", "protocol2", "size", "month", "day", "time", "name"),
+      readr::read_table(
+        col_names = c("flags", "len", "protocol", "protocol2", "size", "month", "day", "time", "name"),
         col_types = readr::cols(
           flags     = readr::col_character(),
           len       = readr::col_integer(),
           protocol  = readr::col_character(),
           protocol2 = readr::col_character(),
-          size      = readr::col_integer(),
+          size      = readr::col_number(),
           month     = readr::col_character(),
           day       = readr::col_integer(),
           time      = readr::col_character(),
@@ -64,7 +68,7 @@ copernicus_ftp_list <- function(
       dplyr::select(!dplyr::any_of(c("protocol2", "name"))) %>%
       dplyr::rowwise() %>%
       dplyr::group_map(~{
-        if (startsWith(..1$flags, "d")) dirlist(sprintf("%s/", ..1$url)) else ..1
+        if (recursive && startsWith(..1$flags, "d")) dirlist(sprintf("%s/", ..1$url)) else ..1
       }) %>%
       dplyr::bind_rows()
   }
@@ -77,6 +81,7 @@ copernicus_ftp_list <- function(
   } else {
     base_url <- base_url %>% dplyr::filter(layer == {{layer}}) %>% dplyr::pull("ftp")
   }
+  base_url <- paste(c(base_url, subdir), collapse = "/")
 
   result <- dirlist(paste0(base_url, "/"))
   return(result)

R/imports.r

@@ -6,7 +6,7 @@
 #' \item{dplyr pipe operator}{[`%>%`][dplyr::reexports]}
 #' }
 #' @importFrom dplyr %>%
-#' @return Returns the result of the function call on the right-hand side of the pipe operator.
+#' @returns Returns the result of the function call on the right-hand side of the pipe operator.
 #' The left-hand side is used as first argument to the call to the right-hand side. For
 #' more details see [dplyr::reexports].
 #' @export %>%

R/wms.r

@@ -4,7 +4,7 @@
 #' products and layers. Use this function to obtain URLs of WMS services if any.
 #' @template wms_template
 #' @inheritParams copernicus_download_motu
-#' @return Returns a `tibble` with WMS URLs and descriptors for the specified product.
+#' @returns Returns a `tibble` with WMS URLs and descriptors for the specified product.
 #' @rdname copernicus_wms_details
 #' @name copernicus_wms_details
 #' @family wms-functions
@@ -42,7 +42,7 @@ copernicus_wms_details <- function(product, layer, variable) {
 #' @inheritParams copernicus_download_motu
 #' @param options Passed on to [`leaflet::addWMSTiles()`].
 #' @param ... Passed on to [`leaflet::addWMSTiles()`].
-#' @return Returns an updated `map`
+#' @returns Returns an updated `map`
 #' @rdname addCopernicusWMSTiles
 #' @name addCopernicusWMSTiles
 #' @family wms-functions
@@ -88,7 +88,7 @@ addCopernicusWMSTiles <- function(map, product, layer, variable,
 #' @param destination File name for the geo-referenced TIFF.
 #' @param width Width in pixels of the TIFF image.
 #' @param height Height in pixels of the TIFF image.
-#' @return Stores the file as `destination` and returns invisible `NULL`
+#' @returns Stores the file as `destination` and returns invisible `NULL`
 #' @rdname copernicus_wms2geotiff
 #' @name copernicus_wms2geotiff
 #' @family wms-functions