Error warning improvements

R/create_replace_table.R

@@ -44,7 +44,7 @@
 # Column in to load dataframe not compatible with existing SQL table
 mismatch_datatype_error <- function(compare_col_df) {
   incompatible_df <- compare_col_df[compare_col_df$col_issue
   == "incompatible", ]
   if (nrow(incompatible_df) > 0) {
     error_message <- glue::glue_collapse(glue::glue_data(
       incompatible_df,
@@ -197,7 +197,7 @@
 sql_versioned_table <- function(sql, db_params) {
   # To remove the trailing ); and replace with ,
   sql <- glue::glue_sql(substr(sql, 1, nchar(sql) - 2), ",")
   history_table <- quoted_schema_tbl(
     db_params$schema,
     glue::glue(db_params$table_name, "History")
   )
@@ -299,7 +299,7 @@
           "Failed to write staging",
           "data to database.\n", cond,
           .sep = " "
-        ))
+        ), call. = FALSE)
       }
     )
     message(glue::glue(
@@ -314,7 +314,7 @@
 
 create_insert_sql <- function(db_params, metadata_df) {
   metadata_df <- metadata_df[metadata_df$column_name !=
     paste0(db_params$table_name, "ID"), ]
 
   glue::glue_sql(
     "INSERT INTO ",
@@ -471,8 +471,11 @@
 }
 
 
-#' Write an R dataframe to SQL Server table optionally with system
-#' versioning on.
+#' Write an R dataframe to a SQL Server table
+#'
+#' Can create table optionally with system versioning on. However, extra
+#' permissions may be required to drop or overwrite
+#' system versioned tables so use this option with caution.
 #'
 #' @param server Server instance where SQL Server database running.
 #' @param database Name of SQL Server database where table will be written.
@@ -487,9 +490,11 @@
 #' @param batch_size Source R dataframe rows will be loaded into a staging SQL
 #'  Server table in batches of this many rows at a time.
 #' @param versioned_table Create table with SQL Server system versioning.
-#' Defaults to FALSE. If table already exists in DB will not
-#' change existing versioning status. If overwriting an existing table
-#' may receive permissions error to contact system admin.
+#' Defaults to FALSE. If appending to existing table will not
+#' change existing versioning status. If overwriting an existing
+#' versioned table may receive permissions error due to dropping existing
+#' versioned table failing. Contact a sysadmin to drop the
+#' versioned table for you.
 #'
 #' @importFrom utils tail
 #' @export
@@ -548,8 +553,8 @@
     # If not appending and exists then inform that will be overwritten
   } else {
     warning(glue::glue(
-      "Existing database table: {schema}.{table_name}",
-      "was over-written.",
+      "Database table: {schema}.{table_name} already exists",
+      "attempting to drop and replace it...",
       .sep = " "
     ), call. = FALSE)
     # Drop the existing table
@@ -575,6 +580,11 @@
 
   # Drop the staging table and finished
   delete_staging_table(db_params)
+  if (versioned_table) {
+    warning(glue::glue("Created {schema}.{table_name} as versioned table"),
+      call. = FALSE
+    )
+  }
   end_time <- Sys.time()
   message(glue::glue(
     "Loading completed in",

R/db_table_metadata.R

@@ -28,7 +28,7 @@ db_table_metadata <- function(server, database, schema, table_name) {
   )) {
     stop(glue::glue(
       "Table: {schema}.{table_name} does not exist in the database."
-    ))
+    ), call. = FALSE)
   }
   sql <- paste0("
                 SET NOCOUNT ON;

R/drop_table.R

@@ -10,7 +10,7 @@
 
 # create versioned table sql
 create_drop_sql_versioned <- function(schema, table_name) {
   history_table <- quoted_schema_tbl(schema, glue::glue(table_name, "History"))
   glue::glue_sql("ALTER TABLE {`quoted_schema_tbl(schema, table_name)`} ",
     "SET ( SYSTEM_VERSIONING = OFF );",
     "DROP TABLE {`quoted_schema_tbl(schema, table_name)`};",
@@ -45,28 +45,26 @@
     output = TRUE
   )
   if (is_versioned(check_df)) {
-    warning(glue::glue(
-      "Attempting to drop system versioned table.",
-      "If receive permissions error will need to",
-      "ask admin to drop this table for you mentioning",
-      "it is a temporal/system versioned table."
-    ))
     drop_sql <- create_drop_sql_versioned(schema, table_name)
   } else { # if not actually versioned:
     drop_sql <- create_drop_sql_nonversioned(schema, table_name)
   }
-  return(drop_sql)
+  return(list(drop_sql = drop_sql, versioned = is_versioned(check_df)))
 }
 
-#' Drop SQL Server table from database. Check if versioned table and disable
-#' versioning and drop history table too if so.
+#' Drop SQL Server table from database
+#'
+#' Drop specified table. Check if versioned table. If so attempt to disable
+#' versioning and drop history table too if so. Extra permissions may be
+#' required to drop a versioned table so contact system admin if
+#' receive an error showing this is the case.
 #'
 #' @param server Server and instance where SQL Server database found.
 #' @param database Database containing the table to be dropped.
 #' @param schema Name of schema containing table to be dropped.
 #' @param table_name Name of the table to be dropped.
-#' @param versioned_table Is this a versioned table. Legacy parameter no
-#' longer used as this is now checked every time.
+#' @param versioned_table Is this a versioned table. Legacy argument no
+#' longer used. This is now checked every time regardless of T or F input.
 #' @param silent If TRUE do not give message that dropping complete.
 #' Defaults to FALSE.
 #'
@@ -108,12 +106,29 @@
   )
 
   # Run drop sql
-
-  execute_sql(
-    server,
-    database,
-    drop_sql,
-    output = FALSE
+  tryCatch(
+    {
+      execute_sql(
+        server,
+        database,
+        drop_sql$drop_sql,
+        output = FALSE
+      )
+    },
+    error = function(cond) {
+      if (drop_sql$versioned) {
+        cond$message <- glue::glue(
+          "{cond$message}\n\n",
+          "{schema}.{table_name} is a VERSIONED TABLE.\n\n",
+          "Contact a system admin to request that they drop this versioned ",
+          "table for you as you do not have sufficient permissions.",
+        )
+      } else {
+        cond$message <- glue::glue("Error dropping table: {cond}")
+      }
+      cond$call <- NULL
+      stop(cond)
+    }
   )
 
   # Output message if required

R/execute_sql.R

@@ -23,30 +23,25 @@ execute_sql <- function(server, database, sql, output = FALSE) {
     server = server,
     database = database
   )
-  if (output) {
-    tryCatch(
-      {
+
+  tryCatch(
+    {
+      if (output) {
         output_data <- DBI::dbGetQuery(connection, sql)
-      },
-      error = function(cond) {
-        stop(glue::glue(
-          "Failed to execute SQL.\nODBC error message: {cond}"
-        ))
-      }
-    )
-  } else {
-    tryCatch(
-      {
+      } else {
         DBI::dbExecute(connection, sql)
         output_data <- glue::glue("SQL: {sql}\nexecuted successfully")
-      },
-      error = function(cond) {
-        stop(glue::glue(
-          "Failed to execute SQL.\nODBC error message: {cond}"
-        ))
       }
-    )
-  }
-  DBI::dbDisconnect(connection)
+    },
+    error = function(cond) {
+      stop(glue::glue(
+        "Failed to execute SQL. ODBC error message:\n{cond$message}"
+      ), call. = FALSE)
+    },
+    finally = {
+      DBI::dbDisconnect(connection)
+    }
+  )
+
   return(output_data)
 }

R/read_table.R

@@ -23,14 +23,14 @@
     if (length(not_exist_cols) > 0) {
       stop(glue::glue(
         "Column {not_exist_cols} not found in {schema}.{table_name}."
-      ))
+      ), call. = FALSE)
     } else {
       return(columns)
     }
 
     # where no user specified list of columns
   } else {
-    if (!include_pk & !is.null(pk)) {
+    if (!include_pk && !is.null(pk)) {
       return(existing_cols[existing_cols != pk])
     } else {
       return(existing_cols)
@@ -65,7 +65,7 @@
   if (cast_datetime2) {
     # Need to know the datetime2 cols to cast them
     datetime2_cols_to_cast <- table_metadata[table_metadata$data_type ==
       "datetime2", "column_name"]
     if (length(datetime2_cols_to_cast) == 0) {
       datetime2_cols_to_cast <- NULL
     }
@@ -86,7 +86,7 @@
                             table_metadata,
                             filter_stmt,
                             cast_datetime2) {
   column_sql <- cols_select_format(select_list, table_metadata, cast_datetime2)
 
   initial_sql <- glue::glue_sql(
     "SELECT {column_sql} FROM {`quoted_schema_tbl(schema, table_name)`}",
@@ -163,7 +163,7 @@
   )) {
     stop(glue::glue(
       "Table: {schema}.{table_name} does not exist in the database."
-    ))
+    ), call. = FALSE)
   }
 
   # Use a genuine connection, so the filter translation SQL is correct

R/utils.R

@@ -16,7 +16,7 @@
         "{database} on server: {server}",
         "\n{cond}",
         .sep = " "
-      ))
+      ), call. = FALSE)
     }
   )
 }
@@ -98,8 +98,8 @@
   } else if (existing_col_type == to_load_col_type) {
     return("compatible")
   } else if (!(grepl("nvarchar", existing_col_type) &&
     grepl("nvarchar", to_load_col_type)
   )) {
     return("incompatible")
   } else {
     # Extract the nvarchar column size, e.g. 255 from nvarchar(255)
@@ -110,7 +110,7 @@
     } else if (to_load_col_size == "max") {
       return("resize") # If existing not max but to load is then must resize
     } else if (as.numeric(to_load_col_size)
     <= as.numeric(existing_col_size)) {
       return("compatible") # If neither is max, but existing greater
       # than or equal to load then will be fine
     } else {
@@ -129,7 +129,7 @@
   all_tables <- get_db_tables(database = database, server = server)
   # return TRUE if exists or else false
   nrow(all_tables[all_tables$Schema == schema &
     all_tables$Name == table_name, ]) == 1
 }
 
 # Prevent SQL injection with quoted schema table name construction

tests/testthat/test-drop_table.R

@@ -20,7 +20,7 @@ test_that("versioned drop sql created correctly", {
 
   expect_equal(create_drop_sql(
     "test", "test", "test_schema", "test_tbl"
-  ), drop_ver_sql)
+  )$drop_sql, drop_ver_sql)
 })
 
 test_that("non-versioned drop sql created correctly", {
@@ -34,7 +34,7 @@ test_that("non-versioned drop sql created correctly", {
 
   expect_equal(create_drop_sql(
     "test", "test", "test_schema", "test_tbl"
-  ), drop_nonver_sql)
+  )$drop_sql, drop_nonver_sql)
 })
 
 test_that("user error non-versioned drop sql created correctly", {
@@ -48,5 +48,5 @@ test_that("user error non-versioned drop sql created correctly", {
 
   expect_equal(create_drop_sql(
     "test", "test", "test_schema", "test_tbl"
-  ), drop_nonver_sql)
+  )$drop_sql, drop_nonver_sql)
 })