sql-lib.R

# Library for simple sql code generation from R You can learn more about package
# authoring with RStudio at: http://r-pkgs.had.co.nz/ Some useful keyboard
# shortcuts for package authoring: Build and Reload Package: 'Cmd + Shift + B'
# Check Package: 'Cmd + Shift + C' Test Package: 'Cmd + Shift + T' to
# internationalize gettext('no where_values specified', domain = 'R-rsql') does
# provide a tool to do it.


# TODO where clause  with range as mpg > 1

#' The class that provides the SQL functionality.
#'
#' @description
#' This class is intended to simplify SQL commands.
#' @examples
#' library(RSQL)
#' db.name <- getMtcarsdbPath(copy = TRUE)
#' rsql <- createRSQL(drv = RSQLite::SQLite(), dbname = db.name)
#' where_values_df <- data.frame(carb = 8, stringsAsFactors = FALSE)
#' select_sql <- rsql$gen_select(
#'  select_fields = "*", #c("wt", "qsec"),
#'  table = "mtcars",
#'  where_values = where_values_df)
#' mtcars.observed <- rsql$execute_select(select_sql)
#'  mtcars.observed
#'
#'  mtcars.new <- mtcars.observed
#' mtcars.new$carb <- 9
#' insert_sql <- rsql$gen_insert(table = "mtcars", values_df = mtcars.new)
#' rsql$execute_insert(sql_insert = insert_sql)
#'
#' where_values_df <- data.frame(carb = 9, stringsAsFactors = FALSE)
#' select_sql <- rsql$gen_select(
#'   select_fields = "*", #c("wt", "qsec"),
#'  table = "mtcars",
#'  where_values = where_values_df)
#' mtcars.observed <- rsql$execute_select(select_sql)
#' mtcars.observed
#'
#' @export
#' @importFrom R6 R6Class
RSQL.class <- R6::R6Class("RSQL", public = list(
    #' @field driver driver  name
    driver = NA,
    #' @field db.name database name
    db.name = NA,
    # regexp
    #'
    #' @field available.functions for generating select expressions
    available.functions  = NA,
    #' @field entity.field.regexp for scrape a field or table expression
    entity.field.regexp  = NA,
    #' @field entity.select.regexp for scrape a select expressions expression
    entity.select.regexp = NA,
    #state
    #' @field conn  The connection handler
    conn = NULL,
    #' @field last.query The last query
    last.query = NA,
    #' @field last.rs  The last resultset
    last.rs = NA,
    #counters
    #' @field select.counter  An instance select counter
    select.counter = 0,
    #' @field insert.counter  An instance insert counter
    insert.counter = 0,
    #' @field update.counter  An instance update counter
    update.counter = 0,
    #' @field delete.counter   An instance delete counter
    delete.counter = 0,
    #' @field command.counter   An instance command counter
    command.counter = 0,
    #' @description
    #' Initializes a connection
    #' @param drv driver name
    #' @param dbname database name
    #' @param user user name
    #' @param password password
    #' @param host host name
    #' @param port port number
    initialize = function(drv, dbname,
        user = NULL, password = NULL, host = NULL, port = NULL) {
        self$db.name <- dbname
        self$driver <- drv
        self$conn <- dbConnect(drv = self$driver, dbname = self$db.name,
                                     user = user, password = password, host = host, port = port)
    },
    #' @description
    #' initialize regexp for scraping entities
    #' @param force force setup?
    #' @return regexp for scraping select expressions
    setupRegexp = function(force = FALSE){
      if (is.na(self$entity.field.regexp) | force){
        self$available.functions   <- c("max", "min", "mean", "tmean", "count")
        self$entity.field.regexp   <- "([[:alnum:]\\_]+)"
        available.functions.regexp <- paste(self$available.functions, collapse = "|")
        field.wildcard <- paste("(?:",self$entity.field.regexp, "|\\*)", sep = "")
        self$entity.select.regexp  <- paste("^(?:", self$entity.field.regexp, "|(",
                                              available.functions.regexp,")\\(",
                                                self$entity.field.regexp,
                                           "\\)", "|", "\\*)$", sep = "")
        entity.regexp <- "^(?:[[:alnum:]]\\_|(?:max|min|mean|tmean|count)\\([[:alnum:]\\_]+\\)|\\*)$"

        self$entity.field.regexp   <- paste("^", self$entity.field.regexp, "$", sep ="")
      }
      self$entity.select.regexp
    },
    #' @description
    #' Class destructor
    finalize = function(){
      message("Finalizing object and disconnecting")
      self$disconnect()
    },
    #'@description
    #' Checks if an entity exists
    #' @param entities entities to check
    #' @param entity.type entity type to check against
    checkEntitiesNames = function(entities, entity.type){
      self$setupRegexp()
      errors <- NULL
      for (entity in entities){
        error <- FALSE

        entity.regexp <- NULL
        if (entity.type %in% c("table", "field")){
          entity.regexp <- self$entity.field.regexp
        }
        if (entity.type == "select"){
          entity.regexp <- self$entity.select.regexp
        }

        grepl(entity.regexp, entity, perl = TRUE)
        gsub(entity.regexp, "====", entity, perl = TRUE)

        if (!grepl(entity.regexp, entity, perl = TRUE)){
          error <- TRUE
        }
        if (error){
          errors <- c(errors, entity)
        }
      }
      errors
      if (!is.null(errors)){
        stop(paste(entity.type, " names are not legal:",
                   paste(errors, collapse = ",")
                   ))
      }
    },
    #' @description
    #' Generates a select
    #' @param select_fields fields to be selected
    #' @param table table to select from
    #' @param where_fields fields in the where clause
    #' @param where_values values to the fields on the where clause
    #' @param group_by fields to group by
    #' @param order_by fields to order by
    #' @param top where does the resultset starts?
    #' @param distinct provides a way to select distinct rows
    gen_select = function(select_fields,
                          table,
                          where_fields = names(where_values),
                          where_values = NULL,
                          group_by = c(),
                          order_by = c(),
                          top = 0,
                          distinct = FALSE) {
      self$checkEntitiesNames(select_fields, entity.type = "select")
      self$checkEntitiesNames(table, entity.type = "table")
      self$checkEntitiesNames(c(where_fields, group_by, order_by), entity.type = "field")

      sql_gen_select(select_fields = select_fields, table = table,
                       where_fields = where_fields,
                       where_values = where_values,
                       group_by = group_by,
                       order_by = order_by,
                       top = top,
                       distinct = distinct)
    },
    #'@description
    #'
    #' Generate  insert statement
    #'
    #' @param values_df The values to insert. Must be defined as data.frame of values
    #' @param table The table to insert into
    #' @param insert_fields the fields to insert into
    gen_insert = function(table, values_df, insert_fields  = names(values_df)) {
      self$checkEntitiesNames(table, entity.type = "table")
      self$checkEntitiesNames(insert_fields, entity.type = "field")
       sql_gen_insert(table = table, values_df = values_df, insert_fields = insert_fields)
    },
    #'@description
    #'
    #' Generate  insert statement
    #' @param table the table to insert into
    #' @param update_fields the fields to update
    #' @param where_fields a where clause to the insert
    #' @param where_values the values to add to the where clause
    #' @param values the values to update
    gen_update = function(table,
                             update_fields = names(values), values,
                             where_fields = names(where_values), where_values = NULL) {
      self$checkEntitiesNames(table, entity.type = "table")
      self$checkEntitiesNames(c(update_fields, where_fields), entity.type = "field")
      sql_gen_update(table = table,
                     update_fields = update_fields, values = values,
                     where_fields = where_fields, where_values = where_values)
    },
    #'@description
    #'
    #' Generate a delete statement
    #' @param table the table to insert into
    #' @param where_values the fields to add to the where clause
    #' @param where_fields a where clause to the insert
    gen_delete = function(table, where_fields = names(where_values), where_values = NULL) {
      self$checkEntitiesNames(table, entity.type = "table")
      self$checkEntitiesNames(c(where_fields), entity.type = "field")

      sql_gen_delete(table, where_fields, where_values)
    },
    #'@description
    #'
    #' Performs an execution on the database
    #' @param sql_select the sql select statement to perform
    execute_select = function(sql_select) {
        self$last.query <- sql_select
        self$last.rs <- sql_execute_select(sql_select, dbconn = self$conn)
        self$select.counter <- self$select.counter + 1
        self$last.rs
    },
    #'@description
    #'
    #' Performs an update on the database
    #' @param sql_update the sql update statement to perform
    execute_update = function(sql_update) {
        self$last.query <- sql_update
        self$last.rs <- sql_execute_update(sql_update = sql_update, dbconn = self$conn)
        self$update.counter <- self$update.counter + 1
        self$last.rs
    },
    #'@description
    #'
    #' Performs an insert on the database
    #' @param sql_insert the sql insert statement to perform
    execute_insert = function(sql_insert) {
        self$last.query <- sql_insert
        self$last.rs <- sql_execute_insert(sql_insert = sql_insert, dbconn = self$conn)
        self$insert.counter <- self$insert.counter + 1
        self$last.rs
    },
    #'@description
    #'
    #' Performs a command on the database
    #' @param sql_command the sql statement to perform
    execute_command = function(sql_command){
      self$last.query <- sql_command
      self$last.rs <- sql_execute_insert(sql_command, dbconn = self$conn)
      self$command.counter <- self$command.counter + 1
      self$last.rs
    },
    #'@description
    #'
    #' Performs an deletion on the database
    #' @param sql_delete the sql delete statement to perform
    execute_delete = function(sql_delete) {
        self$last.query <- sql_delete
        self$last.rs <- sql_execute_delete(sql_delete, dbconn = self$conn)
        self$delete.counter <- self$delete.counter + 1
        self$last.rs
    },
    #'@description
    #'
    #' Performs an insert on the database. This is a composite function
    #' @param table The table
    #' @param fields_uk The fields unique key
    #' @param values_uk The values unique key
    #' @param fields The fields (Not used. Included for compatibility)
    #' @param values The values (Not used. Included for compatibility)
    #' @param field_id The field of the serial id
    retrieve = function(table, fields_uk = names(values_uk), values_uk,
                        fields = names(values), values,
                               field_id = "id"){
      self$checkEntitiesNames(table, entity.type = "table")
      self$checkEntitiesNames(c(fields_uk, field_id), entity.type = "field")
      sql_retrieve(table = table, fields_uk = fields_uk, values_uk = values_uk,
                   fields = fields, values = values, field_id = field_id,
                   dbconn = self$conn)
    },
    #'@description
    #'
    #' Obtain id if object exists on the database. Insert object if not.
    #' @param table The table
    #' @param fields_uk The fields unique key
    #' @param values_uk The values unique key
    #' @param fields The fields
    #' @param values The values
    #' @param field_id The field of the serial id
    retrieve_insert = function(table, fields_uk = names(values_uk), values_uk,
                               fields = names(values), values,
                               field_id = "id"){
      self$checkEntitiesNames(table, entity.type = "table")
      self$checkEntitiesNames(c(fields_uk, fields, field_id), entity.type = "field")
      sql_retrieve_insert(table = table, fields_uk = fields_uk, values_uk = values_uk,
                          fields = fields, values = values, field_id = field_id,
                          dbconn = self$conn)
    },
    #' @description
    #'
    #' Disconnects the instance from the database
    disconnect = function() {
      if (!is.null(self$conn)){
        if (!is.null(self$last.rs)) {
          # TODO Fix this call
          #DBI::dbClearResult(self$last.rs)
          self$last.rs <- NULL
        }
        DBI::dbDisconnect(self$conn)
        self$conn <- NULL
      }

    }))

#' Produces a RSQL object
#'
#' @param drv Driver name
#' @param dbname Database name
#' @param user Database user name
#' @param password Database password
#' @param host Database host
#' @param port Database port
#' @export
createRSQL <- function(drv, dbname, user = NULL, password = NULL, host = NULL, port = NULL) {
    RSQL.class$new(drv, dbname, user, password, host, port)
}


#' Executes a statement on the database.
#'
#' @import lgr
#' @param sql_insert The SQL String
#' @param dbconn The Database Connection to run the query against
sql_execute_insert <- function(sql_insert, dbconn = NULL) {
    sql_insert <- gsub(",NA", ",NULL", sql_insert)
    sql_insert <- gsub(", NA", ",NULL", sql_insert)
    sql_insert <- paste(sql_insert, ";", sep = "")
    #ret <- DBI::dbSendQuery(dbconn, sql_insert)
    ret <- DBI::dbSendStatement(dbconn, sql_insert)

    lgr$trace(sql_insert)

    # data <- fetch(rs,n=-1) print(res)
    if (length(ret) > 0) {
        # TODO check if OK

        # if (nchar(ret[1])>5){ print(paste('for processing', id_process, ' in Insert
        # No', contadorInserts, ' an error is inserted in database'))
        # print(paste(sql_insert)) print(paste('Error:',res[1]))
        # insertarErrorEnBD(id_process, contadorInserts, id_ciudad, anio, mes,
        # sql_insert, res[1],context) }
    }
    ret
}

#' Executes an update on the database
#'
#' @param sql_update The update SQL
#' @param dbconn The Database Connection to run the query against
sql_execute_update <- function(sql_update, dbconn = NULL) {
    sql_update <- gsub(",NA", ",NULL", sql_update)
    sql_update <- gsub(", NA", ",NULL", sql_update)
    ret <- DBI::dbSendQuery(dbconn, sql_update)
    ret
}


#' sql_execute_delete
#'
#' Executes a delete on the Database
#'
#' @param sql_delete The delete SQL
#' @param dbconn The Database Connection to run the query against
sql_execute_delete <- function(sql_delete, dbconn = NULL) {
    sql_delete <- gsub(",NA", ",NULL", sql_delete)
    sql_delete <- gsub(", NA", ",NULL", sql_delete)
    ret <- DBI::dbExecute(dbconn, sql_delete)
    lgr$trace(sql_delete)
    ret

}

#' Executes a select on the database
#'
#' @import DBI
#' @param sql_select The delete SQL
#' @param dbconn The Database Connection to run the query against
sql_execute_select <- function(sql_select, dbconn = NULL) {
    # debug sql_select <- 'select price from v_quotes_id_completed where
    # symbol='alua' order by date DESC LIMIT 1' sql_select <- 'select * from
    # v_quotes'
    sql_select <- gsub(",NA", ",NULL", sql_select)
    sql_select <- gsub(", NA", ",NULL", sql_select)

    ret <- DBI::dbGetQuery(dbconn, sql_select)
    ret
}

#' Executes the insert statement
#'
#' @param dbconn The db connection
#' @param sql_select The SQL select query
#' @param sql_insert The SQL insert query
#' @param ... other variables to considered.
execute_get_insert <- function(dbconn, sql_select, sql_insert, ...) {
    ret <- sql_execute_select(sql_select, dbconn)
    if (nrow(ret) == 0) {
        sql_execute_insert(sql_insert)
        ret <- sql_execute_select(sql_select, ...)
    }
    ret[1, ]
}

#' Determines if the string is quoted or not
#'
#' @param text The text to test
#' @param quotes_symbols The quotation characters
is_quoted <- function(text, quotes_symbols = c("'", "'")) {
    ret <- FALSE
    i <- 1
    while (!ret & i <= length(quotes_symbols)) {
        quotes <- quotes_symbols[i]
        ret <- substr(text, 1, 1) == quotes & substr(text, nchar(text), nchar(text)) ==
            quotes
        i <- i + 1
    }
    ret
}

#' Removes the quotes from the string
#'
#' @param text The string to remove the quotes from.
dequote <- function(text) {
    substr(text, 2, nchar(text) - 1)
}

#' TODO: WHAT IS THIS FUNCTION DOING AGAIN?
#'
#' @param text The string
#' @param quotes The quotes
re_quote <- function(text, quotes = "'") {
    quote <- FALSE
    if (!is_quoted(text, "'"))
        quote <- TRUE
    if (is_quoted(text, "'")) {
        text <- dequote(text)
        quote <- TRUE
    }
    if (quote)
        text <- paste(quotes, text, quotes, sep = "")
    text
}

#' Adds quotes to a string
#'
#' @param text The string to quote
add_quotes <- function(text) {
    ret <- sapply(text, FUN = re_quote)
    names(ret) <- NULL
    ret
}

#' Removes quotes from the String
#'
#' @param text The string to remove quotes from
#' @param quotes Quote characters
rm_quotes <- function(text, quotes = "'") {
    if (quotes == substr(text, 1, 1) & quotes == substr(text, nchar(text), nchar(text))) {
        text <- substr(text, 2, nchar(text) - 1)
    }
    text
}

#' Removes quotes from data.frame columns
#'
#' @param text The text column to remove quotes from.
remove_quotes <- function(text) {
    ret <- sapply(text, FUN = rm_quotes)
    names(ret) <- NULL
    ret
}


#' add_grep_exact_match
#'
#' @param text TEST
add_grep_exact_match <- function(text) {
    text <- gsub("(\\^|\\%)", "\\\\\\1", text)
    paste("^", text, "$", sep = "")
}

#' Generates a Delete Statement
#'
#' @param table The table from which the delete statement will be generated
#' @param where_fields The fields used in the where section
#' @param where_values The values used in the where section
sql_gen_delete <- function(table, where_fields = names(where_values), where_values = NULL) {
    sql_where <- sql_gen_where(where_fields, where_values)
    ret <- paste("delete from", table, sql_where)
    ret

}

#' Generates a Select Statement
#'
#' @param select_fields The fields to be selected
#' @param table The table to be used in the select
#' @param where_fields The fields used in the where section
#' @param where_values The values used in the where section
#' @param group_by Group by fields
#' @param order_by Order by fields
#' @param top Retrieve top records
#' @param distinct it adds a distinct clause to the query.
sql_gen_select <- function(select_fields, table,
                           where_fields = names(where_values),
                           where_values = NULL,
                           group_by = c(),
                           order_by = c(),
                           top = 0,
                           distinct = FALSE) {
    separator <- ""
    sql_select_fields <- ""
    for (f in select_fields) {
        sql_select_fields <- paste(sql_select_fields, separator, f, sep = "")
        separator <- ", "
    }
    if (distinct){
      sql_select_fields <- paste("distinct", sql_select_fields)
    }
    sql_where <- sql_gen_where(where_fields, where_values)
    sql_order_by <- paste(order_by, collapse = ",")
    sql_group_by <- ""
    if (length(group_by) > 0) {
        separator <- ""
        for (f in group_by) {
            sql_group_by <- paste(sql_group_by, separator, f, sep = "")
            separator <- ", "
        }
        order_by <- c(sql_group_by, order_by)
        sql_group_by <- paste("group by ", sql_group_by)
    }
    ret <- paste("select", sql_select_fields, "from", table, sql_where, sql_group_by)
    if (nchar(sql_order_by) > 0)
        ret <- paste(ret, "order by", sql_order_by)
    if (top > 0)
        ret <- paste(ret, "limit", top)
    trimws(ret)
}

#' Generates a where statement to be used on a SQL statement.
#'
#' @param where_fields The fields used in the where section
#' @param where_values The values used in the where section
sql_gen_where <- function(where_fields = names(where_values), where_values) {
    ret <- ""
    if (!is.null(where_fields) & !is.null(where_values)) {
        # Asserts with values
        if (!is.vector(where_fields))
            stop(paste(gettext("sql_lib_where_files_has_to_be_a_vector",
                               domain = "R-rsql"), str(where_fields)))
        if (!is.list(where_values))
            if (is.vector(where_values))
                where_values <- data.frame(matrix(where_values,
                                                  byrow = TRUE,
                                                  ncol = length(where_values)),
                  stringsAsFactors = FALSE)
        if (length(where_fields) != ncol(where_values))
            stop(paste(gettext("sql_lib.where_fields_num_not_eq_where_values_num", domain = "R-sql"), length(where_fields), "!=",
                length(where_values), paste(where_fields, collapse = ","), paste(where_values,
                  collapse = ",")))
        # if strings values, add '
        for (col in names(where_values)) {
            where_values_col <- where_values[, col]
            if (class(where_values_col) == "factor"){
              where_values_col <- as.character(where_values_col)
            }
            if (max(is.character(where_values_col)) == 1) {
                # TODO extend to multiple columns
                # if there is at least one value character in column remove ' for normalization
                # and adding after
                new.values <- paste("'", sub("\\'([a-zA-Z0-9[:punct:]!'[:space:]]+)\\'",
                  "\\1", where_values[, col]), "'", sep = "")
                lgr$trace(paste("col", col, "is character. Replacing values",
                  paste(where_values[, col], collapse = ","), "with values", paste(new.values,
                    collapse = ",")))
                where_values[, col] <- new.values
            }
        }

        ret <- ""
        if (length(where_fields) > 0 & !(length(where_fields) == 1 & nchar(where_fields[1]) ==
            0)) {
            where_values <- as.data.frame(where_values, nrow = nrow(where_values) / length(where_fields),
                stringsAsFactors = FALSE)
            #if (nrow(where_values) > 2){
            ret <- sql_gen_where_list(where_fields = where_fields, where_values = where_values)
            #}
            #else{
            #  ret <- sql_gen_where_or(where_fields, where_values)
            #}
        }
    } else {
        if (!is.null(where_fields)){
            stop(paste(gettext("sql_lib.no_where_values_specified", domain = "R-rsql")))
        }
        if (!is.null(where_values)) {
          stop(paste(gettext("sql_lib.no_where_values_specified", domain = "R-rsql")))
        }
    }
    ret
}

#' Generates a where list statement to be used on a SQL statement.
#'
#' @param where_fields The fields used in the where section
#' @param where_values The values used in the where section
sql_gen_where_list <- function(where_fields, where_values) {
    sql_where <- ""
    comma.sep <- ", "
    if (length(where_fields) > 0) {
        separator <- ""
        sql_where <- "where ("
        for (f in where_fields) {
            sql_where <- paste(sql_where, separator, f, sep = "")
            separator <- comma.sep
        }
        sql_where <- paste(sql_where, ") in ", sep = "")
        list_where <- ""
        separator_list <- ""
        for (v in seq_len(nrow(where_values))) {
            i <- 1
            separator <- ""
            sql_row_where <- ""
            for (f in where_fields) {
                if (is.na(where_values[v, i]))
                  value <- paste(":label_", f, ":", sep = "") else value <- where_values[v, i]

                if (is.character(value)) {
                  value <- add_quotes(value)
                }
                sql_row_where <- paste(sql_row_where, separator, value, sep = "")
                separator <- comma.sep
                i <- i + 1
            }
            if (i > 2)
                sql_row_where <- paste("(", sql_row_where, ")", sep = "")
            list_where <- paste(list_where, separator_list, sql_row_where, sep = "")
            separator_list <- comma.sep
        }
        sql_where <- paste(sql_where, "(", list_where, ")")
    }
    sql_where
}

#' Generates a where (or) statement to be used on a SQL statement.
#'
#' @param where_fields The fields used in the where section
#' @param where_values The values used in the where section
sql_gen_where_or <- function(where_fields = names(where_values), where_values) {
    sql_where <- ""
    if (length(where_fields) > 0) {
        sql_where <- "where"
        separator_where <- ""
        for (v in seq_len(nrow(where_values))) {
            i <- 1
            separator <- ""
            sql_row_where <- ""
            for (f in where_fields) {
                if (is.na(where_values[v, i]))
                  value <- paste(":label_", f, ":", sep = "") else value <- where_values[v, i]
                if (is.character(value))
                  value <- add_quotes(value)
                sql_row_where <- paste(sql_row_where, separator, f, "=", value, sep = "")
                separator <- " and "
                i <- i + 1
            }
            sql_where <- paste(sql_where, separator_where, "(", sql_row_where, ")")
            separator_where <- " or "
        }
    }
    sql_where
}



#' Generates an insert statement.
#'
#' @param table The table to be affected
#' @param insert_fields The fields to insert
#' @param values_df The values to insert. Must be defined as data.frame of values
sql_gen_insert <- function(table, values_df, insert_fields = names(values_df)) {
    if (length(values_df) > 1 & class(values_df) != "data.frame"){
      #debug
      print(values_df)
      stop("Values must be defined as data.frames with same size of columns")
    }
    # Converts all factors to strings
    values_df <- as.data.frame(lapply(values_df, as.character), stringsAsFactors = FALSE)

    if (length(insert_fields) != ncol(values_df)) {
        stop(paste(gettext("sql_lib.incompatible_fields_and_data", domain = "R-rsql"), length(insert_fields), gettext("sql_lib.not_eq", domain = "R-rsql"),
            ncol(values_df), paste(insert_fields, collapse = ";"), paste(values_df, collapse = ";")))
    }
    separator <- ""
    sql_insert_fields <- ""
    for (f in insert_fields) {
        sql_insert_fields <- paste(sql_insert_fields, separator, f, sep = "")
        separator <- ", "
    }
    sql_values <- ""
    separator_rows <- ""
    for (i in seq_len(nrow(values_df))) {
        sql_values_row <- ""
        separator <- ""
        for (j in seq_len(length(insert_fields))) {
            if (is.na(values_df[i, j])) {
                value <- "NA"
            } else {
                value <- values_df[i, j]
                if (is.character(value)) {
                  value <- add_quotes(value)
                }
            }

            sql_values_row <- paste(sql_values_row, separator, value, sep = "")
            separator <- ", "
        }
        lgr$trace(sql_values_row)
        sql_values <- paste(sql_values, separator_rows, "(", sql_values_row, ")")
        separator_rows <- ", "
    }
    ret <- paste("insert into ", table, "(", sql_insert_fields, ") values ", sql_values,
        sep = "")
    ret
}


#' Generates an update statement
#'
#' @param table The table to update
#' @param update_fields The fields to update
#' @param values The values to update
#' @param where_fields The fields for where statement
#' @param where_values The values for where statement
sql_gen_update <- function(table, update_fields = names(values), values, where_fields = names(where_values), where_values) {
    sql_where <- sql_gen_where(where_fields, where_values)
    ret <- paste("update ", table, " set (", paste(update_fields, collapse = ","),
                                      ")=(", paste(add_quotes(values), collapse =  ","),
        ") ", sql_where, sep = "")
    ret
}


#' Returns string w/o leading whitespace
#'
#' @param x The string
trim_leading <- function(x) sub("^\\s+", "", x)

#' Returns string w/o trailing whitespace
#'
#' @param x The string
trim_trailing <- function(x) sub("\\s+$", "", x)


#' Returns string w/o leading or trailing whitespace
#'
#' @param x The string
trim <- function(x) gsub("^\\s+|\\s+$", "", x)

#' renames a column on a data.frame
#'
#' @param df The date.frame
#' @param name The name of the column
#' @param replace_name The new name of the column
rename_col <- function(df, name, replace_name) {
    i <- which(names(df) == name)
    names(df)[i] <- replace_name
    df
}

#' TODO: WHAT DOES THIS DO AGAIN?
#'
#' @param ... The parameters
cbind_coerced <- function(...) {
    ret <- cbind(..., stringsAsFactors = FALSE)
    if ("stringsAsFactors" %in% names(ret))
        ret <- ret[, -which(names(ret) == "stringsAsFactors")]
    ret
}


#' Checks that the columns are in the data.frame
#'
#' @param dataframe The data.frame
#' @param columns The columns to check
df_verify <- function(dataframe, columns) {
    ret <- NULL
    dataframe_names <- names(dataframe)
    for (column in columns) {
        if (!column %in% dataframe_names)
            ret <- c(ret, column)
    }
    if (length(ret) > 0)
        stop(paste(gettext("sql_lib.missing_columns_in_dataframe", domain = "R-rsql"), paste(ret, collapse = ","), "df",
            paste(dataframe_names, collapse = ",")))
}


#' Retrieves Statement
#'
#' @param table The table
#' @param fields_uk The fields unique key
#' @param values_uk The values unique key
#' @param field_id The field of the serial id
#' @param fields The fields (Not used. Included for compatibility)
#' @param values The values (Not used. Included for compatibility)
#' @param dbconn The database connection
sql_retrieve <- function(table, fields_uk = names(values_uk), values_uk,
                         fields = names(values), values = NULL,
                         field_id = "id", dbconn = NULL) {
  ret <- NULL
  values_uk <- as.data.frame(values_uk, stringsAsFactors = FALSE)

  for (i in seq_len(nrow(values_uk))) {
    # value_uk <- as.character(values_uk[i,]) value <- as.character(values[i,])
    value_uk <- as.data.frame(values_uk[i, ], stringsAsFactors = FALSE)

    select_statement <- sql_gen_select(field_id, table, where_fields = fields_uk,
                                       where_values = value_uk)
    lgr$trace(paste("verifying", select_statement, ":"))
    row <- sql_execute_select(select_statement, dbconn = dbconn)
    lgr$trace("Retrieved", rows = nrow(row))
    ret <- c(ret, as.numeric(row[, field_id]))
    i <- i + 1
  }
  ret
}


#' Retrieves or insert Statement
#'
#' @param table The table
#' @param fields_uk The fields unique key
#' @param values_uk The values unique key
#' @param fields The fields
#' @param values The values
#' @param field_id The field of the serial id
#' @param dbconn The database connection
sql_retrieve_insert <- function(table, fields_uk = names(values_uk), values_uk,
                                fields = names(values), values = NULL,
                                field_id = "id", dbconn = NULL) {
    ret <- NULL
    values_uk <- as.data.frame(values_uk, stringsAsFactors = FALSE)
    values <- as.data.frame(values, stringsAsFactors = FALSE)
    if (nrow(values) > 0 & nrow(values) != nrow(values_uk)) {
        stop(paste(gettext("sql_lib.error_nrows_values_uk_neq_nrows_values", domain = "R-rsql"), nrow(values_uk), nrow(values)))
    }


    for (i in seq_len(nrow(values_uk))) {
        # value_uk <- as.character(values_uk[i,]) value <- as.character(values[i,])
        value_uk <- as.data.frame(values_uk[i, ], stringsAsFactors = FALSE)
        value <- values[i, ]
        values_insert <- cbind_coerced(value_uk, value)

        select_statement <- sql_gen_select(field_id, table, where_fields = fields_uk,
            where_values = value_uk)

        lgr$trace(paste("verifying", select_statement, ":"))
        insert_statement <- sql_gen_insert(table, insert_fields = c(fields_uk, fields),
            values_df = values_insert)
        row <- sql_execute_select(select_statement, dbconn = dbconn)
        lgr$trace("Retrieved", rows = nrow(row))
        if (nrow(row) == 0) {
            lgr$trace(paste("executing", insert_statement))
            sql_execute_insert(insert_statement, dbconn = dbconn)
            row <- sql_execute_select(select_statement, dbconn = dbconn)
        }

        ret <- c(ret, as.numeric(row[, field_id]))
        i <- i + 1
    }
    ret
}


#' Generates a Joined Query
#' TODO integrate with external functionality
#' @param dw_definition TEST
#' @param recipe TEST
#' @param indicator_fields TEST
#' @noRd
sql_gen_joined_query <- function(dw_definition, recipe, indicator_fields) {
    # sql_gen_select <- function(select_fields, table, where_fields='',
    # where_values=NULL,group_by=c()){
    sql_select_fields <- rep("", length(indicator_fields))
    sql_from <- ""
    sql_where <- ""
    ind_i <- 0
    where_sep <- ""
    from_sep <- ""
    for (i in seq_len(nrow(recipe$m_recipe))) {
        current_expression <- recipe$m_recipe[i, ]
        # TODO correct in a dictionary
        alias <- gsub("\\.", "_", current_expression$value)
        for (j in seq_len(length(indicator_fields) ) ) {
            if (current_expression$op == "=")
                sql_select_fields[j] <- current_expression$value else {
                sql_select_fields[j] <- paste("(", sql_select_fields[j], current_expression$op,
                  alias, ".", indicator_fields[j], ")", sep = "")
            }
        }
        if (current_expression$value_type == "indicator") {
            ind_i <- ind_i + 1
            if (ind_i == 1)
                first_alias <- alias
            sql_from <- paste(sql_from, from_sep, dw_definition$m_fact_table, " ",
                alias, sep = "")
            from_sep <- ","
            first_field_def <- dw_definition$m_dimensions[1, ]
            for (k in seq_len(nrow(dw_definition$m_dimensions))) {
                current_field_def <- dw_definition$m_dimensions[k, ]
                explicit_value <- ind_i == 1 & nchar(current_field_def$default) ==
                  0
                # TODO define in dw_definition fields mapping
                explicit_value <- explicit_value | current_field_def$field == "symbol"
                filter <- ind_i > 1 | current_field_def$field == "symbol"

                # debug explicit_value< <- explicit_value dw_definition< <- dw_definition k< <- k

                if (explicit_value) {
                  if (current_expression$value_id > 0)
                    right_value <- current_expression$value_id else right_value < paste("'", current_expression$value, "'", sep = "")
                } else {
                  if (filter)
                    right_value <- paste(first_alias, ".", current_field_def$field,
                      sep = "")
                }
                if (filter) {
                  sql_where <- paste(sql_where, where_sep, alias, ".", current_field_def$field,
                    "=", right_value, sep = "")
                  where_sep <- " and "
                }
                current_field_def
            }
        }
        ret <- paste("select", paste(sql_select_fields, "as", indicator_fields, collapse = ","),
            "from", sql_from, "where", sql_where)
    }
    ret
}

#' Parses a where clause.
#'
#' @param where_clause_list The list of params
#' @import lgr
#' @export
parse_where_clause <- function(where_clause_list = c()) {
    where_df <- data.frame(lhs = character(), comp = character(), rhs = character(),
        stringsAsFactors = FALSE)
    names(where_df) <- c("lhs", "comp", "rhs")
    for (where_clause in where_clause_list) {
        where_struct <- strsplit(where_clause, "!=")
        if (length(where_struct[[1]]) == 2) {
            where <- data.frame(where_struct[[1]][1], "!=", paste("'", sub("\\'([a-zA-Z0-9[:punct:]!'[:space:]]+)\\'",
                "\\1", where_struct[[1]][2]), "'", sep = ""))
            names(where) <- c("lhs", "comp", "rhs")
            where_df <- rbind(where_df, where)
            next
        }
        where_struct <- strsplit(where_clause, "<=")
        if (length(where_struct[[1]]) == 2) {
            where <- data.frame(where_struct[[1]][1], "<=", paste("'", sub("\\'([a-zA-Z0-9[:punct:]!'[:space:]]+)\\'",
                "\\1", where_struct[[1]][2]), "'", sep = ""))
            names(where) <- c("lhs", "comp", "rhs")
            where_df <- rbind(where_df, where)
            next
        }
        where_struct <- strsplit(where_clause, ">=")
        if (length(where_struct[[1]]) == 2) {
            where <- data.frame(where_struct[[1]][1], ">=", paste("'", sub("\\'([a-zA-Z0-9[:punct:]!'[:space:]]+)\\'",
                "\\1", where_struct[[1]][2]), "'", sep = ""))
            names(where) <- c("lhs", "comp", "rhs")
            where_df <- rbind(where_df, where)
            next
        }
        where_struct <- strsplit(where_clause, "=")
        if (length(where_struct[[1]]) == 2) {
            where <- data.frame(where_struct[[1]][1], "=", paste("'", sub("\\'([a-zA-Z0-9[:punct:]!'[:space:]]+)\\'",
                "\\1", where_struct[[1]][2]), "'", sep = ""))
            names(where) <- c("lhs", "comp", "rhs")
            where_df <- rbind(where_df, where)
            next
        }
        where_struct <- strsplit(where_clause, ">")
        if (length(where_struct[[1]]) == 2) {
            where <- data.frame(where_struct[[1]][1], ">", paste("'", sub("\\'([a-zA-Z0-9[:punct:]!'[:space:]]+)\\'",
                "\\1", where_struct[[1]][2]), "'", sep = ""))
            names(where) <- c("lhs", "comp", "rhs")
            where_df <- rbind(where_df, where)
            next
        }
        where_struct <- strsplit(where_clause, "<")
        if (length(where_struct[[1]]) == 2) {
            where <- data.frame(where_struct[[1]][1], "<", paste("'", sub("\\'([a-zA-Z0-9[:punct:]!'[:space:]]+)\\'",
                "\\1", where_struct[[1]][2]), "'", sep = ""))
            names(where) <- c("lhs", "comp", "rhs")
            where_df <- rbind(where_df, where)
            next
        }

    }
    where_df
}

#' Operator IN for multiple columns
#'
#' @param x TEST
#' @param y TEST
"%IN%" <- function(x, y) interaction(x) %in% interaction(y)


#' Get package directory
#'
#' Gets the path of package data.
#' @export
getPackageDir <- function(){
  home.dir <- find.package("RSQL", lib.loc = NULL, quiet = TRUE)
  data.subdir <- file.path("inst", "extdata")
  if (!dir.exists(file.path(home.dir, data.subdir)))
    data.subdir <- "extdata"
  file.path(home.dir, data.subdir)
}

#' getCarsdbPath
#' @param copy a boolean that states whether it should be copied to the home directory or not.
#' @export
getMtcarsdbPath <- function(copy = TRUE){
  db.filename <- "mtcars.db"
  source.path <- file.path(getPackageDir(), db.filename)
  if (copy){
    tmp.dir <- tempdir()
    file.copy(source.path, tmp.dir, overwrite = TRUE)
    ret <- file.path(tmp.dir, db.filename)
  }
  else{
    ret <- source.path
  }
  ret
}