R/utils.R

In RSQLite.toolkit: Load Data in SQLite from Tabular Files

#' error_handler manage error messages for package
#'
#' @param err character, error message
#' @param fun character, function name where error happened
#' @param step integer, code identifying the step in the function
#'   where error happened.
#'   For dbTableFrom... functions steps are:
#'   - 101,121: read file schema (DSV, Xlsx)
#'   - 102: handle col_names and col_types
#'   - 103: create empty table
#'   - 104: read data
#'   - 105: write data
#'   - 106: indexing
#'
#' @returns nothing
#'
#'
error_handler <- function(err, fun, step) {

  if (step == 101) {
    step_msg <- paste0("reading file schema: \n",
                       "please check 'sep', 'dec', 'grp' ",
                       "params and those used by 'scan' ",
                       "for quoting, encoding, ...")

  } else if (step == 121) {
    step_msg <- paste0("reading file schema: \n",
                       "please check file name and ",
                       "'sheet_name', 'first_row', ",
                       "'cols_range' params.")

  } else if (step == 131) {
    step_msg <- paste0("reading file schema: \n",
                       "please check file name and ",
                       "file format.")

  } else if (step == 102) {
    step_msg <- paste0("handling 'col_names' and ",
                       "'col_types' parameters.")

  } else if (step == 103) {
    step_msg <- paste0("creating empty table in db.")

  } else if (step == 104) {
    step_msg <- paste0("reading data from input file.")

  } else if (step == 105) {
    step_msg <- paste0("writing data to db table.")

  } else if (step == 106) {
    step_msg <- paste0("indexing db table.")
  }

  msg <- paste0("Blocking error in ", fun, " while ", step_msg,
                "\n", "Original error msg: ", err)
  msg
}



Arrow2R_types <- function(x) {
  arrow2r_dict <- c(
    "boolean"    = "logical",
    "int8"       = "integer",
    "int16"      = "integer",
    "int32"      = "integer",
    "int64"      = "integer",
    "uint8"      = "integer",
    "uint16"     = "integer",
    "uint32"     = "integer",
    "uint64"     = "integer",
    "float16"    = NA,
    "float32"    = "double",
    "float64"    = "double",
    "decimal"    = "double",
    "double"     = "double",
    "utf8"       = "character",
    "large_utf8" = "character",
    "binary"            = NA,
    "large_binary"      = NA,
    "fixed_size_binary" = NA,
    "date32"    = "Date",
    "date64"    = "POSIXct",
    "time32"    = NA,
    "time64"    = NA,
    "timestamp" = "POSIXct",
    "duration"  = "difftime",
    "dictionary" = "character",
    "list"       = NA,
    "large_list" = NA,
    "fixed_size_list" = NA,
    "struct"    = NA,
    "null"      = NA,
    "map"       = NA,
    "union"     = NA
  )

  y <- arrow2r_dict[x]

  y
}


Xlsx2R_types <- function(x) {
  xlsx2r_dict <- c(
    "0" = "character",
    "1" = "numeric",
    "2" = "Date",
    "3" = "POSIXct",
    "4" = "logical"
  )

  y <- xlsx2r_dict[as.character(x)]

  y
}

#' From R class names to SQLite data types
#' 
#' @description 
#' The `R2SQL_types()` function returns a character vector with the names
#' of SQLite data types corresponding to the R classes passed through the
#' `x` parameter.
#'
#' If any class is not recognized, it will be replaced with `TEXT` data type.
#'
#' @param x character, a vector containing the strings with the R class names.
#'
#' @returns a character vector with the names of SQLite data types.
#'
#' @examples
#' # Convert R data types to SQLite types
#' r_types <- c("character", "integer", "numeric", "logical", "Date")
#' sql_types <- R2SQL_types(r_types)
#'
#' # Display the mapping
#' data.frame(
#'   R_type = r_types,
#'   SQLite_type = sql_types,
#'   row.names = NULL
#' )
#'
#' # Handle unknown types (converted to TEXT)
#' mixed_types <- c("character", "unknown_type", "integer")
#' R2SQL_types(mixed_types)
#'
#' @export
#' 
R2SQL_types <- function(x) {
  r2sql_dict <- c("character" = "TEXT",
                  "double"    = "REAL",
                  "integer"   = "INTEGER",
                  "logical"   = "INTEGER",
                  "numeric"   = "REAL",
                  "Date"      = "DATE",
                  "double_grouped"   = "REAL",
                  "integer_grouped"  = "INTEGER",
                  "numeric_grouped"  = "REAL",
                  "percentage"       = "REAL")

  y <- r2sql_dict[x]
  y[which(is.na(y))] <- "TEXT"

  y
}

convert_grouped_digits <- function(x, to, dec, grp) {

  check1 <-  grep(pattern = "[.\\|()[{^$*+?]", x = grp)
  if (length(check1) > 0) {
    pg <- paste0("\\", grp)
  } else {
    pg <- grp
  }

  check2 <-  grep(pattern = "[.\\|()[{^$*+?]", x = dec)
  if (length(check2) > 0) {
    pd <- paste0("\\", dec)
  } else {
    pd <- dec
  }

  y <- gsub(pattern = pd, replacement = ".",
    x = gsub(pattern = pg, replacement = "", x = x)
  )
  if (to %in% c("numeric", "double")) {
    y <- as.numeric(y)
  } else if (to == "integer") {
    y <- as.integer(y)
  }

  y
}

convert_percentage <- function(x, dec, grp) {

  check1 <-  grep(pattern = "[.\\|()[{^$*+?]", x = grp)
  if (length(check1) > 0) {
    pg <- paste0("\\", grp)
  } else {
    pg <- grp
  }

  check2 <-  grep(pattern = "[.\\|()[{^$*+?]", x = dec)
  if (length(check2) > 0) {
    pd <- paste0("\\", dec)
  } else {
    pd <- dec
  }

  y <- gsub(pattern = pd, replacement = ".",
    x = gsub(pattern = pg, replacement = "", x = x)
  )
  y <- as.numeric(y) / 100

  y
}

#' Format column names for SQLite
#' 
#' @description
#' The `format_column_names()` function formats a vector of
#' strings to be used as columns' names for a table in a SQLite
#' database.
#'
#' @param x character vector with the identifiers' names to be quoted.
#' @param quote_method character, used to specify how to build the SQLite
#'    columns' names from the identifiers passed through the `x`
#'    parameter.
#'    Supported values for `quote_method`:
#'    - `DB_NAMES` tries to build a valid SQLite column name:
#'      a. substituting all characters, that are not letters or digits or
#'         the `_` character, with the `_` character;
#'      b. prefixing `N_` to all strings starting with a digit;
#'      c. prefixing `F_` to all strings equal to any SQL92 keyword.
#'    - `SINGLE_QUOTES` encloses each string in single quotes.
#'    - `SQL_SERVER` encloses each string in square brackets.
#'    - `MYSQL` encloses each string in back ticks.
#'    Defaults to `DB_NAMES`.
#' @param unique_names logical, checks for any duplicate name after
#'    applying the selected quote methods. If duplicates exist, they
#'    will be made unique by adding a postfix `_[n]`, where `n` is
#'    a progressive integer. Defaults to `TRUE`.
#' @param encoding character, encoding to be assumed for input strings.
#'    It is used to re-encode the input in order to process it
#'    to build column identifiers. Defaults to ‘""’ (for the encoding of
#'    the current locale).
#'
#' @returns A data frame containing the columns' identifiers in two formats:
#'   - `quoted`: the quoted names, as per the selected `quote_method`;
#'   - `unquoted`: the cleaned names, without any quoting.
#'
#' @examples
#' # Example with DB_NAMES method
#' col_names <- c("column 1", "column-2", "3rd_column", "SELECT")
#' 
#' formatted_names <- format_column_names(col_names, quote_method = "DB_NAMES")
#' print(formatted_names)
#'
#' # Example with SINGLE_QUOTES method
#' formatted_names_sq <- format_column_names(col_names, quote_method = "SINGLE_QUOTES")
#' print(formatted_names_sq)
#'
#' # Example with SQL_SERVER method
#' formatted_names_sqlsrv <- format_column_names(col_names, quote_method = "SQL_SERVER")
#' print(formatted_names_sqlsrv)
#'
#' @importFrom DBI .SQL92Keywords
#' 
#' @export
#'
format_column_names <- function(x, quote_method = "DB_NAMES",
                                unique_names = TRUE, encoding = "") {
  allowed_methods <- c("DB_NAMES",
                       "SINGLE_QUOTES", ## "DOUBLE_QUOTES",
                       "SQL_SERVER",    "MYSQL")

  if (!quote_method %in% allowed_methods) {
    stop("RSQLite.toolkit: error in quote_method: ", quote_method, " unknown.")
  }

  x1 <- x

  if (any(is.na(iconv(x1)))) {

    if (!(any(is.na(iconv(x1, encoding, ""))))) {
      x1 <- iconv(x1, encoding, "")

    } else if (!(any(is.na(iconv(x1, "latin1", ""))))) {
      x1 <- iconv(x1, "latin1", "")

    } else if (!(any(is.na(iconv(x1, "utf8", ""))))) {
      x1 <- iconv(x1, "utf8", "")

    } else if (!(any(is.na(iconv(x1, "latin1", "utf8"))))) {
      x1 <- iconv(x1, "latin1", "utf8")

    } else if (!(any(is.na(iconv(x1, "utf8", "latin1"))))) {
      x1 <- iconv(x1, "utf8", "latin1")
    }
  }

  idx <- which(x1 == "")
  if (length(idx) > 0) {
    x1[idx] <- paste0("X_", idx)
  }

  if (quote_method == "DB_NAMES") {

    x1 <- gsub("^\\s+|\\s+$", "", x1)
    x1 <- gsub("^[\"'`]+|[\"'`]+$", "", x1)

    reg1 <- "([^[:alpha:]0-9_]+)"
    x1 <- gsub(pattern = reg1, replacement = "_", x = x1)

    idx <- which(toupper(x1) %in% DBI::.SQL92Keywords)
    if (length(idx) > 0) {
      x1[idx] <- paste0("F_", x1[idx])
    }

    reg2 <- "(^[0-9])"
    idx <- grep(pattern = reg2, x = x1)
    if (length(idx) > 0) {
      x1[idx] <- paste0("N_", x1[idx])
    }

    reg3 <- "(^sqlite_)"
    x1 <- gsub(pattern = reg3, replacement = "", x = x1)
    x2 <- x1

  } else if (quote_method == "SINGLE_QUOTES") {
    x1 <- gsub(pattern = "'", replacement = "`", x = x1)
    x2 <- x1
    x1 <- paste0("'", x1, "'")

  } else if (quote_method == "SQL_SERVER") {
    x1 <- gsub(pattern = "[\\[\\]]", replacement = "_", x = x1)
    x2 <- x1
    x1 <- paste0("[", x1, "]")

  } else if (quote_method == "MYSQL") {
    x1 <- gsub(pattern = "`", replacement = "'", x = x1)
    x2 <- x1
    x1 <- paste0("`", x1, "`")
  }


  if (unique_names) {
    idx <- which(x1 %in% x1[duplicated(x1)])
    if (length(idx) > 0) {
      id <- c(seq_along(idx))
      x1[idx] <- paste0(x1[idx], "_", id)
      x2[idx] <- paste0(x2[idx], "_", id)

    }
  }

  data.frame(quoted = x1, unquoted = x2)
}