R/utils.R

Defines functions fill_query pcd_query qrc_link

Documented in fill_query pcd_query qrc_link

#' @title fill_query
#' @description Fills query with start and end date given by user or defaults to past 13 months.
#'
#' @param query Query to fill.
#' @param range Character vector of date range. Defaults to past 13 months.
#'
#' @return Returns filled query.
fill_query <- function(query, range) {

  if (all(is.na(range))) {
    start <- paste0("'",
                    strftime(lubridate::floor_date(Sys.time(), 'month') - months(13),
                             format = '%Y-%m-%d'),
                    "'")
    end <- paste0("'",
                  strftime(lubridate::ceiling_date(Sys.time(), 'month') - months(1),
                           format = '%Y-%m-%d'),
                  "'")

    daterange <- c(start, end)
  } else {
    start <- paste0("'", range[1], "'")
    end <- paste0("'", range[2], "'")
    daterange <- c(start, end)
  }

  query <- gsub('%start', daterange[1], query)
  query <- gsub('%end', daterange[2], query)

  return(query)
}

#' @title pcd_query
#'
#' @description Function to query Product Complaint Database (PCD).
#'
#' @param dsn Server name. Set as PCD_DSN in .Renviron file.
#' @param db Database name.
#' @param uid User ID. Set as PCD_USER in .Renviron file.
#' @param pwd Password. Set as PCD_PWD in .Renviron file.
#' @param query Query to send to PCD.
#'
#' @return Returns results of query.
pcd_query <- function(
  dsn = Sys.getenv('PCD_DSN'),
  db = '',
  uid = Sys.getenv('PCD_USER'),
  pwd = Sys.getenv('PCD_PWD'),
  query
) {

  connect_string <- switch(
    Sys.info()['sysname'],
    Linux = sprintf(
      'Driver={ODBC Driver 13 for SQL Server};Server=%s;Database=%s;Uid=%s;Pwd=%s;',
      dsn, db, uid, pwd
    ),
    Windows = sprintf(
      'driver={SQL Server};server=%s;database=%s;uid=%s;pwd=%s;',
      dsn, db, uid, pwd
    )
  )

  channel <- RODBC::odbcDriverConnect(connection = connect_string)

  results <- RODBC::sqlQuery(
    channel = channel,
    query = query,
    stringsAsFactors = FALSE
  ) %>%
    dplyr::mutate_if(is.character, trimws)

  RODBC::odbcClose(channel)
  return(results)
}

#' @title qrc_link
#' @description Utility function to allow function to query qrc_link database.
#' Can query qrc_raw if needed by changed db.
#'
#' @param query Query to send to database.
#' @param dbhost Host IP address. Set to QRC_DB_HOST in .Renviron.
#' @param port Port that server is listening on. Defaults to 5432.
#' @param uid User ID. Set as QRC_DB_USER in .Renviron file.
#' @param pwd Password. Set as QRC_DB_PWD in .Renviron file.
#' @param db Database name.
#'
#' @return Returns query results in dataframe.
#' @export
qrc_link <- function(
  query,
  dbhost = Sys.getenv('QRC_DB_HOST'),
  port = 5432,
  uid = Sys.getenv('QRC_DB_USER'),
  pwd = Sys.getenv('QRC_DB_PWD'),
  db = 'qrc_link'
) {
  con <- DBI::dbConnect(drv = RPostgreSQL::PostgreSQL(),
                        dbname = db,
                        host = dbhost,
                        port = port,
                        user = uid,
                        password = pwd)

  df <- DBI::dbGetQuery(conn = con,
                        statement = query)

  DBI::dbDisconnect(conn = con)
  return(df)
}
kimjam/qrcutils documentation built on May 20, 2019, 10:21 p.m.