Merge branch 'develop' into test-db

CHANGELOG.md

@@ -107,6 +107,7 @@ convert data for a single PFT fixed (#1329, #2974, #2981)
 - Internal changes to keep up to date with tidyselect v1.2.0
 - The `PEcAn.utils::download.file()` function has now been renamed to `PEcAn.utils::download_file()`
 - The `regrid()` and `grid2netcdf()` function from `PEcAn.utils` have been moved to `PEcAn.data.remote` package.
+- Web is now build using PHP 8 since PHP 7 is EOL.
 
 ### Removed
 

base/qaqc/DESCRIPTION

@@ -21,14 +21,16 @@ Imports:
     stats
 Suggests:
     knitr,
+    mockery,
     mvbutils,
     PEcAn.BIOCRO,
     PEcAn.ED2,
     PEcAn.SIPNET,
     PEcAn.utils,
     rmarkdown,
     testthat (>= 3.0.4),
-    vdiffr (>= 1.0.2)
+    vdiffr (>= 1.0.2),
+    withr
 X-Comment-Remotes:
     Installing vdiffr from GitHub because as of 2021-09-23, this is the
     easiest way to get version >= 1.0.2 onto Docker images that use older

base/qaqc/R/find_formats_without_inputs.R

@@ -5,13 +5,13 @@
 ##' @param con database connection object
 ##' @param user_id_code  Optional parameter to search by user_id
 ##' @param created_after Optional parameter to search by creation date. Date must be in form 'YYYY-MM-DD'.
-##' @param created_before Optional parameter to search by creation date. Can be used in conjunciton with created_after to specify a spesific window. Date must be in form 'YYYY-MM-DD'.
-##' @param updated_after Optional parameter to search all entried updated after a certain date. Date must be in form 'YYYY-MM-DD'.
-##' @param updated_before Optional parameter to search all entried updated before a certain date. Date must be in form 'YYYY-MM-DD'.
+##' @param created_before Optional parameter to search by creation date. Can be used in conjunction with created_after to specify a specific window. Date must be in form 'YYYY-MM-DD'.
+##' @param updated_after Optional parameter to search all entries updated after a certain date. Date must be in form 'YYYY-MM-DD'.
+##' @param updated_before Optional parameter to search all entries updated before a certain date. Date must be in form 'YYYY-MM-DD'.
 ##' @param con connection the the bety database
 ##'
 ##'
-##' @description This is a fucntion that returns a dataframe with all of the format entries that have no assosiated input records.
+##' @description This is a function that returns a dataframe with all of the format entries that have no associated input records.
 ##'
 ##' For more information on how to use this function see the "Pre-release-database-cleanup" script in the 'vignettes' folder
 ##' or look at the README

base/qaqc/R/find_inputs_without_formats.R

@@ -7,7 +7,7 @@
 ##' @param con connection the the bety database
 ##'
 ##'
-##' @description This is a function that returns a dataframe with all of the input entries that have no assosiated format records.
+##' @description This is a function that returns a dataframe with all of the input entries that have no associated format records.
 ##' This is very rare in the database.
 ##'
 ##' For more information on how to use this function see the "Pre-release-database-cleanup" script in the 'vignettes' folder

base/qaqc/R/get_table_column_names.R

@@ -1,38 +1,35 @@
 ##' get_table_column_names
 ##' @author Tempest McCabe
-##' 
-##' @param table a table that is output from one of the find_* functions, 
-##' or a data.frame containing the output from multiple find_* functions. Could also be a vector of table names. 
-##' @param con a connection to the bety database. 
-##' 
-##' 
-##' @description This function will return a vector of the column names for a given table(s) in the bety database. 
-##' Useful for choseing which columns to include in the written-out table. 
+##'
+##' @param table a table that is output from one of the find_* functions,
+##' or a data.frame containing the output from multiple find_* functions. Could also be a vector of table names.
+##' @param con a connection to the bety database.
+##'
+##'
+##' @description This function will return a vector of the column names for a given table(s) in the bety database.
+##' Useful for choosing which columns to include in the written-out table.
 ##'
 ##' For more information on how to use this function see the "Pre-release-database-cleanup" script in the 'vignettes' folder
 ##' or look at the README
 ##' @export
-get_table_column_names<-function(table, con){
-
-  if(is.data.frame(table)){
-    if("table_name" %in% names(table)){
-      table_factor<-as.factor(table$table_name)
-      table_name<-levels(table_factor)
-    }else{
+get_table_column_names <- function(table, con) {
+  if (is.data.frame(table)) {
+    if ("table_name" %in% names(table)) {
+      table_factor <- as.factor(table$table_name)
+      table_name <- levels(table_factor)
+    } else {
       PEcAn.logger::logger.severe("Table needs either a 'table_names' column or be a character vector of table names")
     }
-
-  }else if(is.vector(table)){
-    table_name<-table
-  }else{
+  } else if (is.vector(table)) {
+    table_name <- table
+  } else {
     PEcAn.logger::logger.severe("table must either be a dataframe or a vector")
   }
-  column_names<-list()
-  for(i in seq_along(table_name)){
-    query <- PEcAn.DB::db.query(paste("SELECT * from", table_name, "LIMIT 1"), con=con)
-    column_names[[i]]<-colnames(query)
-    names(column_names)<-table_name
-
+  column_names <- list()
+  for (i in seq_along(table_name)) {
+    query <- PEcAn.DB::db.query(paste("SELECT * from", table_name, "LIMIT 1"), con = con)
+    column_names[[i]] <- colnames(query)
+    names(column_names) <- table_name
   }
   return(column_names)
 }

base/qaqc/R/taylor.plot.R

@@ -1,7 +1,7 @@
 #-------------------------------------------------------------------------------
 # Copyright (c) 2012 University of Illinois, NCSA.
 # All rights reserved. This program and the accompanying materials
-# are made available under the terms of the 
+# are made available under the terms of the
 # University of Illinois/NCSA Open Source License
 # which accompanies this distribution, and is available at
 # http://opensource.ncsa.illinois.edu/license.html
@@ -20,7 +20,7 @@ new.taylor <- function(dataset, runid, siteid) {
       mod <- dataset[sitemask, paste0("model", run)]
       R <- stats::cor(obs, mod, use = "pairwise")
       sd.f <- stats::sd(mod)
-      lab  <- paste(paste0("model", run), paste0("site", si))
+      lab <- paste(paste0("model", run), paste0("site", si))
       if (run == runid[1] && si == siteid[1]) {
         plotrix::taylor.diagram(obs, mod, pos.cor = FALSE)
       } else {

base/qaqc/R/write_out_table.R

@@ -1,30 +1,29 @@
 ##' write_out_table
 ##' @author Tempest McCabe
-##' 
-##' @param table a table that is output from one of the find_* fucntions
+##'
+##' @param table a table that is output from one of the find_* functions
 ##' @param table_name name of table
 ##' @param outdir path to folder into which the editable table will be written
-##' @param relevant_table_columns a list of all columns to keep. ID and table name will be automatically included. 
-##' 
-##' 
-##' @description This is a fucntion that returns a dataframe with all of the format entries that have no assosiated input records.  
+##' @param relevant_table_columns a list of all columns to keep. ID and table name will be automatically included.
+##'
+##'
+##' @description This is a function that returns a dataframe with all of the format entries that have no associated input records.
 ##'
 ##' For more information on how to use this function see the "Pre-release-database-cleanup" script in the 'vignettes' folder
 ##' or look at the README
 ##' @export
-write_out_table<-function(table,table_name,outdir, relevant_table_columns){
-
-  if(!"id" %in% relevant_table_columns){
-    relevant_table_columns<-c(relevant_table_columns, "id")
+write_out_table <- function(table, table_name, outdir, relevant_table_columns) {
+  if (!"id" %in% relevant_table_columns) {
+    relevant_table_columns <- c(relevant_table_columns, "id")
   }
-  if(!"table_name" %in% relevant_table_columns){
-    relevant_table_columns<-c(relevant_table_columns, "id", "table_name")
+  if (!"table_name" %in% relevant_table_columns) {
+    relevant_table_columns <- c(relevant_table_columns, "table_name")
   }
-  if(!any(c("id", "table_name") %in% names(table))){
+  if (!any(c("id", "table_name") %in% names(table))) {
     PEcAn.logger::logger.severe("table provided doesn't have a table_name or id column or both. ")
   }
-  
-  
-  table<-table[ , (relevant_table_columns)]
-  utils::write.table(table, file=paste(outdir,"/query_of_",table_name ,sep=""),row.names = FALSE,sep="|")
-}
+
+
+  table <- table[, (relevant_table_columns)]
+  utils::write.table(table, file = paste(outdir, "/query_of_", table_name, sep = ""), row.names = FALSE, sep = "|")
+}

base/qaqc/tests/testthat/test.cull_database_entries.R

@@ -0,0 +1,25 @@
+test_that("`cull_database_entries()` gives errors for faulty inputs",{
+  expect_error(
+    cull_database_entries(outdir = 'test'),
+    "If a table object hasn't been provided, a file_name must be set."
+  )
+  expect_error(
+    cull_database_entries(table = 'test_table', file_name = 'test_file', outdir = 'test'),
+    "table and file_name cannot both be provided."
+  )
+  expect_error(
+    cull_database_entries(table = 'test_table', outdir = 'test'),
+    "Please provide a table_name"
+  )
+})
+
+test_that("`cull_database_entries()` able to correctly add logs to the output file", {
+  withr::with_dir(tempdir(), {
+    mockery::stub(cull_database_entries, 'PEcAn.DB::db.query', 'test_log')
+    dir <- getwd()
+    cull_database_entries(table = data.frame(id = 1), table_name = 'test', con = 1, outdir = dir)
+    expect_true(file.exists(paste0(dir, "/deletion_log_of_test")))
+    file_data <- readLines(paste0(dir, "/deletion_log_of_test"))
+    expect_equal(grepl("test_log", file_data), c(TRUE, TRUE))
+  })
+})

base/qaqc/tests/testthat/test.find_formats_without_inputs.R

@@ -0,0 +1,14 @@
+test_that("`find_formats_without_inputs()` able to find formats with no input record",{
+  format_command_mock <- data.frame(user_id = '2020', created_at = '2001-01-01', updated_at = '2010-01-01')
+  input_command_mock <- data.frame(format_id = '2000', user_id = '2021', created_at = '2002-01-02', updated_at = '2012-01-02')
+  mocked_res <- mockery::mock(input_command_mock, format_command_mock)
+  mockery::stub(find_formats_without_inputs, 'dplyr::tbl', mocked_res)
+
+  res <- find_formats_without_inputs(
+    con = NULL, user_id_code = '2020', created_after = '2000-01-01', updated_after = '2009-01-01', created_before = '2002-01-01', updated_before = '2011-01-01'
+  )
+  expect_equal(
+    res, 
+    data.frame(id = '2020', created_at = '2001-01-01', updated_at = '2010-01-01', table_name = "formats")
+  )
+})

base/qaqc/tests/testthat/test.find_inputs_without_formats.R

@@ -0,0 +1,13 @@
+test_that("`find_inputs_without_formats()` able to find inputs with no format records", {
+  input_command_mock <- data.frame(format_id = '2020', user_id = '2020', created_at = '2001-01-01', updated_at = '2010-01-01')
+  format_command_mock <- data.frame(user_id = '2021', created_at = '2002-01-02', updated_at = '2012-01-02')
+  mocked_res <- mockery::mock(input_command_mock, format_command_mock)
+  mockery::stub(find_inputs_without_formats, 'dplyr::tbl', mocked_res)
+  res <- find_inputs_without_formats(
+    con = NULL, user_id = '2020', created_after = '2000-01-01', updated_after = '2009-01-01', created_before = '2002-01-01', updated_before = '2011-01-01'
+  )
+  expect_equal(
+    res, 
+    data.frame(id = '2020', user_id = '2020',created_at = '2001-01-01', updated_at = '2010-01-01', table_name = "inputs")
+  )
+})

base/qaqc/tests/testthat/test.get_table_column_names.R

@@ -0,0 +1,8 @@
+test_that("`get_table_column_names()` able to return the column names of a table as a list",{
+  mocked_res <- mockery::mock(data.frame(head1 = 1, head2 = 2))
+  mockery::stub(get_table_column_names, 'PEcAn.DB::db.query', mocked_res)
+  res <- get_table_column_names(table = data.frame(table_name = 'test_table'), con = 1)
+  args <- mockery::mock_args(mocked_res)
+  expect_equal(args[[1]][[1]], "SELECT * from test_table LIMIT 1")
+  expect_equal(res, list(test_table = c("head1", "head2")))
+})

base/qaqc/tests/testthat/test.write_out_table.R

@@ -0,0 +1,11 @@
+test_that("`write_out_table()` able to create and update output file with relevant data",{
+  withr::with_dir(tempdir(), {
+    dir <- getwd()
+    write_out_table(
+      table = data.frame(id = 1, table_name = 'test'), table_name = 'test', relevant_table_columns = c(), outdir = dir
+    )
+    expect_true(file.exists(paste0(dir, "/query_of_test")))
+    file_data <- readLines(paste0(dir, "/query_of_test"))
+    expect_equal(grepl("test", file_data), c(FALSE, TRUE))
+  })
+})

base/remote/DESCRIPTION

@@ -25,6 +25,7 @@ Imports:
 Suggests:
     doSNOW,
     getPass,
+    mockery,
     testthat,
     tools,
     withr

base/remote/tests/testthat/test.check_model_run.R

@@ -0,0 +1,10 @@
+test_that("`check_model_run()` gives correct output for the passed `out` value",{
+  # failure
+  expect_error(
+    check_model_run(c("ERROR IN MODEL RUN")), 
+    "Model run aborted with the following error:\nERROR IN MODEL RUN"
+  )
+
+  # success
+  expect_equal(check_model_run(c("SUCCESS")), TRUE)
+})

base/remote/tests/testthat/test.kill.tunnel.R

@@ -0,0 +1,20 @@
+test_that("`kill.tunnel()` able to read the correct files and log the correct messages to kill tunnel for exe and data", {
+  withr::with_dir(tempdir(), {
+    mockery::stub(kill.tunnel, 'tools::pskill', TRUE)
+    mockery::stub(kill.tunnel, 'dirname', getwd())
+
+    # Kill tunnel to executable
+    settings <- list(host = list(tunnel = getwd()))
+    file_path <- file.path(getwd(), "pid")
+    file.create(file_path)
+    writeLines("1234", file_path)
+    expect_output(kill.tunnel(settings), "Killing tunnel with PID 1234")
+
+    # Kill tunnel to data
+    settings <- list(host = list(data_tunnel = getwd()))
+    file_path <- file.path(getwd(), "pid")
+    file.create(file_path)
+    writeLines("3456", file_path)
+    expect_output(kill.tunnel(settings), "Killing tunnel with PID 3456")
+  })
+})