Merge pull request #101 from surveydown-dev/data-opt

v0.3.1

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: surveydown
 Title: Markdown-Based Surveys Using Quarto Shiny Documents
-Version: 0.3.0
+Version: 0.3.1
 Authors@R: c(
     person(given   = "John Paul",
            family  = "Helveston",

NEWS.md

@@ -1,8 +1,12 @@
 # surveydown (development version)
 
+# surveydown 0.3.1
+
+- Improved efficiency in `database_uploading()` so only the changed fields get written, and also the writing happens after checking the `show_if` conditions (addresses #100).
+- Modified default rendering behavior to not delete the rendered html file.
 - Modified the `refresh_interval` argument in `sd_get_data()` as defaulting to `NULL`, which means the data will not be reactively fetched, regardless of the context it is used in. The data will only continuously refresh if `sd_get_data()` is called within a reactive context and `refresh_interval > 0`.
 - Modified messaging from `sd_set_password()` to not print out user's password and provide clearer instructions.
-- `sd_show_password()` to show stored password. The user will be prompted to double confirm. If there is no password, the user will be prompted so, along with a message of using `sd_set_password()` to create the password.
+- `sd_show_password()` added to show a stored password. The user will be prompted to double confirm that they want to show it. If there is no password, the user will be prompted so, along with a message of using `sd_set_password()` to create the password.
 
 # surveydown 0.3.0
 

R/config.R

@@ -45,6 +45,11 @@ run_config <- function(
         stop("The specified start_page does not exist - check that you have not mis-spelled the id")
     }
 
+    # Set the start page
+    if (is.null(start_page)) {
+        start_page <- page_ids[1]
+    }
+
     # Check skip_if and show_if inputs
     check_skip_show(question_ids, question_values, page_ids, skip_if, show_if)
 
@@ -64,25 +69,8 @@ run_config <- function(
 }
 
 get_html_content <- function(survey_file) {
-    # Check if the file exists
-    if (!file.exists(survey_file)) {
-        stop("The specified survey file does not exist.")
-    }
-
-    # Get the file extension
-    file_ext <- tools::file_ext(survey_file)
-
-    # Process based on file type
-    if (file_ext == "qmd") {
-        temp_html <- quarto_render_temp(survey_file)
-        html_content <- rvest::read_html(temp_html)
-        unlink(temp_html)
-    } else if (file_ext == "html") {
-        html_content <- rvest::read_html(survey_file)
-    } else {
-        stop("Invalid file type. Please provide either a .qmd or .html file.")
-    }
-    return(html_content)
+    if (survey_file == 'survey.qmd') { quarto::quarto_render(survey_file) }
+    return(rvest::read_html('survey.html'))
 }
 
 extract_html_pages <- function(

R/db.R

@@ -219,72 +219,9 @@ create_table <- function(data_list, db, table) {
         DBI::dbExecute(conn, paste0('ALTER TABLE "', table, '" ENABLE ROW LEVEL SECURITY;'))
     })
 
-    message("Table created (or already exists) in your Supabase database.")
+    message(paste("Table", table, "created in the database."))
 }
 
-check_and_add_columns <- function(data_local, db, table) {
-    pool::poolWithTransaction(db, function(conn) {
-        existing_cols <- DBI::dbListFields(conn, table)
-        new_cols <- setdiff(names(data_local), existing_cols)
-        for (col in new_cols) {
-            r_type <- typeof(data_local[[col]])
-            sql_type <- r_to_sql_type(r_type)
-            query <- paste0('ALTER TABLE "', table, '" ADD COLUMN "', col, '" ', sql_type, ';')
-            DBI::dbExecute(conn, query)
-        }
-    })
-}
-
-# Less secure approach - vulnerable to SQL injection
-# database_uploading <- function(data_list, db, table) {
-#     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)
-#
-#             # Filter data_list to only include existing columns
-#             data_list <- data_list[names(data_list) %in% existing_cols]
-#
-#             # Prepare the update query
-#             cols <- names(data_list)
-#             update_cols <- setdiff(cols, "session_id")
-#
-#             # Create value string, properly escaping and quoting values
-#             values <- sapply(data_list, function(x) {
-#                 if (is.character(x)) {
-#                     paste0("'", gsub("'", "''", x), "'")
-#                 } else if (is.numeric(x)) {
-#                     as.character(x)
-#                 } else {
-#                     "NULL"
-#                 }
-#             })
-#             values_str <- paste(values, collapse = ", ")
-#
-#             update_set <- paste(sapply(update_cols, function(col) {
-#                 paste0('"', col, '" = EXCLUDED."', col, '"')
-#             }), collapse = ", ")
-#
-#             update_query <- paste0(
-#                 'INSERT INTO "', table, '" ("', paste(cols, collapse = '", "'), '") ',
-#                 'VALUES (', values_str, ') ',
-#                 'ON CONFLICT (session_id) DO UPDATE SET ',
-#                 update_set
-#             )
-#
-#             # Execute the query
-#             DBI::dbExecute(conn, update_query)
-#         })
-#     }, error = function(e) {
-#         warning("Error in database operation: ", e$message)
-#         print(e)  # Print the full error for debugging
-#     })
-# }
-
 # Solution found in this issue:
 # https://github.com/r-dbi/DBI/issues/193
 sqlInterpolateList <- function(conn, sql, vars=list(), list_vars=list()) {
@@ -303,7 +240,7 @@ sqlInterpolateList <- function(conn, sql, vars=list(), list_vars=list()) {
     DBI::sqlInterpolate(conn, sql, .dots=vars)
 }
 
-database_uploading <- function(data_list, db, table) {
+database_uploading <- function(data_list, db, table, changed_fields) {
     if(is.null(db)) {
         return(warning("Databasing is not in use"))
     }
@@ -313,8 +250,13 @@ database_uploading <- function(data_list, db, table) {
             # Get the actual columns in the table
             existing_cols <- DBI::dbListFields(conn, table)
 
-            # Filter data_list to only include existing columns
-            data_list <- data_list[names(data_list) %in% existing_cols]
+            # 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))]
+
+            # If there's nothing to update (only session_id), return early
+            if (length(data_list) <= 1) {
+                return()
+            }
 
             # Ensure session_id is the first column
             cols <- c("session_id", setdiff(names(data_list), "session_id"))