R/trace_functions.R

Defines functions clean_traces trace_function clean_trace end_trace start_trace

Documented in clean_trace clean_traces end_trace start_trace trace_function

#' @title Trace functions which create files
#' @description Some functions create output files during their execution;
#'  some of them are slow, so the probability that something goes wrong
#'  during their execution is not null, with the consequence that output
#'  files are incomplete, or that undesired temporary files are left on
#'  the filesystem.
#'
#'  This functions is though to manage these situations.
#'
#'  [trace_function] runs a function and checks if errors occur during its execution;
#'  in this case, the files created by it are deleted (only if the timestamp
#'  of the files is subsequent to the time of execution of the function).
#'  If the code interrupts before the function ends, the paths of the files
#'  intended to be created by the function are saved within the package, so that
#'  they can be easily deleted in a second time; to do it, simply
#'  run [clean_traces].
#'
#'  Other intermediate functions are used internally:
#'  [start_trace] saves the paths of the files intended to be created within
#'  a text file;
#'  [end_trace] deletes this text file (it is used by [trace_function] when
#'  a function stops without errors);
#'  [clean_trace] deletes this text file and the intended output files (it is
#'  used by [trace_function] when a function stops with errors).
#'
#' @param trace_fun The function to be run.
#' @param ... Arguments of the function `fun`
#' @param trace_files Vector of the files intended to be created by `fun`
#'  (for now, providing it is mandatory). Also temporary files can be indicated
#'  here.
#' @param trace_funname The name of the function to be run (in [start_trace]) or
#'  to be cleaned (in [clean_traces]; if NA, all the traces are cleaned).
#' @param tracename The path of the text file containing the log information
#'  generated by [start_trace].
#' @return NULL (the function is called for its side effects)
#' @author Luigi Ranghetti, phD (2019)
#' @references L. Ranghetti, M. Boschetti, F. Nutini, L. Busetto (2020).
#'  "sen2r": An R toolbox for automatically downloading and preprocessing 
#'  Sentinel-2 satellite data. _Computers & Geosciences_, 139, 104473. 
#'  \doi{10.1016/j.cageo.2020.104473}, URL: \url{https://sen2r.ranghetti.info/}.
#' @note License: GPL 3.0
#' @importFrom methods is

#' @name start_trace
#' @rdname trace_function
#' @keywords internal
start_trace <- function(trace_files, trace_funname) {
  
  # path in which trace txt files are placed
  trace_path <- file.path(dirname(attr(load_binpaths(), "path")),"logs")
  dir.create(trace_path, showWarnings = FALSE)
  
  # define name of the tracelog
  tracename <- file.path(
    trace_path,
    paste0(
      strftime(Sys.time(), "%y%m%d%H%M%S"), "_",
      trace_funname, ".txt"
    )
  )
  
  # write tracename with the paths of the expected files
  writeLines(trace_files, tracename)
  # return its path
  tracename
  
}


#' @name end_trace
#' @rdname trace_function
end_trace <- function(tracename) {
  if (file.exists(tracename)) {unlink(tracename)}
}


#' @name clean_trace
#' @rdname trace_function
clean_trace <- function(tracename) {
  
  # do nothing if tracename does not exist
  if (!file.exists(tracename)) {return(invisible(NULL))}
  
  # retrieve when the trace started
  tracetime <- as.POSIXct(
    gsub("^([0-9]+)\\_.*\\.txt$","\\1",basename(tracename)),
    format="%y%m%d%H%M%S"
  )
  # read expected output filenames
  outfilenames <- readLines(tracename)
  
  # delete files if they were created after tracetime
  for (outfilename in outfilenames) {
    if (file.exists(outfilename)) {
      outfiletime <- file.mtime(outfilename)
      if (outfiletime > tracetime) {
        unlink(outfilename, recursive=TRUE)
      }
    }
  }
  
  # delete trace file
  unlink(tracename)
  
}


#' @name trace_function
#' @rdname trace_function
trace_function <- function(trace_fun, trace_files, trace_funname=NA, ...) {
  
  # Start tracing
  if (is.na(trace_funname)) {
    trace_funname <- deparse(substitute(trace_fun))
  }
  tracename <- start_trace(trace_files, trace_funname)
  
  # run function
  fun_out <- tryCatch(
    trace_fun(...),
    error = print
  )
  
  # in case of errors, clean the ouput and return an error;
  # otherwise, end the trace and return the output
  if (is(fun_out, "error")) {
    clean_trace(tracename)
    stop(fun_out)
  } else {
    end_trace(tracename)
    return(fun_out)
  }
  
}


#' @name clean_traces
#' @rdname trace_function
clean_traces <- function(trace_funname=NA) {
  
  # import the content of the path in which trace txt files are placed
  trace_path <- system.file("logs",package="sen2r")
  tracenames_df <- data.frame(
    "name" = list.files(trace_path, "^([0-9]+)\\_(.*)\\.txt$", full.names = TRUE),
    stringsAsFactors = FALSE
  )
  tracenames_df$time <- as.POSIXct(
    gsub("^([0-9]+)\\_(.*)\\.txt$","\\1",basename(tracenames_df$name)),
    format="%y%m%d%H%M%S"
  )
  tracenames_df$fun <- gsub("^([0-9]+)\\_(.*)\\.txt$","\\2",basename(tracenames_df$name))
  # if required, filter on trace_funname
  if (!is.na(trace_funname)) {
    tracenames_df <- tracenames_df[tracenames_df$fun==trace_funname,]
  }
  # if empty, exit
  if (nrow(tracenames_df)==0) {return(invisible(NULL))}
  
  # read the names of the single files
  outfilenames <- lapply(tracenames_df$name, readLines)
  outfiles_df <- data.frame(
    "name" = unlist(outfilenames),
    "tracename" = rep(tracenames_df$name, sapply(outfilenames, length)),
    stringsAsFactors = FALSE
  )
  outfiles_df$time <- file.mtime(outfiles_df$name)
  outfiles_df$tracetime <- tracenames_df[
    match(outfiles_df$tracename, tracenames_df$name),
    "time"
    ]
  
  # delete files if they were created after each tracetime
  for (i in seq_len(nrow(outfiles_df))) {
    if (file.exists(outfiles_df[i,"name"])) {
      if (outfiles_df[i,"time"] > outfiles_df[i,"tracetime"]) {
        unlink(outfiles_df[i,"name"], recursive=TRUE)
      }
    }
  }
  
  # delete trace files
  unlink(tracenames_df$name)
  
}

Try the sen2r package in your browser

Any scripts or data that you put into this service are public.

sen2r documentation built on Nov. 10, 2023, 9:08 a.m.