R/sql_table.r

In EntirelyDS/sqlmapr:

#' @export
SQLTable <- R6::R6Class(
  "SQLTable",
  public = list(
    initialize = function(name = NA, db_name = NA, column_details = NULL){
      if (!is.na(name)){
        private$set_name_(name)
      }
      if (!is.na(db_name)){
        private$set_name_(db_name, TRUE)
      }
      if (!is.null(column_details)){
        private$set_column_details_(column_details)
      }
    },
    connect = function(cred){
      private$conn_ <- mysql_connect(cred)
      return(invisible(self))
    },
    is_connected = function(){
      out <- assertive::is_s4(private$conn_)
      out <- out && assertive::is_true(DBI::dbIsValid(private$conn_))
      return(out)
    },
    exists = function(){
      res <- private$run_query_('table_exists', private$db_name_, private$name_)
      if (nrow(res) == 0){
        return(FALSE)
      }
      return(TRUE)
    },
    create = function(){
      assertive::assert_all_are_false(self$exists())
      table_def_sql <- private$create_def_sql_()
      private$run_query_(
        'create_table', private$db_name_, private$name_, table_def_sql
      )
      return(invisible(self))
    },
    drop = function(){
      # Check the table exists
      assertive::assert_all_are_true(self$exists())
      private$run_query_('drop_table', private$db_name_, private$name_)
      return(invisible(self))
    },
    add_index = function(what = list(), type = 'index'){
      cat('TO DO\n')
    },
    show_indexes = function(){
      cat('TO DO\n')
    },
    drop_index = function(name){
      cat('TO DO\n')
    },
    sql_snippet = function(){
      return(private$sql_snippet_)
    }
  ),
  active = list(
    name = function(nm){
      if (missing(nm)) return(private$name_) else private$set_name_(nm)
    },
    db_name = function(nm){
      if (missing(nm)) return(private$db_name_) else private$set_name_(nm, TRUE)
    },
    column_details = function(df){
      if (missing(df)){
        return(private$column_details_)
      }else{
        private$set_column_details_(df)
      }
    }
  ),
  private = list(
    name_ = NA,
    sql_snippet_ = NA,
    db_name_ = NA,
    column_details_ = NULL,
    conn_ = NA,
    set_name_ = function(name, is_db_name = FALSE){
      tmp_name <- as.character(name)
      if (is.na(tmp_name) || tmp_name != stringr::str_trim(tmp_name)){
        stop(
          stringr::str_c(
            'name parameter must be convertible to character and must not ',
            'contain whitespace'
          )
        )
      }else{
        if (is_db_name){
          private$db_name_ <- as.character(name)
        }else{
          private$name_ <- as.character(name)
        }
      }
      if (!is.na(private$db_name_) && stringr::str_length(private$db_name_) > 0){
        if(!is.na(private$name_) && stringr::str_length(private$name_) > 0){
          private$sql_snippet_ <- stringr::str_c(
            '`', private$db_name_, '`.`', private$name_, '` AS t'
          )
        }
      }
    },
    set_column_details_ = function(column_details){
      assertive::assert_is_data.frame(column_details)
      assertive::assert_all_are_true(
        c(
          'name', 'type', 'is_pk', 'is_nn', 'is_uq', 'is_un', 'is_ai', 'default'
        ) %in% colnames(column_details)
      )
      private$column_details_ <- column_details
    },
    is_query_ready_ = function(){
      assertive::assert_is_s4(private$conn_)
      assertive::assert_all_are_true(DBI::dbIsValid(private$conn_))
      assertive::assert_all_are_not_na(private$db_name_)
      assertive::assert_all_are_non_empty_character(private$db_name_)
      assertive::assert_all_are_not_na(private$name_)
      assertive::assert_all_are_non_empty_character(private$name_)
    },
    run_query_ = function(qname, ...){
      private$is_query_ready_()
      qfile <- file.path(
        path.package('sqlmapr'),'sql', stringr::str_c(qname, '.sql')
      )
      return(run_file_query(private$conn_, qfile, ...))
    },
    create_def_sql_ = function(){
      assertive::assert_is_data.frame(private$column_details_)
      pk_str <- ''
      uq_strs <- c()
      out_str <- ''
      uq <- 1
      for(i in 1:nrow(private$column_details_)){
        out_str <- stringr::str_c(
          out_str,
          '`', private$column_details_$name[i], '` ',
          private$column_details_$type[i],
          ifelse(private$column_details_$is_un[i], ' UNSIGNED', ''),
          ifelse(private$column_details_$is_nn[i], ' NOT NULL', 'NULL'),
          ifelse(private$column_details_$is_ai[i], ' AUTO_INCREMENT', ''),
          ifelse(
            !is.na(private$column_details_$default[i]),
            stringr::str_c(' DEFAULT ', private$column_details_$default[i]), ''
          ),
          ifelse(i < nrow(private$column_details_), ',', '')
        )
        if (private$column_details_$is_pk[i]){
          if (stringr::str_length(pk_str) > 0){
            pk_str <- stringr::str_c(pk_str, ', ')
          }
          pk_str <- stringr::str_c(
            pk_str, '`', private$column_details_$name[i], '`'
          )
        }
        if (private$column_details_$is_uq[i] != 0){
          uq_strs[uq] <- stringr::str_c(
            'UNIQUE INDEX `uq_idx', uq, '` (`', private$column_details_$name[i],
            '`', ifelse(private$column_details_$is_uq[i] > 0, ' ASC', ' DESC'),
            ')'
          )
        }
      }
      if (stringr::str_length(pk_str) > 0){
        out_str <- stringr::str_c(out_str, ', PRIMARY KEY(', pk_str,')')
      }
      if (length(uq_strs) > 0){
        out_str <- stringr::str_c(
          out_str, ', ', stringr::str_c(uq_strs, collapse = ',')
        )
      }
      return(out_str)
    }
  )
)