Added test and corrected for deletion of classification on re-upload

R/add_history_record.R

@@ -1,14 +1,13 @@
 add_history_record_if_required = function(min_hours_since = 1) {
   latest_hist = latest_history_date()
   if (is.null(latest_hist) || is.na(latest_hist)) {
-    log_it(glue("Initial history added", TRUE))
+    log_it(glue("Initial history added"), TRUE)
     add_history_record()
     return(-1)
   }
   latest_hist = as.POSIXlt(latest_hist, format = "%Y-%m-%dT%H:%M")
   hours_since = round(as.numeric(
     difftime(as.POSIXlt(Sys.time()), latest_hist, units = "hours")))
-  # TODO: remove this when checked
   # log_it(glue("{hours_since} hours since last history update"))
   if (hours_since >= min_hours_since) {
     log_it(glue("Updated history after {hours_since} hours"))

R/global_functions.R

@@ -107,7 +107,7 @@ log_it = function(msg, force_console = FALSE, severity = "info") {
   tm = as.POSIXlt(Sys.time(), "UTC")
   force_console = force_console || g$config$force_console
   if (force_console || (!is.null(g$config) && is.list(g$config) && g$config$force_console))
-    cat(file = stderr(), msg, "\n")
+    cat(file = stderr(), "\n", msg, "\n")
   if (!is.null(g$pool) && DBI::dbIsValid(g$pool)) {
     op <- options(digits.secs = 2)
     iso = strftime(tm , tz = "Europe/Berlin", "%Y-%m-%d %H:%M:%OS")
@@ -222,3 +222,8 @@ tryCatch.W.E <- function(expr)
     warning = w.handler), warning = W)
 }
 
+n_classifications = function() {
+  q = "SELECT COUNT() as n from classification as n"
+  dbGetQuery(g$pool, q)$n
+}
+

R/record_cache.R

@@ -42,6 +42,7 @@ record_cache = function(file, max_p, time_zoom,  test_hook = NULL) {
     return(files)
   }
   # One file is missing or test_hook exists: remove all cached files
+  log_it(paste("Created cache for", basename(file)))
   unlink(cache_file)
   unlink(png_hrm_file)
   unlink(png_line_file)

R/record_to_database.R

@@ -18,23 +18,24 @@ record_to_database = function(file, markers, time_step){
       return(NULL)
     }
   }
+  log_it(paste("Record to database", basename(file)))
   # REPLACE if record is already there
   anon_h = anon_from_record(record, "h")
   anon_l = anon_from_record(record, "l")
   # The following is required to avoid loosing classifications
-  dbExecute(g$pool, "BEGIN TRANSACTION")
   dbExecute(g$pool, "PRAGMA FOREIGN_KEYS=OFF")
+  dbExecute(g$pool, "BEGIN TRANSACTION")
   ins_q = glue_sql(
     "INSERT OR REPLACE INTO record (record, anon_h, anon_l, file_mtime, timestep) ",
     "VALUES({record},{anon_h},{anon_l},{file_mtime},{time_step})", .con = g$pool)
   dbExecute(g$pool, ins_q)
-  dbExecute(g$pool, "PRAGMA FOREIGN_KEYS=ON")
   dbExecute(g$pool, "COMMIT")
+  dbExecute(g$pool, "PRAGMA FOREIGN_KEYS=ON")
   log_it(ins_q, force_console = force_console)
   del_sql = glue_sql("DELETE from marker where record = {record}",
                      .con = g$pool)
   deleted_markers = dbExecute(g$pool, del_sql)
-  log_it(glue("{deleted_markers} markers were deleted"), force_console = force_console)
+  #log_it(glue("{deleted_markers} markers were deleted"), force_console = force_console)
   for (i in 1:nrow(markers)) {
     ins_q = glue_sql(
       "INSERT INTO marker (record, sec, indx, annotation) VALUES(",
@@ -43,7 +44,7 @@ record_to_database = function(file, markers, time_step){
 #    log_it(ins_q)
     dbExecute(g$pool, ins_q)
   }
-  log_it(glue("Inserted {record} with {nrow(markers)} markers"),
+  log_it(glue("Inserted {record} with {nrow(markers)} markers, deleted {deleted_markers}"),
          force_console = force_console)
 }
 

tests/testthat/test_database.R

@@ -5,11 +5,6 @@ withr::defer(cleanup_test_data())
 valid_fa = c("fa-battery-2", "fa-battery-1", "fa-battery-3",
   "fa-question", "fa-flag-checkered", "fa-check")
 
-n_classifications = function() {
-  q = "SELECT COUNT() as n from classification as n"
-  dbGetQuery(g$pool, q)$n
-}
-
 test_that("timestamp is updated when classification is saved and no data deleted",{
   # This is an unsaved record
   ret = classification_from_database("x_bertha", "test1", 'l', "tone", 0.17)

tests/testthat/test_record_to_database.R

@@ -2,16 +2,15 @@ Sys.setenv("R_CONFIG_ACTIVE" = "test")
 globals()
 withr::defer(cleanup_test_data())
 
-
-test_that("Examples are not overwritten", {
+test_that("Examples and classifications are not overwritten", {
   file = "test1.txt"
   markers = tibble::tribble(
     ~sec, ~index, ~annotation,
     1, 1, "Squeeze",
     2, 2, "RAIR"
   )
   time_step = 0.15
-
+  n_classifications_1 = n_classifications()
   record = file_path_sans_ext(file)
   sql_markers = glue_sql(
     "SELECT COUNT() as n_markers from marker where record = {record}",
@@ -21,6 +20,8 @@ test_that("Examples are not overwritten", {
 
   # Write with new markers
   record_to_database(file, markers, time_step)
+  n_classifications_2 = n_classifications()
+  expect_equal(n_classifications_1, n_classifications_2)
   # check if time_step was updated, others should be same
   sql = "SELECT timestep from record where record = 'test1'"
   expect_equal(as.numeric(dbGetQuery(g$pool, sql)), time_step)
@@ -41,6 +42,8 @@ test_that("Examples are not overwritten", {
   expect_equal(test1_rec$anon_h, '$ex1')
   expect_equal(test1_rec$anon_l, '$ex1')
   expect_equal(test1_rec$timestep, time_step)
+  n_classifications_3 = n_classifications()
+  expect_equal(n_classifications_1, n_classifications_3)
 })