new function added for copying mod, obs, lai and weather files

DESCRIPTION

@@ -70,7 +70,7 @@ ByteCompile: true
 Encoding: UTF-8
 Language: en-US
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Collate: 
     'add_node_to_doc.R'
     'add_stics_nodes.R'
@@ -183,7 +183,7 @@ Collate:
     'set_usms_param_xml.R'
     'static_help.R'
     'stics_environment.R'
-    'stics_examples_utils.R'
+    'stics_files_utils.R'
     'upgrade_ini_xml.R'
     'upgrade_param_gen_xml.R'
     'upgrade_param_newform_xml.R'

R/stics_examples_utils.R → R/stics_files_utils.R

@@ -157,3 +157,114 @@ unzip_examples <- function(files_type, version_dir, overwrite = FALSE) {
 
   return(dir_path)
 }
+
+
+#' Copy mod, obs, lai, and weather data files
+#' @param workspace JavaStics xml workspace path
+#' @param file_type file type to copy among "mod", "obs", "clim"
+#' @param javastics JavaStics folder path (Optional)
+#' @param out_dir   Output directry path
+#' @param verbose   logical, TRUE for displaying a copy message
+#' FALSE otherwise (default)
+#' @param overwrite Logical TRUE for overwriting files,
+#' FALSE otherwise (default)
+#'
+#' @return invisible copy statuses
+#'
+#' @keywords internal
+#' @noRd
+#'
+workspace_files_copy <- function(workspace,
+                                 file_type = NULL,
+                                 javastics = NULL,
+                                 out_dir,
+                                 overwrite = FALSE,
+                                 verbose = FALSE) {
+
+  # files types vector and associated regex
+  file_types <- c("mod", "obs", "lai", "meteo")
+  file_patt <- c("*.mod", "*.obs", "*.lai", "\\.[0-9]{4}$")
+  file_desc <- c("output definition (*.mod)",
+                 "observation (*.obs)",
+                 "LAI dynamics (*.lai)",
+                 "weather data (*.YYYY)")
+
+  # if file_type is not given, all files type are processed
+  if (is.null(file_type)) file_type <- file_types
+
+  # recurive call for a vector
+  if (length(file_type) > 1) {
+    stat_list <- vector(mode = "list", length(file_type))
+    for (i in seq_along(file_type)) {
+      stat_list[[i]] <- workspace_files_copy(workspace = workspace,
+                                             file_type = file_type[i],
+                                             javastics = javastics,
+                                             out_dir = out_dir,
+                                             overwrite = overwrite,
+                                             verbose = verbose
+      )
+    }
+    return(invisible(stat_list))
+  }
+
+  # Just in case if the func is used outside of the workspace upgrade
+  type_idx <- file_types %in% file_type
+
+  if (! any(type_idx)) {
+    warning("The given file type does not exist: ", file_type, " nothing done!")
+    return()
+  }
+
+  # getting the file path list to copy
+  patt <- file_patt[type_idx]
+  files_list <- list.files(path = workspace,
+                           full.names = TRUE,
+                           pattern = patt)
+
+  # Just for the *.mod files, looking in javastics if not found in the workspace
+  # TODO: combine both if partial match
+  if (length(files_list) == 0) {
+    if (file_type == "mod") {
+
+      if (is.null(javastics)) {
+        warning(paste("No", "mod",
+                      "files in the source workspace",
+                      "the Javastics path must be given",
+                      "as input for copying files from it"))
+      }
+
+      files_list <- list.files(
+        path = file.path(javastics, "example",
+                         full.names = TRUE,
+                         pattern = patt))
+
+    }
+  }
+
+  # nothing to do
+  if (length(files_list) == 0) {
+    warning(paste0("Not any '", file_desc[type_idx], "' file to copy!"))
+    return()
+  }
+
+  # copy and treat of the copy return
+  stat <- file.copy(
+    from = files_list,
+    to = out_dir,
+    overwrite = overwrite
+  )
+
+  if (verbose) {
+    message(paste("Copying", file_desc[type_idx], "files.\n"))
+  }
+
+  if (!all(stat)) {
+    warning("Error when copying file(s): ",
+            paste(basename(files_list[!stat]), collapse = ", "),
+            "\nin\n",
+            out_dir,
+            "\n",
+            "Consider to set as input: overwrite = TRUE")
+  }
+  return(invisible(stat))
+}

R/upgrade_workspace_xml.R

@@ -261,57 +261,67 @@ upgrade_workspace_xml <- function(workspace,
     message("*_tec.xml\n")
   }
 
-  # Copying *.mod files (for model outputs)
-  stat <- file.copy(
-    from = list.files(path = workspace, full.names = TRUE, pattern = "*.mod"),
-    to = out_dir, overwrite = overwrite
-  )
 
-  if (verbose) {
-    message("Copying *.mod files.\n")
-  }
-
-  # TODO: see how to manage variables names checks in *.mod files
-  # Probably, the new JavaSTICS path may be added as a new function argument
-  # for getting information on output variables
-  # (use get_var_info with the appropriate version string)
+  # # Copying *.mod files (for model outputs)
+  # stat <- file.copy(
+  #   from = list.files(path = workspace, full.names = TRUE, pattern = "*.mod"),
+  #   to = out_dir, overwrite = overwrite
+  # )
+  #
+  # if (verbose) {
+  #   message("Copying *.mod files.\n")
+  # }
 
 
   # Copying observation files
   # all .obs files deteted in workspace,
   # not only according to usms names, because now obs files names are
   # references in the usms.xml file (i.e. not fixed a priori)
-  stat <- file.copy(
-    from = list.files(path = workspace, full.names = TRUE, pattern = "*.obs"),
-    to = out_dir, overwrite = overwrite
-  )
-
-  if (verbose) {
-    message("Copying *.obs files.\n")
-  }
+  # stat <- file.copy(
+  #   from = list.files(path = workspace, full.names = TRUE, pattern = "*.obs"),
+  #   to = out_dir, overwrite = overwrite
+  # )
+  #
+  # if (verbose) {
+  #   message("Copying *.obs files.\n")
+  # }
 
   # Copying weather data files
   # Note: for the moment, all files with a numerical extension
   # (i.e. year, as .1996) are taken into account because when USM are
   # defined over 2 successive years, files are not explicitly mentioned
   # in the usms.xml file.
 
-  weather_files <-
-    list.files(workspace, full.names = TRUE, pattern = "\\.[0-9]")
+  # weather_files <-
+  #   list.files(workspace, full.names = TRUE, pattern = "\\.[0-9]")
+  #
+  # stat <- file.copy(
+  #   from = weather_files,
+  #   to = out_dir, overwrite = overwrite
+  # )
+  #
+  # if (!all(stat)) {
+  #   warning("Error when copying file(s): ",
+  #           paste(weather_files[stat], collapse = ", "))
+  # }
+  #
+  # if (verbose) {
+  #   message("Copying weather files.\n")
+  # }
 
-  stat <- file.copy(
-    from = weather_files,
-    to = out_dir, overwrite = overwrite
-  )
 
-  if (!all(stat)) {
-    warning("Error when copying file(s): ",
-            paste(weather_files[stat], collapse = ", "))
-  }
+  # TODO: see how to manage variables names checks in *.mod files
+  # Probably, the new JavaSTICS path may be added as a new function argument
+  # for getting information on output variables
+  # (use get_var_info with the appropriate version string)
+
+  workspace_files_copy(workspace = workspace,
+                       file_type = c("mod", "obs", "lai", "meteo"),
+                       javastics = javastics,
+                       out_dir = out_dir,
+                       overwrite = overwrite,
+                       verbose = verbose)
 
-  if (verbose) {
-    message("Copying weather files.\n")
-  }