Merge pull request #169 from parmsam-pfizer/167_capture_repo_urls

Add argument to capture repo URLs

NEWS.md

@@ -1,9 +1,9 @@
 # logrx 0.3.0
 
+- Add `show_repo_url` option in `axecute()` to capture repo URL(s) into log file (#167)
 - Moved website theme to bootstarp 5, enabled search (#179)
 - Add `include_rds` argument to `axecute()` to export log as rds file
 
-
 # logrx 0.2.2
 
  - Hotfix to remove unnecessary `across()` and update `.data$var` top new syntax to match updates in source packages (#172)

R/axecute.R

@@ -19,6 +19,8 @@
 #' * messages: any messages generated by program execution
 #' * output: any output generated by program execution
 #' * result: any result generated by program execution
+#' @param show_repo_url Boolean. Should the repository URLs be reported
+#' Defaults to FALSE
 #'
 #' @importFrom purrr map_chr
 #'
@@ -38,7 +40,8 @@ axecute <- function(file, log_name = NA,
                     remove_log_object = TRUE,
                     include_rds = FALSE,
                     quit_on_error = TRUE,
-                    to_report = c("messages", "output", "result")){
+                    to_report = c("messages", "output", "result"),
+                    show_repo_url = FALSE){
 
    # lower everything for consistency and check values
    to_report <- map_chr(to_report, tolower)
@@ -56,6 +59,7 @@ axecute <- function(file, log_name = NA,
    # write log
    log_write(file = file,
              remove_log_object = remove_log_object,
+             show_repo_url = show_repo_url,
              include_rds = include_rds,
              to_report = to_report)
 

R/get.R

@@ -290,3 +290,15 @@ get_lint_results <- function(file) {
       lint(file, getOption('log.rx.lint'))
    }
 }
+
+#' Get repository URLs
+#'
+#' Obtain repository URLs possibly used to install packages in session
+#'
+#' @return results from `getOption("repos")` as list
+#'
+#' @noRd
+#'
+get_repo_urls <- function() {
+   as.list(getOption("repos"))
+}

R/log.R

@@ -83,7 +83,8 @@ log_config <- function(file = NA, log_name = NA, log_path = NA){
       "unapproved_packages_functions",
       "lint_results",
       "log_name",
-      "log_path")
+      "log_path",
+      "repo_urls")
 
    # Add attributes to the log.rx environment, and set them to NA
    for (key in 1:length(keys)){
@@ -108,6 +109,8 @@ log_config <- function(file = NA, log_name = NA, log_path = NA){
    set_log_name_path(log_name, log_path)
    # lint results
    set_log_element("lint_results", get_lint_results(file))
+   # repo urls
+   set_log_element("repo_urls", get_repo_urls())
 }
 
 #' Cleaning-up of log.rx object
@@ -156,6 +159,8 @@ log_cleanup <- function() {
 #' writing the log file? Defaults to TRUE
 #' @param to_report String vector. Objects to optionally report; additional
 #' information in \code{\link{axecute}}
+#' @param show_repo_url Boolean. Should the repo URLs be reported
+#' Defaults to FALSE
 #'
 #' @return Nothing
 #' @export
@@ -179,6 +184,7 @@ log_cleanup <- function() {
 #' log_write(file)
 log_write <- function(file = NA,
                       remove_log_object = TRUE,
+                      show_repo_url = FALSE,
                       include_rds = FALSE,
                       to_report = c("messages", "output", "result")){
    # Set end time and run time
@@ -213,6 +219,12 @@ log_write <- function(file = NA,
                         write_log_header("Session Information"),
                         write_session_info())
 
+   if (show_repo_url) {
+      cleaned_log_vec <- c(cleaned_log_vec,
+                           write_log_header("Repo URLs"),
+                           write_repo_urls())
+   }
+
    if ("masked_functions" %in% names(log_cleanup())) {
       cleaned_log_vec <- c(cleaned_log_vec,
                            write_log_header("Masked Functions"),

R/writer.R

@@ -63,6 +63,28 @@ write_session_info <- function(){
    return(session_info)
 }
 
+#' Format repo URLs for writing
+#'
+#' @return A vector of file name and path prefixed
+#'
+#' @noRd
+#'
+write_repo_urls <- function(){
+   repo_urls <- ifelse(is.na(get_log_element("repo_urls")),
+                       "Repo URLs not able to be determined",
+                       map2(
+                          names(get_log_element("repo_urls")),
+                          get_log_element("repo_urls"),
+                          ~paste(paste0(.x, ": "),
+                                 paste0(.y, collapse = ", "))
+                       ) %>%
+                          unname() %>%
+                          unlist()
+   )
+
+   return(repo_urls)
+}
+
 #' Format file name and path for writing
 #'
 #' @return A vector of file name and path prefixed

tests/testthat/test-axecute.R

@@ -67,6 +67,47 @@ test_that("to_report works to control log output elements", {
    log_remove()
 })
 
+test_that("show_repo_url works to show repo url elements", {
+   options("log.rx" = NULL)
+   scriptPath <- tempfile()
+   logDir <- tempdir()
+   writeLines(
+      c("message('hello logrx')",
+        "cat('this is output')",
+        "data.frame(c(8, 6, 7, 5, 3, 0, 9))"),
+      con = scriptPath)
+
+   # check no log is currently written out
+   expect_warning(expect_error(file(file.path(logDir, "log_out_repo_url"), "r"), "cannot open the connection"))
+
+   axecute(scriptPath, log_name = "log_out_repo_url",
+           log_path = logDir,
+           remove_log_object = FALSE,
+           show_repo_url = TRUE
+   )
+   con <- file(file.path(logDir, "log_out_repo_url"), "r")
+   flines <- readLines(con)
+   close(con)
+
+   expect_true(grepl(paste(write_log_header("Repo URLs"), collapse = ','),
+                     paste(flines,collapse = ',')))
+   rm(flines, con)
+   log_remove()
+
+   axecute(scriptPath, log_name = "log_out_repo_url2",
+           log_path = logDir,
+           remove_log_object = FALSE,
+           show_repo_url = FALSE
+   )
+   con <- file(file.path(logDir, "log_out_repo_url2"), "r")
+   flines <- readLines(con)
+   close(con)
+
+   expect_false(grepl(paste(write_log_header("Repo URLs"), collapse = ','),
+                      paste(flines,collapse = ',')))
+   rm(flines, con, scriptPath, logDir)
+})
+
 test_that("include_rds works to output log as rds", {
    options("log.rx" = NULL)
    scriptPath <- tempfile()

tests/testthat/test-log.R

@@ -13,7 +13,7 @@ test_that("log_config configures the log and all the necessary elements", {
                      "result","output","start_time", "end_time", "run_time",
                      "file_name","file_path","user", "hash_sum", "masked_functions",
                      "used_packages_functions", "unapproved_packages_functions",
-                     "lint_results", "log_name","log_path"))
+                     "lint_results", "log_name","log_path", "repo_urls"))
 
    expect_identical(getOption("log.rx")[['file_path']], dirname(get_file_path('./test-get.R')))
    expect_identical(getOption("log.rx")[['file_name']], basename(get_file_path('./test-get.R')))