Refactor convert_input to Perform tasks via helper function

CHANGELOG.md

@@ -1,4 +1,5 @@
 # Change Log
+
 All notable changes are kept in this file. All changes made should be added to the section called
 `Unreleased`. Once a new release is made this file will be updated to create a new `Unreleased`
 section for the next release.
@@ -9,6 +10,8 @@ For more information about this file see also [Keep a Changelog](http://keepacha
 
 ### Added
 
+- Refactor `convert_input` to Perform tasks via helper function. Subtask of [#3307](https://github.com/PecanProject/pecan/issues/3307)
+
 ### Fixed
 - updated github action to build docker images
 

base/db/R/add.database.entries.R

@@ -0,0 +1,121 @@
+#' Return new arrangement of database while adding code to deal with ensembles
+#'
+#' @param result list of results from the download function
+#' @param con database connection
+#' @param start_date start date of the data
+#' @param end_date end date of the data
+#' @param write whether to write to the database
+#' @param overwrite Logical: If a file already exists, create a fresh copy?
+#' @param insert.new.file whether to insert a new file
+#' @param input.args input arguments obtained from the convert_input function
+#' @param machine machine information
+#' @param mimetype data product specific file format
+#' @param formatname format name of the data
+#' @param allow.conflicting.dates whether to allow conflicting dates
+#' @param ensemble ensemble id
+#' @param ensemble_name ensemble name
+#' @param existing.input existing input records
+#' @param existing.dbfile existing dbfile records
+#' @param input input records
+#' @return list of input and dbfile ids
+#'
+#' @author Betsy Cowdery, Michael Dietze, Ankur Desai, Tony Gardella, Luke Dramko
+
+add.database.entries <- function(
+ result, con, start_date,
+ end_date, write, overwrite,
+ insert.new.file, input.args,
+ machine, mimetype, formatname,
+ allow.conflicting.dates, ensemble,
+ ensemble_name, existing.input,
+ existing.dbfile, input) {
+ if (write) {
+ # Setup newinput. This list will contain two variables: a vector of input IDs and a vector of DB IDs for each entry in result.
+ # This list will be returned.
+ newinput <- list(input.id = NULL, dbfile.id = NULL) # Blank vectors are null.
+
+ for (i in 1:length(result)) { # Master for loop
+ id_not_added <- TRUE
+
+ if (!is.null(existing.input) && nrow(existing.input[[i]]) > 0 &&
+ (existing.input[[i]]$start_date != start_date || existing.input[[i]]$end_date != end_date)) {
+ # Updating record with new dates
+ db.query(paste0("UPDATE inputs SET start_date='", start_date, "', end_date='", end_date, "' WHERE id=", existing.input[[i]]$id), con)
+ id_not_added <- FALSE
+
+ # The overall structure of this loop has been set up so that exactly one input.id and one dbfile.id will be written to newinput every iteration.
+ newinput$input.id <- c(newinput$input.id, existing.input[[i]]$id)
+ newinput$dbfile.id <- c(newinput$dbfile.id, existing.dbfile[[i]]$id)
+ }
+
+ if (overwrite) {
+ # A bit hacky, but need to make sure that all fields are updated to expected values (i.e., what they'd be if convert_input was creating a new record)
+ if (!is.null(existing.input) && nrow(existing.input[[i]]) > 0) {
+ db.query(paste0("UPDATE inputs SET name='", basename(dirname(result[[i]]$file[1])), "' WHERE id=", existing.input[[i]]$id), con)
+ }
+
+ if (!is.null(existing.dbfile) && nrow(existing.dbfile[[i]]) > 0) {
+ db.query(paste0("UPDATE dbfiles SET file_path='", dirname(result[[i]]$file[1]), "', file_name='", result[[i]]$dbfile.name[1], "' WHERE id=", existing.dbfile[[i]]$id), con)
+ }
+ }
+
+ # If there is no ensemble then for each record there should be one parent
+ # But when you have ensembles, all of the members have one parent !!
+ parent.id <- if (is.numeric(ensemble)) {
+ ifelse(is.null(input[[i]]), NA, input[[1]]$id)
+ } else {
+ ifelse(is.null(input[[i]]), NA, input[[i]]$id)
+ }
+
+
+ if ("newsite" %in% names(input.args) && !is.null(input.args[["newsite"]])) {
+ site.id <- input.args$newsite
+ }
+
+ if (insert.new.file && id_not_added) {
+ dbfile.id <- dbfile.insert(
+ in.path = dirname(result[[i]]$file[1]),
+ in.prefix = result[[i]]$dbfile.name[1],
+ "Input",
+ existing.input[[i]]$id,
+ con,
+ reuse = TRUE,
+ hostname = machine$hostname
+ )
+
+ newinput$input.id <- c(newinput$input.id, existing.input[[i]]$id)
+ newinput$dbfile.id <- c(newinput$dbfile.id, dbfile.id)
+ } else if (id_not_added) {
+ # This is to tell input.insert if we are writing ensembles
+ # Why does it need it? Because it checks for inputs with the same time period, site, and machine
+ # and if it returns something it does not insert anymore, but for ensembles, it needs to bypass this condition
+ ens.flag <- if (!is.null(ensemble) | is.null(ensemble_name)) TRUE else FALSE
+
+ new_entry <- dbfile.input.insert(
+ in.path = dirname(result[[i]]$file[1]),
+ in.prefix = result[[i]]$dbfile.name[1],
+ siteid = site.id,
+ startdate = start_date,
+ enddate = end_date,
+ mimetype = mimetype,
+ formatname = formatname,
+ parentid = parent.id,
+ con = con,
+ hostname = machine$hostname,
+ allow.conflicting.dates = allow.conflicting.dates,
+ ens = ens.flag
+ )
+
+ newinput$input.id <- c(newinput$input.id, new_entry$input.id)
+ newinput$dbfile.id <- c(newinput$dbfile.id, new_entry$dbfile.id)
+ }
+ } # End for loop
+
+ successful <- TRUE
+ return(newinput)
+ } else {
+ PEcAn.logger::logger.warn("Input was not added to the database")
+ successful <- TRUE
+ return(NULL)
+ }
+}

base/db/R/check.missing.files.R

@@ -0,0 +1,47 @@
+#' Function to check if result has empty or missing files
+#'
+#' @param result A list of dataframes with file paths
+#' @param outname Name of the output file
+#' @param existing.input Existing input records
+#' @param existing.dbfile Existing dbfile records
+#' @return A list of dataframes with file paths, a list of strings with the output file name, a list of existing input records, and a list of existing dbfile records
+#'
+#' @author Betsy Cowdery, Michael Dietze, Ankur Desai, Tony Gardella, Luke Dramko
+
+check_missing_files <- function(result, outname, existing.input = NULL, existing.dbfile = NULL) {
+ result_sizes <- purrr::map_dfr(
+ result,
+ ~ dplyr::mutate(
+ .,
+ file_size = purrr::map_dbl(file, file.size),
+ missing = is.na(file_size),
+ empty = file_size == 0
+ )
+ )
+
+ if (any(result_sizes$missing) || any(result_sizes$empty)) {
+ log_format_df <- function(df) {
+ formatted_df <- rbind(colnames(df), format(df))
+ formatted_text <- purrr::reduce(formatted_df, paste, sep = " ")
+ paste(formatted_text, collapse = "\n")
+ }
+
+ PEcAn.logger::logger.severe(
+ "Requested Processing produced empty files or Nonexistent files:\n",
+ log_format_df(result_sizes[, c(1, 8, 9, 10)]),
+ "\n Table of results printed above.",
+ wrap = FALSE
+ )
+ }
+
+
+ # Wrap in a list for consistant processing later
+ if (exists("existing.input") && is.data.frame(existing.input)) {
+ existing.input <- list(existing.input)
+ }
+
+ if (exists("existing.dbfile") && is.data.frame(existing.dbfile)) {
+ existing.dbfile <- list(existing.dbfile)
+ }
+ return(list(existing.input, existing.dbfile))
+}