Merge pull request #118 from surveydown-dev/db-pages

Db pages
surveydown-dev · Oct 10, 2024 · ac17f7d · ac17f7d
2 parents 3321bc9 + 1add1d7
commit ac17f7d
Show file tree

Hide file tree

Showing 3 changed files with 26 additions and 15 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,8 @@
 # surveydown (development version)
 
+- The database updating is simplified to only write to the database on each page turn and after the survey closes.
+- Bug fix: if you added new questions or values to the survey after creating the initial database table, those new values would not have been added to the table. Now they are added.
+
 # surveydown 0.3.4
 
 - Bug fix: reactive questions now work with show_if conditions too

diff --git a/R/db.R b/R/db.R
@@ -244,12 +244,22 @@ database_uploading <- function(data_list, db, table, changed_fields) {
     if(is.null(db)) {
         return(warning("Databasing is not in use"))
     }
-
     tryCatch({
         pool::poolWithTransaction(db, function(conn) {
             # Get the actual columns in the table
             existing_cols <- DBI::dbListFields(conn, table)
 
+            # Check for new fields
+            new_fields <- setdiff(names(data_list), existing_cols)
+            if (length(new_fields) > 0) {
+                # Add new fields to the table
+                for (field in new_fields) {
+                    DBI::dbExecute(conn, sprintf('ALTER TABLE "%s" ADD COLUMN "%s" TEXT', table, field))
+                }
+                # Update existing_cols
+                existing_cols <- c(existing_cols, new_fields)
+            }
+
             # Filter data_list to only include existing columns and changed fields
             data_list <- data_list[names(data_list) %in% c("session_id", intersect(changed_fields, existing_cols))]
 

diff --git a/R/server.R b/R/server.R
@@ -174,9 +174,11 @@ sd_server <- function(
         }
     }
 
-    update_data <- function(data_list, changed_fields = NULL, time_last = FALSE) {
-        if (length(changed_fields) == 0) {
-            changed_fields = names(data_list)
+    update_data <- function(time_last = FALSE) {
+        data_list <- latest_data()
+        fields <- changed_fields()
+        if (length(fields) == 0) {
+            fields = names(data_list)
         }
         if (time_last) {
             data_list[['time_end']] <- get_utc_timestamp()
@@ -197,7 +199,7 @@ sd_server <- function(
                 message("Running in a non-writable environment.")
             }
         } else {
-            database_uploading(data_list, db$db, db$table, changed_fields)
+            database_uploading(data_list, db$db, db$table, fields)
         }
         # Reset changed_fields after updating the data
         changed_fields(character(0))
@@ -249,14 +251,8 @@ sd_server <- function(
         data[names(data) != ""]
     })
 
-    # Observer to update the data upon any change in the data
-    observe({
-        data <- latest_data()
-        update_data(data, changed_fields())
-    })
-
     # Reactive value to track which fields have changed
-    changed_fields <- shiny::reactiveVal(character(0))
+    changed_fields <- shiny::reactiveVal(names(initial_data))
 
     # Main question observers ----
     # (one created for each question)
@@ -350,6 +346,9 @@ sd_server <- function(
 
               # Update tracker of which fields changed
               changed_fields(c(changed_fields(), next_ts_id))
+
+              # Update data
+              update_data()
             } else if (!is.null(next_page_id)) {
               shinyWidgets::sendSweetAlert(
                 session = session,
@@ -414,7 +413,7 @@ sd_server <- function(
       changed_fields(c(changed_fields(), 'exit_survey_rating'))
       # Update data immediately
       isolate({
-        update_data(latest_data(), time_last = TRUE)
+        update_data(time_last = TRUE)
       })
       # Close the modal and the window
       removeModal()
@@ -430,10 +429,9 @@ sd_server <- function(
     # Ensure final update on session end
     shiny::onSessionEnded(function() {
         shiny::isolate({
-            update_data(latest_data(), time_last = TRUE)
+            update_data(time_last = TRUE)
         })
     })
-
 }
 
 #' Define skip conditions for survey pages