Nothing
## TODO: time_i.out
finalize_check_results <- function(check_results_dir,
path_to_pkg_src,
check_args,
timings,
check_results_files = c("SUMMARY",
"check.csv",
"time_c.out")){
## search check directory for check results
## check_results_dir <- "/srv/rsync/R-Forge.check/R-devel"
## path_to_pkg_src <- "/srv/R/pkgs"
PKGS <- file.path(check_results_dir, "PKGS")
Rcheck <- dir(PKGS)
Rcheck <- Rcheck[grep(".Rcheck$", Rcheck)]
## successfully checked
##pkgs <- gsub(".Rcheck$", "", Rcheck)
path_to_install_logs <- file.path(check_results_dir, "installout")
if(!file.exists(path_to_install_logs))
dir.create(path_to_install_logs)
## provide DESCRIPTION metadata in directories with check results
## FIXME: only works on Linux as path_to_pkg_src is only there available
for(dir in Rcheck){
pkg <- gsub(".Rcheck$", "", dir)
file.copy(file.path(path_to_pkg_src, pkg, "DESCRIPTION"),
file.path(PKGS, dir, "00package.dcf"))
file.copy(file.path(PKGS, dir, "00install.out"),
file.path(path_to_install_logs, sprintf("%s_install.out", pkg)), overwrite = TRUE)
}
## save old check results
suffix <- ".prev"
check_results_files <- file.path(check_results_dir, check_results_files)
for(file in check_results_files){
previous_file <- paste(file, suffix, sep = "")
if(file.exists(previous_file))
file.remove(previous_file)
if(file.exists(file))
file.rename(file, previous_file)
}
if(!check_directory(file.path(check_results_dir, "Results"), fix=TRUE))
stop(paste("There is no directory", file.path(check_results_dir, "Results"),
"!"))
today <- format(Sys.time(), "%Y-%m-%d")
results_archive <- file.path(check_results_dir, "Results", today)
if(!check_directory(results_archive, fix=TRUE))
stop(paste("There is no directory", results_archive,"!"))
## not yet included
#PKGS_prev <- paste(PKGS, suffix, sep = "")
#if(file.exists(PKGS_prev))
# unlink(PKGS_prev, recursive = TRUE)
#if(file.exists(PKGS))
# file.rename(PKGS, PKGS_prev)
##test -d PKGS && mv PKGS PKGS.prev
##mv Work/PKGS PKGS
## Move timings up.
##mv Work/time_c.out time_c.out
##mv Work/time_i.out time_i.out
write_check_timings(file = file.path(check_results_dir, "time_c.out"),
Rcheck, timings)
## Create check.csv.
write_check_csv(file = file.path(check_results_dir, "check.csv"), Rcheck,
PKGS, path_to_pkg_src, check_args)
## Create SUMMARY.
write_check_SUMMARY(file = file.path(check_results_dir, "SUMMARY"), Rcheck,
PKGS, path_to_pkg_src)
for(file in check_results_files){
file.copy(file, results_archive)
}
write_check_diffs(check_results_dir)
}
## Create check.csv.
## for testing purposes: check_args <- read.csv("/srv/R/lib/check_R_stoplist", stringsAsFactors = FALSE)
write_check_csv <- function(Rcheck, check_dir, path_to_pkg_src, check_args, file = "check.csv"){
fields <- c("Package", "Version", "Priority", "Maintainer", "Status", "Comment")
len <- length(Rcheck)
csv <- matrix(rep(NA, len * length(fields)), nrow = len)
colnames(csv) <- fields
for(i in 1:len){
dir <- Rcheck[i]
pkg <- gsub(".Rcheck$", "", dir)
## FIXME: When reading DCF files, we take the first result. E.g., BIOMOD returns the actual value plus NA. An encoding issue?
suppressWarnings(version <- tryCatch(read.dcf(file.path(path_to_pkg_src, pkg, "DESCRIPTION"), "Version")[1], error = identity))
if(inherits(version, "error"))
version <- NA
suppressWarnings(priority <- tryCatch(read.dcf(file.path(path_to_pkg_src, pkg, "DESCRIPTION"), "Priority")[1], error = identity))
if(inherits(priority, "error"))
priority <- NA
suppressWarnings(maintainer <- tryCatch(read.dcf(file.path(path_to_pkg_src,
pkg, "DESCRIPTION"), "Maintainer")[1], error = identity))
if(inherits(maintainer, "error"))
maintainer <- NA
suppressWarnings(checklog <- tryCatch(readLines(file.path(check_dir, dir,
"00check.log")), error = identity))
if(inherits(checklog, "error"))
checklog <- "ERROR: no check log found (RForgeTools)"
warnings <- grep("WARNING$", checklog, fixed = TRUE, useBytes = TRUE)
errors <- grep("ERROR", checklog, fixed = TRUE, useBytes = TRUE)
if(length(errors))
status <- "ERROR"
else
if(length(warnings))
status <- "WARN"
else
status <- "OK"
args <- get_check_args(pkg, check_args)
if(length(args))
args <- sprintf("[%s]", args)
else
args <- ""
csv[i, ] <- c(pkg, version, priority, maintainer, status, args)
}
write.csv(csv, file, row.names = FALSE)
invisible(TRUE)
}
write_check_SUMMARY <- function(Rcheck, check_dir, path_to_pkg_src, file = "SUMMARY"){
len <- length(Rcheck)
SUMMARY <- character()
for(i in 1:len){
dir <- Rcheck[i]
pkg <- gsub(".Rcheck$", "", dir)
suppressWarnings(checklog <- tryCatch(readLines(file.path(check_dir, dir,
"00check.log")), error = identity))
if(inherits(checklog, "error"))
checklog <- "ERROR: no check log found (RForgeTools)"
problems <- grep("(^\\*\tRd files|^\'*\tnon-standard|(WARNING|ERROR)$)", checklog)
suppressWarnings(maintainer <- tryCatch(read.dcf(file.path(path_to_pkg_src, pkg, "DESCRIPTION"), "Maintainer")[1], error = identity))
if(inherits(maintainer, "error"))
maintainer <- NA
if(length(problems)){
SUMMARY <- c(SUMMARY, pkg, sprintf("Maintainer: %s", maintainer), checklog[problems])
}
}
writeLines(SUMMARY, file)
invisible(TRUE)
}
write_check_timings <- function(Rcheck, timings, file = "time_c.out"){
len <- length(Rcheck)
time_c <- character(len)
for(i in 1:len){
dir <- Rcheck[i]
pkg <- gsub(".Rcheck$", "", dir)
time_c[i] <- sprintf("%s: %s", pkg, timings[pkg])
}
writeLines(time_c, file)
}
write_check_diffs <- function(check_dir, files = "check.csv"){
files <- file.path(check_dir, files)
for(file in files){
if(file.exists(sprintf("%s.prev", file))){
ifelse( .Platform$OS.type == "windows",
shell(sprintf("diff %s.prev %s > %s.diff", file, file, file)),
system(sprintf("diff %s.prev %s > %s.diff", file, file, file)) )
ifelse( .Platform$OS.type == "windows",
shell(sprintf("test -s %s.diff || rm -f %s.diff", file, file)),
system(sprintf("test -s %s.diff || rm -f %s.diff", file, file)) )
}
if(file.exists(sprintf("%s.diff", file))){
db <- check_results_diffs(file.path(check_dir))
sink(sprintf("%s.diff", file))
writeLines(c("Changes in check status (S) and/or version (V)",
do.call(sprintf,
c(list("using R %s.%s (%s-%s-%s r%s):\n"),
R.version[c("major", "minor", "year",
"month", "day", "svn rev")]))))
print(db)
sink()
}
}
invisible(TRUE)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.