feat: improve Soil Data Access metrics for soilDB usage

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: soilDB
 Type: Package
 Title: Soil Database Interface
-Version: 2.8.13
+Version: 2.8.14
 Authors@R: c(person(given="Dylan", family="Beaudette", role = c("aut"), email = "[email protected]", comment=c(ORCID="0009-0008-2780-4785")),
              person(given="Jay", family="Skovlin", role = c("aut")), 
              person(given="Stephen", family="Roecker", role = c("aut")), 

R/SDA_query.R

@@ -105,6 +105,55 @@ format_SQL_in_statement <- function(x) {
 #'    str(x)
 #' }
 SDA_query <- function(q, dsn = NULL) {
+
+  # construct header for SDA metrics
+  fn <- NULL
+  fne <- NULL
+
+  tryCatch({
+    ## prepend info about the caller as query comment header
+    calls <- sys.calls()
+
+    # prevent iteration over very large call stacks
+    if (length(calls) > 100) {
+      calls <- calls[1:100]
+    }
+
+    # determine environment name for each call stack
+    envs <- sapply(calls, function(x)
+      try(environmentName(environment(eval(x[[1]]))), silent = TRUE))
+
+    # keep only soilDB calls
+    calls <- calls[grepl("soilDB", as.character(envs))]
+
+    # extract the function call and environment name
+    fn <- calls[[1]][[1]]
+    fne <- try(environmentName(environment(eval(fn))), silent = TRUE)
+
+    # handle namespaced function calls
+    fn <- as.character(fn)[length(fn)]
+  }, error = function(e) {
+    # silently skip to fallback on error
+  }, finally = {
+    if (length(fn) == 0 ||
+        !nzchar(fn) ||
+        !nzchar(fne) ||
+        inherits(fne, 'try-error')) {
+      fn <- "SDA_query"
+      fne <- "soilDB"
+    }
+  })
+
+  if (nzchar(fne)) {
+    sep <- "::"
+    if (fne == "soilDB" && startsWith(fn, ".")) {
+      sep <- ":::"
+    }
+    fn <- paste0(fne, sep, fn)
+  }
+
+  q <- paste0(.SDA_comment_header(fn), "\n", q)
+
   if (is.null(dsn)) {
     res <- .SDA_query(q)
     if (inherits(res, 'try-error')) {

R/utils.R

@@ -15,6 +15,45 @@
   }, simplify = FALSE)))
 }
 
+#' Generate SDA SQL Comment Header
+#'
+#' This function generates a standardized SQL comment header string to be
+#' prepended to SDA queries.
+#'
+#' @param function_name Character. The name of the high-level `soilDB` function
+#'   generating the query.
+#' @param package_version Character. The current version of the `soilDB`
+#'   package.
+#'
+#' @return A character string containing the SQL comment header.
+#' @noRd
+#' @keywords internal
+#'
+#' @examples
+#' generate_SDA_comment_header("soilDB::get_SDA_property")
+.SDA_comment_header <- function(function_name,
+                                package_version = as.character(packageVersion('soilDB'))) {
+
+  if (!is.character(function_name) ||
+      length(function_name) != 1 ||
+      nchar(function_name) == 0) {
+    stop("`function_name` must be a non-empty character string.")
+  }
+
+  if (!is.character(package_version) ||
+      length(package_version) != 1 ||
+      nchar(package_version) == 0) {
+    stop("`package_version` must be a non-empty character string.")
+  }
+
+  # Construct the SQL comment header
+  sprintf(
+    "/** SDA Query application='soilDB' rule='%s' version='%s' **/",
+    function_name,
+    package_version
+  )
+}
+
 # convert diagnostic horizon info into wide-formatted, boolean table
 .diagHzLongtoWide <- function(d, feature = 'featkind', id = 'peiid') {