R/onattach.R

Defines functions cites_status cites_db_delete .onAttach in_chk

Documented in cites_db_delete cites_status

in_chk <- function() {
  any(
    grepl("check",
          sapply(sys.calls(), function(a) paste(deparse(a), collapse = "\n"))
    )
  )
}

.onAttach <- function(libname, pkgname) {  #nolint
  if (interactive() && Sys.getenv("RSTUDIO") == "1"  && !in_chk()) {
    cites_pane()
  }
  if (interactive()) cites_status()
}

#' Remove the local CITES database
#'
#' Deletes all tables from the local database
#'
#' @return NULL
#' @export
#' @importFrom DBI dbListTables dbRemoveTable
#'
#' @examples
#' \donttest{
#' \dontrun{
#' cites_db_delete()
#' }
#' }
cites_db_delete <- function() {
  cites_disconnect()
  unlink(cites_path(), recursive = TRUE, force = TRUE, expand = FALSE)
}


#' Get the status of the current local CITES database
#'
#' @param verbose Whether to print a status message
#'
#' @return TRUE if the database exists, FALSE if it is not detected. (invisible)
#' @export
#' @importFrom DBI dbExistsTable
#' @importFrom tools toTitleCase
#' @examples
#' cites_status()
cites_status <- function(verbose = TRUE) {
  if (DBI::dbExistsTable(cites_db(), "cites_shipments") &&
      DBI::dbExistsTable(cites_db(), "cites_status")) {
    status <- DBI::dbReadTable(cites_db(), "cites_status")
    status_msg <-
      paste0(
        "CITES database status:\n",
        paste0(toTitleCase(gsub("_", " ", names(status))),
               ": ", as.matrix(status),
               collapse = "\n"
        )
      )
    out <- TRUE
  } else {
    status_msg <- "Local CITES database empty or corrupt. Download with cites_db_download()" #nolint
    out <- FALSE
  }
  if (verbose) message(status_msg)
  invisible(out)
}
ropensci/citesdb documentation built on May 13, 2023, 1:53 a.m.