Skip to content

Commit

Permalink
added knitr and pander support
Browse files Browse the repository at this point in the history
  • Loading branch information
jeroen committed May 25, 2013
1 parent cfeb1da commit 9eb195e
Show file tree
Hide file tree
Showing 13 changed files with 169 additions and 102 deletions.
4 changes: 3 additions & 1 deletion DESCRIPTION
Expand Up @@ -7,4 +7,6 @@ Author: STATDEV
Maintainer: STATDEV <administrations@statdev.org>
Description: OpenCPU
License: Apache2
Imports: parallel, tools, evaluate, httpuv, Rook, RJSONIO, knitr
Imports: parallel, tools, evaluate
Suggests: httpuv, Rook, RJSONIO, knitr, pander, brew
SystemRequirements: pandoc, texlive, apparmor
4 changes: 2 additions & 2 deletions R/eval_session.R
Expand Up @@ -10,7 +10,7 @@ eval_session <- function(input, args){

#setup handler
myhandler <- evaluate::new_output_handler(value=function(myval){
assign("value", myval, sessionenv);
assign(".value", myval, sessionenv);
evaluate:::render(myval);
});

Expand All @@ -25,7 +25,7 @@ eval_session <- function(input, args){
output <- Filter(function(x){!emptyplot(x)}, output);

#save
save(list=ls(sessionenv), file=".RData", envir=sessionenv);
save(list=ls(sessionenv, all.names=TRUE), file=".RData", envir=sessionenv);
saveRDS(output, file=".REval");
saveRDS(sessionInfo(), file=".RInfo");

Expand Down
38 changes: 34 additions & 4 deletions R/execute_file.R
@@ -1,12 +1,12 @@
execute_file <- local({
main <- function(filepath){
res$checkfile(filepath);
ext <- tail(strsplit(filepath, ".", fixed=TRUE)[[1]], 1);
ext <- tolower(tail(strsplit(filepath, ".", fixed=TRUE)[[1]], 1));

switch(ext,
"R" = httppost_rscript(filepath),
"Rnw" = httppost_knitr(filepath),
"Rmd" = httppost_knitr(filepath),
"r" = httppost_rscript(filepath),
"rnw" = httppost_rnw(filepath),
"rmd" = httppost_rmd(filepath),
"brew" = httppost_brew(filepath),
"pdr" = httppost_pander(filepath),
"tex" = httppost_latex(filepath),
Expand All @@ -19,5 +19,35 @@ execute_file <- local({
eval_session(mycon);
}

httppost_rnw <- function(filepath){
#explicit package so that we don't have to preload
knitcall <- as.call(list(quote(tools::texi2pdf), as.call(list(quote(knitr::knit), filepath))));
eval_session(knitcall);
}

httppost_rmd <- function(filepath){
#explicit package so that we don't have to preload
#knitcall <- as.call(list(quote(tools::texi2pdf), as.call(list(quote(knitr::knit), filepath))));
knitcalls <- c(
"library(knitr)",
paste("mdfile <- knit('", filepath, "')", sep=""),
"pandoc(mdfile, format='html')",
"pandoc(mdfile, format='docx')",
"pandoc(mdfile, format='odt')"
);
knitcall <- paste(knitcalls, collapse="\n")
eval_session(knitcall);
}

httppost_brew <- function(filepath){
brewcall <- as.call(list(quote(brew::brew), file=filepath));
eval_session(brewcall);
}

httppost_latex <- function(filepath){
brewcall <- as.call(list(quote(tools::texi2pdf), file=filepath));
eval_session(brewcall);
}

main
});
14 changes: 11 additions & 3 deletions R/extract.R
Expand Up @@ -39,10 +39,14 @@ extract <- local({

extract_console <- function(evaluation){
messages <- lapply(evaluation, function(x){
if(is(x, "warning") || is(x, "message") || is(x, "error")){
return(gettext(x));
if(is(x, "warning")) {
return(paste("Warning message:", clean(x$message), sep="\n"));
} else if(is(x, "message")) {
return(paste("Message:", clean(x$message), sep="\n"));
} else if(is(x, "error")){
return(paste("Error:", x$message, sep="\n"));
} else if(is(x, "character")){
return(x);
return(sub("\n$", "", x));
} else if(is(x, "source")){
return(gsub("\n", "\n+ ", sub("\n$", "", paste(">",x$src))));
} else if(is(x, "recordedplot")){
Expand All @@ -54,6 +58,10 @@ extract <- local({
unlist(messages);
}

clean <- function(x){
return(gsub("^[\\s]+|[\\s]+$", "", x, perl=TRUE));
}

extract <- function(evaluation, what=c("source", "text", "graphics", "message", "warning", "error", "value", "console")){
#stopifnot(is(evaluation, "evaluation"))
stopifnot(length(what) == 1)
Expand Down
7 changes: 7 additions & 0 deletions R/httpget_object.R
Expand Up @@ -12,6 +12,7 @@ httpget_object <- local({
#render object
switch(reqformat,
"print" = httpget_object_print(object),
"pander" = httpget_object_pander(object),
"text" = httpget_object_text(object),
"ascii" = httpget_object_ascii(object),
"bin" = httpget_object_bin(object, objectname),
Expand Down Expand Up @@ -87,6 +88,12 @@ httpget_object <- local({
res$sendtext(outtext);
}

httpget_object_pander <- function(object){
pander <- pander::pander;
outtext <- capture.output(do.call("pander", c(req$get(), list(x=object))));
res$sendtext(outtext);
}

httpget_object_text <- function(object){
object <- paste(unlist(object), collapse="\n")
mytmp <- tempfile(fileext=".txt")
Expand Down
16 changes: 9 additions & 7 deletions R/httpget_package.R
Expand Up @@ -19,13 +19,15 @@ httpget_package <- function(pkgpath, requri){
switch(reqhead,
"R" = httpget_package_r(pkgpath, reqtail),
"dpu" = httpget_package_dpu(pkgpath, reqtail),
"man" = httpget_package_man(pkgpath, reqtail),
"doc" = httpget_package_doc(pkgpath, reqtail),
"demo" = httpget_package_demo(pkgpath, reqtail),
"html" = httpget_package_html(pkgpath, reqtail),
"www" = httpget_package_www(pkgpath, reqtail),
"DESCRIPTION" = res$sendfile(file.path(pkgpath, "DESCRIPTION")),
"NEWS" = res$sendfile(file.path(pkgpath, "NEWS")),
stop("invalid package api:",reqhead)
"man" = httpget_package_man(pkgpath, reqtail),
httpget_file(file.path(pkgpath, paste(requri, collapse="/")))

#"doc" = httpget_package_doc(pkgpath, reqtail),
#"demo" = httpget_package_demo(pkgpath, reqtail),
#"www" = httpget_package_www(pkgpath, reqtail),
#"DESCRIPTION" = res$sendfile(file.path(pkgpath, "DESCRIPTION")),
#"NEWS" = res$sendfile(file.path(pkgpath, "NEWS")),
#stop("invalid package api:",reqhead)
);
}
6 changes: 2 additions & 4 deletions R/httpget_session.R
Expand Up @@ -13,15 +13,12 @@ httpget_session <- function(filepath, requri){
res$setheader("Location", req$uri());
res$sendlist(session$list(filepath));




myfiles <- vector();
if(file.exists(file.path(filepath, ".RData"))){
myfiles <- c(myfiles, "R");
}
if(file.exists(file.path(filepath, ".REval"))){
myfiles <- c(myfiles, c("graphics", "report", "console", "source", "warnings", "messages"));
myfiles <- c(myfiles, c("graphics", "report", "console", "source", "warnings", "messages", "stdout"));
}
if(file.exists(file.path(filepath, ".RInfo"))){
myfiles <- c(myfiles, c("info"));
Expand All @@ -41,6 +38,7 @@ httpget_session <- function(filepath, requri){
"console" = httpget_session_console(filepath, reqtail),
"warnings" = httpget_session_warnings(filepath, reqtail),
"messages" = httpget_session_messages(filepath, reqtail),
"stdout" = httpget_session_stdout(filepath, reqtail),
"info" = httpget_session_info(filepath, reqtail),
"zip" = httpget_session_zip(filepath, reqtail),
"report" = httpget_session_report(filepath, reqtail),
Expand Down
2 changes: 1 addition & 1 deletion R/httpget_session_r.R
Expand Up @@ -14,7 +14,7 @@ httpget_session_r <- function(filepath, requri){
#list session objects
if(!length(reqobject)){
res$checkmethod();
res$sendlist(ls(sessionenv));
res$sendlist(ls(sessionenv, all.names=TRUE));
}

#load object
Expand Down
10 changes: 10 additions & 0 deletions R/httpget_session_stdout.R
@@ -0,0 +1,10 @@
httpget_session_stdout <- function(filepath, requri){

#load data
myeval <- readRDS(sessionfile <- file.path(filepath, ".REval"));
mymsg <- extract(myeval, "text");

#render
reqformat <- requri[1];
httpget_object(mymsg, reqformat, "stdout", "text");
}
5 changes: 5 additions & 0 deletions R/mimelist.R
@@ -1,4 +1,9 @@
mimelist <- list(
"r" = "text/r",
"rmd" = "text/r-markdown",
"rnw" = "text/r-sweave",
"brew" = "text/r-brew",
"md" = "text/markdown",
"3gp"="video/3gpp",
"a"="application/octet-stream",
"ai"="application/postscript",
Expand Down
158 changes: 79 additions & 79 deletions R/session.R
@@ -1,79 +1,79 @@
session <- local({
prefix = "ocpu_session_";

remove <- function(hash){
mydir <- sessiondir(hash);
stopifnot(file.remove(mydir, recursive=TRUE));
}

save <- function(hash, envir){
setwd(sessiondir(hash));
save(file=".RData", list=ls(envir), envir);
}

init <- function(){
characters <- c(0:9, letters[1:6]);
hash <- paste(c("0x0", sample(characters, 7, replace=TRUE)), collapse="")
stopifnot(dir.create(sessiondir(hash)));
setwd(sessiondir(hash));
sessionpath(hash);
}

list <- function(filepath){
setwd(filepath);
outlist <- vector();

#list data files
if(file.exists(".RData")){
myenv <- new.env();
load(".RData", myenv);
if(length(ls(myenv))){
outlist <- c(outlist, paste("R", ls(myenv), sep="/"));
}
}

#list eval files
if(file.exists(".REval")){
myeval <- readRDS(".REval");
if(length(extract(myeval, "graphics"))){
outlist <- c(outlist, paste("graphics", seq_along(extract(myeval, "graphics")), sep="/"));
}
if(length(extract(myeval, "message"))){
outlist <- c(outlist, "messages");
}
if(length(extract(myeval, "warning"))){
outlist <- c(outlist, "warnings");
}
if(length(extract(myeval, "source"))){
outlist <- c(outlist, "source");
}
if(length(extract(myeval, "console"))){
outlist <- c(outlist, "console");
}
#outlist <- c(outlist, "report");
}

#list eval files
if(file.exists(".RInfo")){
outlist <- c(outlist, "info");
}

#other files
if(length(list.files())){
outlist <- c(outlist, "files")
}

return(outlist);
}

sessiondir <- function(hash){
file.path(gettmpdir(), paste(prefix, hash, sep=""));
}

sessionpath <- function(hash){
paste("/tmp/", hash, sep="");
}

environment();
})

session <- local({
prefix = "ocpu_session_";

remove <- function(hash){
mydir <- sessiondir(hash);
stopifnot(file.remove(mydir, recursive=TRUE));
}

save <- function(hash, envir){
setwd(sessiondir(hash));
save(file=".RData", list=ls(envir), envir);
}

init <- function(){
characters <- c(0:9, letters[1:6]);
hash <- paste(c("0x0", sample(characters, 7, replace=TRUE)), collapse="")
stopifnot(dir.create(sessiondir(hash)));
setwd(sessiondir(hash));
sessionpath(hash);
}

list <- function(filepath){
setwd(filepath);
outlist <- vector();

#list data files
if(file.exists(".RData")){
myenv <- new.env();
load(".RData", myenv);
if(length(ls(myenv, all.names=TRUE))){
outlist <- c(outlist, paste("R", ls(myenv, all.names=TRUE), sep="/"));
}
}

#list eval files
if(file.exists(".REval")){
myeval <- readRDS(".REval");
if(length(extract(myeval, "graphics"))){
outlist <- c(outlist, paste("graphics", seq_along(extract(myeval, "graphics")), sep="/"));
}
if(length(extract(myeval, "message"))){
outlist <- c(outlist, "messages");
}
if(length(extract(myeval, "warning"))){
outlist <- c(outlist, "warnings");
}
if(length(extract(myeval, "source"))){
outlist <- c(outlist, "source");
}
if(length(extract(myeval, "console"))){
outlist <- c(outlist, "console");
}
#outlist <- c(outlist, "report");
}

#list eval files
if(file.exists(".RInfo")){
outlist <- c(outlist, "info");
}

#other files
if(length(list.files())){
outlist <- c(outlist, "files")
}

return(outlist);
}

sessiondir <- function(hash){
file.path(gettmpdir(), paste(prefix, hash, sep=""));
}

sessionpath <- function(hash){
paste("/tmp/", hash, sep="");
}

environment();
})

2 changes: 1 addition & 1 deletion R/utils.R
Expand Up @@ -24,7 +24,7 @@ utils <- local({
}

#otherwise lookup in mimelist
input <- tail(strsplit(filename, ".", fixed=T)[[1]], 1)
input <- tolower(tail(strsplit(filename, ".", fixed=T)[[1]], 1));
contenttype <- alltypes[[input]];
if(is.null(contenttype)){
contenttype <- "application/octet-stream";
Expand Down
5 changes: 5 additions & 0 deletions TODO.txt
@@ -0,0 +1,5 @@
TO DO:

request content-type: json
add windows user stuff
add file executors

0 comments on commit 9eb195e

Please sign in to comment.