Fixes for NA in job tracking and missing start time in prefetch

Author: michaelhallquist

R/job_tracking_functions.R

@@ -408,12 +408,25 @@ update_tracked_job_status <- function(sqlite_db = NULL, job_id = NULL, status,
   if (cascade) {
     if (is.numeric(exclude)) exclude <- as.character(exclude)
 
-    status_tree <- get_tracked_job_status(job_id, return_children = TRUE, sqlite_db = sqlite_db) # retrieve current job and children
+    status_tree <- get_tracked_job_status(
+      job_id = job_id,
+      return_children = TRUE,
+      sqlite_db = sqlite_db
+    ) # retrieve current job and children
+    if (!is.data.frame(status_tree) || nrow(status_tree) == 0L) return(invisible(NULL))
     job_ids <- status_tree$job_id # get list of job ids
 
     for (child_job in setdiff(job_ids, c(job_id, exclude))) {
-      child_status <- with(status_tree, status[which(job_ids == child_job)]) # check status
-      if (child_status != "FAILED") update_tracked_job_status(child_job, sqlite_db = sqlite_db, status = "FAILED_BY_EXT", cascade = TRUE)
+      child_idx <- which(status_tree$job_id == child_job)
+      child_status <- if (length(child_idx) > 0L) status_tree$status[child_idx[1L]] else NA_character_ # check status
+      if (length(child_status) != 1L || is.na(child_status) || child_status != "FAILED") {
+        update_tracked_job_status(
+          sqlite_db = sqlite_db,
+          job_id = child_job,
+          status = "FAILED_BY_EXT",
+          cascade = TRUE
+        )
+      }
     }
   }
 

inst/hpc_scripts/prefetch_templates.pbs

@@ -67,6 +67,7 @@ for path in "${bind_paths[@]}"; do
 done
 
 log_message INFO "Prefetching TemplateFlow resources into $templateflow_home for spaces: $prefetch_spaces"
+start_time=$(date +%s)
 
 "${R_HOME}/bin/Rscript" "$upd_job_status_path" --job_id "$PBS_JOBID" --sqlite_db "$sqlite_db" --status "STARTED"
 

inst/hpc_scripts/prefetch_templates.sbatch

@@ -67,6 +67,7 @@ for path in "${bind_paths[@]}"; do
 done
 
 log_message INFO "Prefetching TemplateFlow resources into $templateflow_home for spaces: $prefetch_spaces"
+start_time=$(date +%s)
 
 "${R_HOME}/bin/Rscript" "$upd_job_status_path" --job_id "$SLURM_JOB_ID" --sqlite_db "$sqlite_db" --status "STARTED"
 

tests/testthat/test-job_tracking.R

@@ -382,6 +382,49 @@ test_that("job tracking cascade works for FAILED status", {
   expect_equal(child_result$status, "FAILED_BY_EXT")
 })
 
+test_that("job tracking cascade tolerates NA child status", {
+  db_file <- tempfile(fileext = ".sqlite")
+  on.exit(unlink(db_file), add = TRUE)
+
+  create_tracking_db(db_file)
+
+  insert_tracked_job(
+    sqlite_db = db_file,
+    job_id = "parent_na",
+    tracking_args = list(job_name = "parent", sequence_id = "seq_na")
+  )
+  insert_tracked_job(
+    sqlite_db = db_file,
+    job_id = "child_na",
+    tracking_args = list(job_name = "child", sequence_id = "seq_na")
+  )
+  add_tracked_job_parent(
+    sqlite_db = db_file,
+    job_id = "child_na",
+    parent_job_id = "parent_na",
+    child_level = 1
+  )
+
+  con <- DBI::dbConnect(RSQLite::SQLite(), db_file)
+  DBI::dbExecute(
+    con,
+    "UPDATE job_tracking SET status = NULL WHERE job_id = 'child_na'"
+  )
+  DBI::dbDisconnect(con)
+
+  expect_no_error(
+    update_tracked_job_status(
+      sqlite_db = db_file,
+      job_id = "parent_na",
+      status = "FAILED",
+      cascade = TRUE
+    )
+  )
+
+  child_result <- get_tracked_job_status(job_id = "child_na", sqlite_db = db_file)
+  expect_equal(child_result$status, "FAILED_BY_EXT")
+})
+
 test_that("get_tracked_job_status returns children when requested", {
   db_file <- tempfile(fileext = ".sqlite")
   on.exit(unlink(db_file), add = TRUE)