etnservice/R/get_acoustic_projects.R at 9864fcd34e52477dbe8467102efc2594bea109d4 · inbo/etnservice · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
#' Get acoustic project data
#'
#' Get data for acoustic projects, with options to filter results.
#'
#' @param credentials A list with the username and password to connect to the ETN database.
#' @param acoustic_project_code Character (vector). One or more acoustic
#'   project codes. Case-insensitive.
#'
#' @return A tibble with acoustic project data, sorted by `project_code`. See
#'   also
#'   [field definitions](https://inbo.github.io/etn/articles/etn_fields.html).
#'
#' @export
#'
#' @examples
#' # Set credentials
#' credentials <- list(
#'    username = Sys.getenv("ETN_USER"),
#'    password = Sys.getenv("ETN_PWD")
#'  )
#'
#' # Get all acoustic projects
#' get_acoustic_projects(credentials)
#'
#' # Get a specific acoustic project
#' get_acoustic_projects(credentials, acoustic_project_code = "demer")
get_acoustic_projects <- function(credentials = list(
                                    username = Sys.getenv("ETN_USER"),
                                    password = Sys.getenv("ETN_PWD")
                                  ),
                                  acoustic_project_code = NULL) {

  # Check if credentials object has right shape
  check_credentials(credentials)

  # create connection object
  connection <-
    connect_to_etn(credentials$username, credentials$password)

  # Ensure the connection is closed when the function exits, even when it fails.
  withr::defer(
    if (DBI::dbIsValid(connection)) {
      DBI::dbDisconnect(connection)
    }
  )

  # Check connection
  check_connection(connection)

  # Check acoustic_project_code
  if (is.null(acoustic_project_code)) {
    acoustic_project_code_query <- "True"
  } else {
    acoustic_project_code <- check_value(
      acoustic_project_code,
      list_acoustic_project_codes(credentials),
      "acoustic_project_code",
      lowercase = TRUE
    )
    acoustic_project_code_query <- glue::glue_sql(
      "LOWER(project.project_code) IN ({acoustic_project_code*})",
      .con = connection
    )
  }

  project_sql <- glue::glue_sql(
    readr::read_file(system.file("sql", "project.sql", package = "etnservice")),
    .con = connection
  )

  # Build query
  query <- glue::glue_sql("
    SELECT
      project.*
    FROM
      ({project_sql}) AS project
    WHERE
      project_type = 'acoustic'
      AND {acoustic_project_code_query}
    ", .con = connection)
  projects <- DBI::dbGetQuery(connection, query)

  # Close connection
  DBI::dbDisconnect(connection)

  # Sort data
  projects <-
    projects |>
    dplyr::arrange(.data$project_code)

  dplyr::as_tibble(projects)
}