Call glue::glue_sql() in dbSelect() and dbUpdate()

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: riskassessment
 Title: A web app designed to interface with the `riskmetric` package
-Version: 0.1.1.9013
+Version: 0.1.1.9014
 Authors@R: c( 
     person("Aaron", "Clark", role = c("aut", "cre"), email = "[email protected]"),
     person("Robert", "Krajcik", role = "aut", email = "[email protected]"),

NAMESPACE

@@ -33,6 +33,7 @@ importFrom(formattable,formatter)
 importFrom(formattable,icontext)
 importFrom(formattable,style)
 importFrom(glue,glue)
+importFrom(glue,glue_sql)
 importFrom(golem,activate_js)
 importFrom(golem,add_resource_path)
 importFrom(golem,bundle_resources)

NEWS.md

@@ -13,6 +13,7 @@
 * Improved speed of inserting community metrics into database (#516)
 * Fix button alignment issues (#514)
 * Re-position filter to be at the bottom of the visible page (#518)
+* Utilized `glue::glue_sql()` inside of update and select functions (#520)
 
 # riskassessment 0.1.1
 

R/mod_addComment.R

@@ -62,13 +62,11 @@ addCommentServer <- function(id, metric_abrv, user_name, user_role, pkg_name) {
         # if(str_count(string = comment, pattern = "'") != 0)
         #   validate("Invalid character: comments cannot contain single
         #            quotes (')")
-
-        comment <- stringr::str_replace_all(comment, "'", "''")
 
-        dbUpdate(glue::glue(
-        "INSERT INTO comments values('{pkg_name()}', '{user_name()}', 
-        '{user_role()}', '{comment}', '{metric_abrv}',
-        '{getTimeStamp()}')")
+        dbUpdate(
+        "INSERT INTO comments values({pkg_name()}, {user_name()}, 
+        {user_role()}, {comment}, {metric_abrv},
+        {getTimeStamp()})"
         )
 
         updateTextAreaInput(session, "add_comment", value = "")

R/mod_decision_automation.R

@@ -549,7 +549,7 @@ mod_decision_automation_server <- function(id, user){
 
       out_lst <- purrr::compact(reactiveValuesToList(auto_decision))
       dbUpdate("UPDATE decision_categories SET lower_limit = NULL, upper_limit = NULL")
-      purrr::iwalk(out_lst, ~ dbUpdate(glue::glue("UPDATE decision_categories SET lower_limit = {.x[1]}, upper_limit = {.x[2]} WHERE decision = '{.y}'")))
+      purrr::iwalk(out_lst, ~ dbUpdate("UPDATE decision_categories SET lower_limit = {.x[1]}, upper_limit = {.x[2]} WHERE decision = {.y}"))
       auto_decision_update(out_lst)
 
       if (length(out_lst) == 0) {
@@ -574,7 +574,7 @@ mod_decision_automation_server <- function(id, user){
         purrr::map_chr(~ input[[glue::glue("{risk_lbl(.x, input = FALSE)}_col_2")]]) %>%
         purrr::set_names(decision_lst)
       purrr::iwalk(selected_colors, ~ {
-        dbUpdate(glue::glue("UPDATE decision_categories SET color = '{.x}' WHERE decision = '{.y}'"))
+        dbUpdate("UPDATE decision_categories SET color = {.x} WHERE decision = {.y}")
         shinyjs::runjs(glue::glue("document.documentElement.style.setProperty('--{risk_lbl(.y, input = FALSE)}-color', '{.x}');"))
         })
       loggit::loggit("INFO", glue::glue("The decision category display colors were modified by {user$name} ({user$role})"))

R/mod_decision_automation_utils.R

@@ -11,18 +11,18 @@
 assign_decisions <- function(decision_list, package) {
   score <- get_pkg_info(package)$score
   decision <- paste0(names(decision_list)[purrr::map_lgl(decision_list, ~ .x[1] < score && score <= .x[2])], "")
-  decision_id <- dbSelect(glue::glue("SELECT id FROM decision_categories WHERE decision = '{decision}'"))
+  decision_id <- dbSelect("SELECT id FROM decision_categories WHERE decision = {decision}")
   if (decision != "") {
-    dbUpdate(glue::glue("UPDATE package SET decision_id = '{decision_id}',
-                        decision_by = 'Auto Assigned', decision_date = '{Sys.Date()}'
-                         WHERE name = '{package}'"))
+    dbUpdate("UPDATE package SET decision_id = {decision_id},
+                        decision_by = 'Auto Assigned', decision_date = {Sys.Date()}
+                         WHERE name = {package}")
     loggit::loggit("INFO",
                    glue::glue("decision for the package {package} was assigned {decision} by decision automation rules"))
-    comment <- glue::glue("Decision was assigned ''{decision}'' by decision rules because the risk score was between {decision_list[[decision]][1]} and {decision_list[[decision]][2]}")
-    dbUpdate(glue::glue(
+    comment <- glue::glue("Decision was assigned '{decision}' by decision rules because the risk score was between {decision_list[[decision]][1]} and {decision_list[[decision]][2]}")
+    dbUpdate(
       "INSERT INTO comments
-          VALUES ('{package}', 'Auto Assigned', 'admin',
-          '{comment}', 'o', '{getTimeStamp()}')"))
+          VALUES ({package}, 'Auto Assigned', 'admin',
+          {comment}, 'o', {getTimeStamp()})")
   }
 
   return(decision)

R/mod_downloadHandler.R

@@ -101,7 +101,7 @@ mod_downloadHandler_server <- function(id, pkgs, user, metric_weights){
           report_datetime <- stringr::str_replace_all(stringr::str_replace(Sys.time(), " ", "_"), ":", "-")
           glue::glue('RiskAssessment-Report-{report_datetime}.zip')
         } else {
-          pkg_ver <- dbSelect(glue::glue("SELECT version FROM package WHERE name = '{pkgs()}'"))
+          pkg_ver <- dbSelect("SELECT version FROM package WHERE name = {pkgs()}")
           glue::glue('{pkgs()}_{pkg_ver}_Risk_Assessment.{input$report_format}')
         }
       },

R/mod_reportPreview.R

@@ -251,13 +251,10 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics,
           )
         ))
       } else { # first summary!
-        comment <- stringr::str_replace_all(current_summary, "'", "''")
-        dbUpdate(glue::glue(
+        dbUpdate(
           "INSERT INTO comments
-          VALUES ('{selected_pkg$name()}', '{user$name}', '{user$role}',
-          '{comment}', 's', '{getTimeStamp()}')"))
-        # updateTextAreaInput(session, "pkg_summary", value = "",
-        #                     placeholder = glue::glue('Current Summary: \n{current_summary}'))
+          VALUES ({selected_pkg$name()}, {user$name}, {user$role},
+          {current_summary}, 's', {getTimeStamp()})")
         showModal(modalDialog(
           title = h2("Summary Submitted"),
           br(),
@@ -277,17 +274,13 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics,
 
       req(selected_pkg$name())
 
-      comment <- stringr::str_replace_all(input$pkg_summary, "'", "''")
-
       dbUpdate(
-        glue::glue(
           "UPDATE comments
-          SET comment = '{comment}', added_on = '{getTimeStamp()}'
-          WHERE id = '{selected_pkg$name()}' AND
-          user_name = '{user$name}' AND
-          user_role = '{user$role}' AND
+          SET comment = {input$pkg_summary}, added_on = {getTimeStamp()}
+          WHERE id = {selected_pkg$name()} AND
+          user_name = {user$name} AND
+          user_role = {user$role} AND
           comment_type = 's'"
-        )
       )
 
       # disable text editor and flip button to "edit"

R/mod_reweightView.R

@@ -289,16 +289,11 @@ reweightViewServer <- function(id, user, decision_list) {
         # insert comment for both mm and cum tabs
         for (typ in c("mm","cum")) {
           dbUpdate(
-            paste0(
-              "INSERT INTO comments values('", all_pkgs$pkg_name[i], "',",
-              "'", user$name, "'," ,
-              "'", user$role, "',",
-              "'", paste0(weight_risk_comment(all_pkgs$pkg_name[i]), 
-                          ifelse(all_pkgs$pkg_name[i] %in% cmt_or_dec_pkgs$pkg_name, cmt_or_dec_dropped_cmt, "")), "',",
-              "'", typ, "',",
-              "'", getTimeStamp(), "'" ,
-              ")"
-            )
+            'INSERT INTO comments
+            VALUES({all_pkgs$pkg_name[i]}, {user$name}, {user$role},
+            {paste0(weight_risk_comment(all_pkgs$pkg_name[i]), 
+                          ifelse(all_pkgs$pkg_name[i] %in% cmt_or_dec_pkgs$pkg_name, cmt_or_dec_dropped_cmt, ""))},
+            {typ}, {getTimeStamp()})'
           )
         }
       }
@@ -307,7 +302,7 @@ reweightViewServer <- function(id, user, decision_list) {
       pkg <- dbSelect("SELECT DISTINCT name AS pkg_name FROM package WHERE decision_id IS NOT NULL")
       if (nrow(pkg) > 0) {
         for (i in 1:nrow(pkg)) {
-          dbUpdate(glue::glue("UPDATE package SET decision_id = NULL where name = '{pkg$pkg_name[i]}'"))
+          dbUpdate("UPDATE package SET decision_id = NULL where name = {pkg$pkg_name[i]}")
         }
       }
 
@@ -322,9 +317,9 @@ reweightViewServer <- function(id, user, decision_list) {
         shinyjs::runjs("$('<br>').insertAfter('.progress-message');")
         for (i in 1:nrow(pkg)) {
           incProgress(1 / (nrow(pkg) + 1), detail = pkg$pkg_name[i])
-          dbUpdate(glue::glue(
+          dbUpdate(
             "DELETE FROM package_metrics WHERE package_id = 
-            (SELECT id FROM package WHERE name = '{pkg$pkg_name[i]}')") )
+            (SELECT id FROM package WHERE name = {pkg$pkg_name[i]})")
           # metric_mm_tm_Info_upload_to_DB(pkg$pkg_name[i])
           insert_riskmetric_to_db(pkg$pkg_name[i])
           if (!rlang::is_empty(decision_list())) {

R/mod_sidebar.R

@@ -185,10 +185,10 @@ sidebarServer <- function(id, user, uploaded_pkgs) {
       }
       else {
         # Display package comments if a package and version are selected.
-        comments <- dbSelect(glue::glue(
+        comments <- dbSelect(
           "SELECT comment FROM comments
-          WHERE id = '{input$select_pkg}'
-          AND comment_type = 'o'"))$comment
+          WHERE id = {input$select_pkg}
+          AND comment_type = 'o'")$comment
 
         updateTextAreaInput(session, "overall_comment",
                             placeholder = glue::glue('Current Overall Comment: {comments}'))
@@ -228,11 +228,10 @@ sidebarServer <- function(id, user, uploaded_pkgs) {
           )
         ))
       } else {
-        comment <- stringr::str_replace_all(current_comment, "'", "''")
-        dbUpdate(glue::glue(
+        dbUpdate(
           "INSERT INTO comments
-          VALUES ('{selected_pkg$name}', '{user$name}', '{user$role}',
-          '{comment}', 'o', '{getTimeStamp()}')"))
+          VALUES ({selected_pkg$name}, {user$name}, {user$role},
+          {current_comment}, 'o', {getTimeStamp()})")
 
         updateTextAreaInput(session, "overall_comment", value = "",
                             placeholder = glue::glue('Current Comment: {current_comment}'))
@@ -250,18 +249,14 @@ sidebarServer <- function(id, user, uploaded_pkgs) {
     observeEvent(input$submit_overall_comment_yes, {
 
       req(selected_pkg$name)
-
-      comment <- stringr::str_replace_all(input$overall_comment, "'", "''")
 
       dbUpdate(
-        glue::glue(
           "UPDATE comments
-          SET comment = '{comment}', added_on = '{getTimeStamp()}'
-          WHERE id = '{selected_pkg$name}' AND
-          user_name = '{user$name}' AND
-          user_role = '{user$role}' AND
+          SET comment = {input$overall_comment}, added_on = {getTimeStamp()}
+          WHERE id = {selected_pkg$name} AND
+          user_name = {user$name} AND
+          user_role = {user$role} AND
           comment_type = 'o'"
-        )
       )
       current_comment <- trimws(input$overall_comment)
       updateTextAreaInput(session, "overall_comment", value = "",
@@ -393,10 +388,9 @@ sidebarServer <- function(id, user, uploaded_pkgs) {
 
     # Update database info after decision is submitted.
     observeEvent(input$submit_confirmed_decision, {
-      dbUpdate(glue::glue(
-        "UPDATE package
-          SET decision_id = '{match(input$decision, golem::get_golem_options(\"decision_categories\"))}', decision_by = '{user$name}', decision_date = '{Sys.Date()}'
-          WHERE name = '{selected_pkg$name}'")
+      dbUpdate("UPDATE package
+          SET decision_id = {match(input$decision, golem::get_golem_options(\"decision_categories\"))}, decision_by = {user$name}, decision_date = {Sys.Date()}
+          WHERE name = {selected_pkg$name}"
       )
 
       selected_pkg$decision <- input$decision
@@ -414,16 +408,14 @@ sidebarServer <- function(id, user, uploaded_pkgs) {
     })
 
     observeEvent(input$reset_confirmed_decision, {
-      dbUpdate(glue::glue(
-        "UPDATE package
+      dbUpdate("UPDATE package
           SET decision_id = NULL, decision_by = '', decision_date = NULL
-          WHERE name = '{selected_pkg$name}'")
+          WHERE name = {selected_pkg$name}"
       )
       # remove overall comment for this package 
-      dbUpdate(glue::glue(
-        "delete from comments 
-           where comment_type = 'o'
-           and id in(select '{selected_pkg$name}' from package)"))
+      dbUpdate("DELETE FROM comments 
+           WHERE comment_type = 'o'
+           AND id IN (SELECT {selected_pkg$name} FROM package)")
 
       selected_pkg$decision <- NA_character_
 

R/mod_uploadPackage.R

@@ -209,8 +209,8 @@ uploadPackageServer <- function(id, user, auto_list) {
       for (i in 1:np) {
       pkg_name <- input$rem_pkg_lst[i]
       # update version with what is in the package table
-      uploaded_packages$version[i] <- dbSelect(glue::glue("select version from package where name = '{pkg_name}'"), db_name = golem::get_golem_options('assessment_db_name')) 
-      dbUpdate(glue::glue("delete from package where name = '{pkg_name}'"), db_name = golem::get_golem_options('assessment_db_name'))
+      uploaded_packages$version[i] <- dbSelect("select version from package where name = {pkg_name}", db_name = golem::get_golem_options('assessment_db_name')) 
+      dbUpdate("DELETE FROM package WHERE name = {pkg_name}", db_name = golem::get_golem_options('assessment_db_name'))
       }
 
       # clean up other db tables
@@ -362,10 +362,10 @@ uploadPackageServer <- function(id, user, auto_list) {
             incProgress(1, detail = deets)
             uploaded_packages$version[i] <- as.character(ref$version)
 
-            found <- nrow(dbSelect(glue::glue(
+            found <- nrow(dbSelect(
               "SELECT name
               FROM package
-              WHERE name = '{uploaded_packages$package[i]}'")))
+              WHERE name = {uploaded_packages$package[i]}"))
 
             uploaded_packages$status[i] <- ifelse(found == 0, 'new', 'duplicate')
 

R/utils_config_db.R

@@ -24,12 +24,12 @@ configure_db <- function(dbname, config) {
 
   dbUpdate(glue::glue("INSERT INTO decision_categories (decision) VALUES {paste0('(\\'', dec_config$categories, '\\')', collapse = ', ')}"), dbname)
   if (!is.null(dec_config$rules)) 
-    purrr::iwalk(dec_config$rules, ~ dbUpdate(glue::glue("UPDATE decision_categories SET lower_limit = {.x[1]}, upper_limit = {.x[length(.x)]} WHERE decision = '{.y}'"), dbname))
+    purrr::iwalk(dec_config$rules, ~ dbUpdate("UPDATE decision_categories SET lower_limit = {.x[1]}, upper_limit = {.x[length(.x)]} WHERE decision = {.y}", dbname))
   else
     message("No decision rules applied from configuration")
   col_lst <- set_colors(dec_config$categories)
   purrr::iwalk(dec_config$colors, ~ {col_lst[.y] <<- .x})
-  purrr::iwalk(col_lst, ~ dbUpdate(glue::glue("UPDATE decision_categories SET color = '{.x}' WHERE decision = '{.y}'"), dbname))
+  purrr::iwalk(col_lst, ~ dbUpdate("UPDATE decision_categories SET color = {.x} WHERE decision = {.y}", dbname))
 }
 
 check_decision_config <- function(dec_config) {