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')))