update to latest configure

Author: kevinushey

RcppParallel.Rproj

@@ -13,5 +13,5 @@ RnwWeave: Sweave
 LaTeX: pdfLaTeX
 
 BuildType: Package
-PackageInstallArgs: --with-keep.source
+PackageInstallArgs: --with-keep.source --clean
 PackageCheckArgs: --as-cran

cleanup

@@ -1,3 +1,3 @@
 #!/usr/bin/env sh
 :${R_HOME=`R RHOME`}
-"${R_HOME}/bin/R" --vanilla --slave -f tools/config/cleanup.R
+"${R_HOME}/bin/Rscript"tools/config.R cleanup

cleanup.win

@@ -1,2 +1,2 @@
 #!/usr/bin/env sh
-"${R_HOME}/bin${R_ARCH_BIN}/R.exe"--vanilla --slave -f tools/config/cleanup.R
+"${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" tools/config.R cleanup

configure

@@ -1,3 +1,3 @@
 #!/usr/bin/env sh
 :${R_HOME=`R RHOME`}
-"${R_HOME}/bin/R" --vanilla --slave -f tools/config/configure.R
+"${R_HOME}/bin/Rscript"tools/config.R configure

configure.win

@@ -1,2 +1,2 @@
 #!/usr/bin/env sh
-"${R_HOME}/bin${R_ARCH_BIN}/R.exe"--vanilla --slave -f tools/config/configure.R
+"${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" tools/config.R configure

tools/config.R

@@ -0,0 +1,343 @@
+# configure-database.R ----
+
+#' Retrieve the Global Configuration Database
+#'
+#' Retrieve the global configuration database (as an \R environment).
+#'
+#' @family configure-db
+#'
+#' @export
+configure_database<- local({
+database<- new.env(parent= emptyenv())
+function() database
+})
+
+#' Define Variables for the Configuration Database
+#'
+#' Define variables to be used as part of the default configuration database.
+#' These will be used by [configure_file()] when no configuration database
+#' is explicitly supplied.
+#'
+#' @param ... A set of named arguments, mapping configuration names to values.
+#'
+#' @family configure-db
+#'
+#' @export
+configure_define<-function(...){
+envir<- configure_database()
+ list2env(list(...), envir=envir)
+}
+
+#' @export
+define<-configure_define
+
+
+# utils.R ----
+
+#' Configure a File
+#'
+#' Configure a file, replacing any instances of `@`-delimited variables, e.g.
+#' `@VAR@`, with the value of the variable called `VAR` in the associated
+#' `config` environment.
+#'
+#' @param source The file to be configured.
+#' @param target The file to be generated.
+#' @param config The configuration database.
+#' @param verbose Boolean; report files as they are configured?
+#'
+#' @family configure
+#'
+#' @export
+configure_file<-function(
+source,
+target= sub("[.]in$", "", source),
+config= configure_database(),
+verbose= configure_verbose())
+{
+contents<- readLines(source, warn=FALSE)
+ enumerate(config, function(key, val){
+needle<- paste("@", key, "@", sep="")
+replacement<-val
+contents<<- gsub(needle, replacement, contents)
+ })
+
+ ensure_directory(dirname(target))
+ writeLines(contents, con=target)
+
+info<- file.info(source)
+ Sys.chmod(target, mode=info$mode)
+
+if (isTRUE(verbose)){
+fmt<-"** configured file: '%s' => '%s'"
+ message(sprintf(fmt, source, target))
+ }
+}
+
+#' Configure Files in a Directory
+#'
+#' This companion function to [configure_file()] can be used to
+#' configure all `.in` files within a directory.
+#'
+#' @param path The path to a directory in which files should be configured.
+#' @param config The configuration database to be used.
+#' @param verbose Boolean; report files as they are configured?
+#'
+#' @family configure
+#'
+#' @export
+configure_directory<-function(
+path=".",
+config= configure_database(),
+verbose= configure_verbose())
+{
+files<- list.files(
+path=path,
+pattern="[.]in$",
+full.names=TRUE)
+
+ lapply(files, configure_file, config=config, verbose=verbose)
+}
+
+configure_auto<-function(type){
+ configure_common(type=type)
+}
+
+configure_common<-function(type){
+
+if (!isTRUE(getOption("configure.common", default=TRUE)))
+return(invisible(FALSE))
+
+sources<- list.files(
+path= c("R", "src"),
+pattern="[.]in$",
+full.names=TRUE
+ )
+
+sources<- sub("[.]/", "", sources)
+
+if (type=="configure"){
+ lapply(sources, configure_file)
+ } elseif (type=="cleanup"){
+targets<- sub("[.]in$", "", sources)
+ lapply(targets, remove_file)
+ }
+
+invisible(TRUE)
+}
+
+#' Read R Configuration for a Package
+#'
+#' Read the \R configuration, as through `R CMD config`.
+#'
+#' @param ... The \R configuration values to read (as a character vector).
+#' If empty, all values are read as through `R CMD config --all`).
+#' @param package The path to the \R package's sources.
+#' @param envir The environment in which the configuration information should
+#' be assigned. By default, the [configure_database()] is populated with the
+#' requested values.
+#' @param verbose Boolean; notify the user as \R configuration is read?
+#'
+#' @export
+read_r_config<-function(
+...,
+package= Sys.getenv("R_PACKAGE_DIR", unset="."),
+envir= configure_database(),
+verbose= configure_verbose())
+{
+# move to requested directory
+owd<- setwd(package)
+ on.exit(setwd(owd), add=TRUE)
+R<- file.path(R.home("bin"), "R")
+
+values<- unlist(list(...), recursive=TRUE)
+if (length(values) ==0){
+if (verbose)
+ message("** executing 'R CMD config --all'")
+output<- system2(R, c("CMD", "config", "--all"), stdout=TRUE)
+equalsIndex<- regexpr("=", output, fixed=TRUE)
+keys<- trim_whitespace(substring(output, 1, equalsIndex-1))
+config<- as.list(trim_whitespace(substring(output, equalsIndex+1)))
+ names(config) <-keys
+
+ } else{
+if (verbose)
+ message("** executing 'R CMD config'")
+config<- lapply(values, function(value){
+ system2(R, c("CMD", "config", value), stdout=TRUE)
+ })
+ names(config) <-values
+ }
+
+ list2env(config, envir=envir)
+}
+
+#' Concatenate the Contents of a Set of Files
+#'
+#' Given a set of files, concatenate their contents into
+#' a single file.
+#'
+#' @param sources An \R list of files
+#' @param target The file to use for generation.
+#' @param headers Headers to be used for each file copied.
+#' @param preamble Text to be included at the beginning of the document.
+#' @param postamble Text to be included at the end of the document.
+#' @param verbose Boolean; inform the user when the requested file is created?
+#'
+#' @export
+concatenate_files<-function(
+sources,
+target,
+headers= sprintf("# %s ----", basename(sources)),
+preamble=NULL,
+postamble=NULL,
+verbose= configure_verbose())
+{
+pieces<- vapply(seq_along(sources), function(i){
+source<-sources[[i]]
+header<-headers[[i]]
+contents<- trim_whitespace(read_file(source))
+ paste(header, contents, "", sep="\n\n")
+ }, character(1))
+
+all<- c(preamble, pieces, postamble)
+
+ ensure_directory(dirname(target))
+ writeLines(all, con=target)
+
+if (verbose){
+fmt<-"** created file '%s'"
+ message(sprintf(fmt, target))
+ }
+
+TRUE
+}
+
+#' Add Configure Infrastructure to an R Package
+#'
+#' Add the infrastructure needed to configure an R package.
+#'
+#' @param package The path to the top-level directory of an \R package.
+#' @export
+use_configure<-function(package="."){
+
+# preserve working directory
+owd<- getwd()
+ on.exit(setwd(owd), add=TRUE)
+
+# find resources
+package<- normalizePath(package, winslash="/")
+resources<- system.file("resources", package="configure")
+
+# copy into temporary directory
+dir<- tempfile("configure-")
+ on.exit(unlink(dir, recursive=TRUE), add=TRUE)
+
+ dir.create(dir)
+ file.copy(resources, dir, recursive=TRUE)
+
+# rename resources directory
+ setwd(dir)
+ file.rename(basename(resources), basename(package))
+
+# now, copy these files back into the target directory
+ file.copy(basename(package), dirname(package), recursive=TRUE)
+
+# ensure DESCRIPTION contains 'Biarch: TRUE' for Windows
+ setwd(package)
+DESCRIPTION<- read_file("DESCRIPTION")
+if (!grepl("(?:^|\n)Biarch:", DESCRIPTION)){
+DESCRIPTION<- paste(DESCRIPTION, "Biarch: TRUE", sep="\n")
+DESCRIPTION<- gsub("\n{2,}", "\n", DESCRIPTION)
+ cat(DESCRIPTION, file="DESCRIPTION", sep="\n")
+ }
+}
+
+ensure_directory<-function(dir){
+info<- file.info(dir)
+
+# no file exists at this location; try to make it
+if (is.na(info$isdir)){
+ dir.create(info$isdir, recursive=TRUE, showWarnings=FALSE)
+if (!file.exists(dir))
+ stop("failed to create directory '", dir, "'")
+return(TRUE)
+ }
+
+# a directory already exists
+if (isTRUE(info$isdir))
+return(TRUE)
+
+# a file exists, but it's not a directory
+ stop("file already exists at path '", dir, "'")
+}
+
+enumerate<-function(x, f, ...){
+nms<-if (is.environment(x)) ls(envir=x) else names(x)
+ lapply(nms, function(nm){
+ f(nm, x[[nm]], ...)
+ })
+}
+
+read_file<-function(path){
+ paste(readLines(path, warn=FALSE), collapse="\n")
+}
+
+remove_file<-function(
+path,
+verbose= configure_verbose())
+{
+info<- file.info(path)
+if (!is.na(info$isdir)){
+ unlink(path, recursive= isTRUE(info$isdir))
+if (verbose){
+fmt<-"** removed file '%s'"
+ message(sprintf(fmt, path))
+ }
+ }
+
+TRUE
+}
+
+source_file<-function(
+path,
+envir= parent.frame())
+{
+contents<- read_file(path)
+invisible(eval(parse(text=contents), envir=envir))
+}
+
+trim_whitespace<-function(x){
+ gsub("^[[:space:]]*|[[:space:]]*$", "", x)
+}
+
+configure_verbose<-function(){
+ getOption("configure.verbose", !interactive())
+}
+
+
+# run.R ----
+
+local({
+
+# extract path to install script
+args<- commandArgs(TRUE)
+type<-args[[1]]
+
+# report start of execution
+package<- Sys.getenv("R_PACKAGE_NAME", unset="<unknown>")
+fmt<-"* preparing to %s package '%s' ..."
+ message(sprintf(fmt, type, package))
+
+# execute the requested script
+path<- sprintf("tools/config/%s.R", type)
+if (file.exists(path)) source_file(path)
+
+# perform automatic configuration
+ configure_auto(type=type)
+
+# report end of execution
+fmt<-"* finished %s for package '%s'"
+ message(sprintf(fmt, type, package))
+})
+
+