# CommandArgs.R
######
# CommandArgsRefClass
######
CommandArgsRefClass <- setRefClass("CommandArgsRefClass",
fields = list(
Name = 'character', #the name of the script
cmdargs = 'character', # character vector
app = 'character', # the name of the application
options = 'character', # character vector of --options
filename = 'character', # the name of the script called
Args = 'list', # of ArgumentRefClass objects
help = 'character')
)
#' Parse the argument vector into \code{\link{Argument}} objects
#'
#' @family CommandArgs
#' @name CommandArgs_parse_arguments
#' @param args input of the value of \code{\link{commandArgs}}
#' @param quit_if_help logical, if TRUE call \code{quit(...)} if arguments include -h or --help
#' @param ... futher arguments for \code{quit(...)}
#' @return a vector of logicals, one per argument
NULL
CommandArgsRefClass$methods(
parse_arguments = function(args, quit_if_help = !interactive(), ...){
if (!missing(args)) .self$field("cmdargs", args)
if (is.null(.self$cmdargs)) stop("args must be supplied in parse_arguments() or CommandArgs()")
allargs <- .self$cmdargs
.self$field("app", allargs[[1]])
ix <- grep("--file", allargs, fixed = TRUE)
if (length(ix) > 0){
.self$field("filename", gsub("--file=", "", allargs[ix[[1]]], fixed = TRUE))
if (.self$Name == "program_name") .self$field("Name", basename(.self$filename))
if (ix > 2) .self$field("options", allargs[2:(ix[1]-1)])
}
OK <- TRUE
ix <- grep("--args", allargs, fixed = TRUE)
if ((length(ix) > 0) && (length(allargs) > ix[1] ) ) {
trailingArgs <- allargs[(ix[1] + 1) : length(allargs)]
nm <- names(.self$Args)
OK <- rep(FALSE, length(nm)) ; names(OK) <- nm
for (n in nm) OK[n] <- .self$Args[[n]]$parse_argument(trailingArgs)
}
if (.self$help_called()){
.self$print_help()
if (quit_if_help) quit(...)
}
invisible(OK)
})
#' Add an argument definition
#' See \code{link{Argument}} for input details
#'
#' @family CommandArgs
#' @name CommandArgs_add_argument
#' @param name the name of the argument to add
#' @param ... furtehr arguments for the \code{\link{Argument}} to be defined
NULL
CommandArgsRefClass$methods(
add_argument = function(name, ...){
.self$Args[[name]] <- Argument(name, ...)
})
#' Add an argument definition
#' See \code{link{Argument}} for input details
#'
#' @family CommandArgs
#' @name CommandArgs_add
#' @param name the name of the argument to add
#' @param ... further arguments for the \code{\link{Argument}} to be defined
NULL
CommandArgsRefClass$methods(
add = function(name, ...){
.self$Args[[name]] <- Argument(name, ...)
})
#' Print information about the object
#'
#' @family CommandArgs
#' @name CommandArgs_show
NULL
CommandArgsRefClass$methods(
show = function(){
cat("Reference Class:", classLabel(class(.self)), "\n")
cat("args:", dQuote(paste(.self$cmdargs, collapse = " ")), "\n")
cat("app:", .self$app, "\n")
cat("options:", .self$options, "\n")
cat("filename:", .self$filename, "\n")
cat("Argument listing follows...\n")
nm <- names(.self$Args)
for (n in nm) .self$Args[[n]]$show()
})
#' Print usage help
#'
#' @family CommandArgs
#' @name CommandArgs_print_help
NULL
CommandArgsRefClass$methods(
print_help = function(commandstring = .self$Name){
nm <- names(.self$Args)
u <- sapply(.self$Args, function(x) x$get_usage())
u <- paste(c(commandstring, u), collapse = " ")
u <- strwrap(c("Usage: ", u), exdent = 5, width = 80)
writeLines(u)
cat("\nArgument details follow\n")
for (n in nm) .self$Args[[n]]$print_help()
})
#' Test is the named argument is present
#'
#' @family CommandArgs
#' @name CommandArgs_get
#' @param name the name of the argument to test
#' @return logical indicating is (or is not) present
NULL
CommandArgsRefClass$methods(
has = function(name){
name %in% names(.self$Args)
})
#' Get the value(s) of an argument
#'
#' @family CommandArgs
#' @name CommandArgs_get
#' @param name the name of the argument to retrieve
#' @param ... futher arguments for the \code{Argument$get()} method requested
#' @return the value of the argument (type varies)
NULL
CommandArgsRefClass$methods(
get = function(name, ...){
.self$Args[[name]]$get(...)
})
#' Get all arguments
#'
#' @family CommandArgs
#' @name CommandArgs_get_all
#' @param ... futher arguments for the \code{Argument$get()} method requested
#' @return a list of key-value pairs
NULL
CommandArgsRefClass$methods(
get_all = function(...){
name <- names(.self$Args)
names(name) <- name
lapply(name, function(x, ARGS,...) {ARGS[[x]]$get(...)}, .self$Args, ...)
})
#' Detect if user called for help using "--help" or "-h"
#'
#' @family CommandArgs
#' @name CommandArgs_help_called
#' @return logical, TRUE if --help or -h exists
NULL
CommandArgsRefClass$methods(
help_called = function(){
if (is.null(.self$cmdargs) || (nchar(.self$cmdargs) == 0)){
stop("CommandArgsRefClass$help_called requires that command args have been loaded")
}
any(.self$cmdargs == "--help") || any(.self$cmdargs == "-h")
})
# Note from Joe
# the convention is single dash for single letter args and double dash for multi-letter
######
# methods above, functions below
######
#' Generate a CommandArgs reference
#'
#' @family CommandArgs
#' @export
#' @param args a character vector as returned by \code{\link{commandArgs}}
#' or NULL
#' @param name character name of the object
#' @param help a character vector of helpful information
#' @return a CommandArgsRefClass instance
CommandArgs <- function(args = commandArgs(trailingOnly = FALSE),
name = 'program_name',
help = NULL){
x <- CommandArgsRefClass$new()
x$field("Args", list())
if (!is.null(args)) x$field("cmdargs", args)
if (!is.null(help)) x$field("help", help)
x$field("Name", name[1])
x
}
#' Retrieve dummy arguments ala \code{commandArgs(trailingOnly = FALSE)}
#'
#' Note that the value returned is a hint or reminder. Your best bet is to test drive
#' your own configuration.
#'
#' @export
#' @param os character the name of the operating system to mimic.
#' @return character vector of typical command arguments
dummy_commandArgs <- function(os = c("linux", "darwin")[1]){
leader <- switch(tolower(os[1]),
"linux" = c( "/usr/lib64/R/bin/exec/R", "--slave", "--no-restore", "--vanilla"),
"darwin"= c("/Library/Frameworks/R.framework/Resources/bin/exec/R", "--no-save",
"--no-restore", "--no-site-file", "--no-environ"))
c(leader,
"--file=/bipitty/bopitty/boo.Rscript",
"--args",
"--foo", "bar",
"--date", format(Sys.Date(), "%j"),
"--version", "v0.00")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.