Rook/ 0000755 0001751 0000144 00000000000 12421241716 011202 5 ustar hornik users Rook/inst/ 0000755 0001751 0000144 00000000000 12332170455 012161 5 ustar hornik users Rook/inst/servers/ 0000755 0001751 0000144 00000000000 12332170455 013652 5 ustar hornik users Rook/inst/servers/rApache.R 0000644 0001751 0000144 00000011273 12332170455 015344 0 ustar hornik users .rApacheInputStream <- setRefClass(
'rApacheInputStream',
methods = list(
read_lines = function(n = -1L){
if (n<=0) return(character())
readLines(n=n,warn=FALSE)
},
read = function(l = -1L){
receiveBin(l)
},
rewind = function(){
warning("rApache doesn't support rewind()")
}
)
)
.rApacheErrorStream <- setRefClass(
'rApacheErrorStream',
methods = list(
flush = function() { base::flush(stderr()) },
cat = function(...,sep=" ",fill=FALSE,labels=NULL)
{ base::cat(...,sep=sep,fill=fill,labels=labels,file=stderr()) }
)
)
Server <- setRefClass(
'rApacheServer',
fields = c('appPath','appList'),
methods = list(
initialize = function(...){
callSuper(...)
},
AppPath = function(appPath){
if (length(appList) == 0) return()
appPath <<- appPath
},
build_env = function(){
env <- new.env(hash=TRUE,parent=emptyenv())
lapply(names(SERVER$headers_in),function(h){
assign(
paste('HTTP_',gsub('-','_',gsub('(\\w+)','\\U\\1',h,perl=TRUE)),sep=''),
SERVER$headers_in[[h]],
env)
})
if (exists('HTTP_CONTENT_LENGTH',env))
assign('CONTENT_LENGTH',get('HTTP_CONTENT_LENGTH',env),env)
else
assign('CONTENT_LENGTH',SERVER$clength,env)
if (exists('HTTP_CONTENT_TYPE',env))
assign('CONTENT_TYPE',get('HTTP_CONTENT_TYPE',env),env)
else
assign('CONTENT_TYPE',SERVER$content_type,env)
assign('SCRIPT_NAME',SERVER$cmd_path,env)
assign('PATH_INFO',sub(SERVER$cmd_path,'',SERVER$uri),env)
# Ensure only one leading forward slash
env$PATH_INFO <- sub('^/+','/',env$PATH_INFO)
assign('QUERY_STRING',SERVER$args,env)
assign('QUERY_STRING',ifelse(is.null(SERVER$args),'',SERVER$args),env)
assign('REQUEST_METHOD',SERVER$method,env)
assign('REMOTE_HOST',SERVER$remote_host,env)
assign('REMOTE_ADDR',SERVER$remote_ip,env)
hostport <- strsplit(get('HTTP_HOST',env),':',fixed=TRUE)[[1]]
assign('SERVER_NAME',hostport[1],env)
if ('port' %in% names(SERVER))
assign('SERVER_PORT',SERVER$port,env)
else
assign('SERVER_PORT',hostport[2],env)
assign('rook.version',packageDescription('Rook',fields='Version'),env)
assign('rook.url_scheme', ifelse(isTRUE(SERVER$HTTPS),'https','http'),env)
assign('rook.input',.rApacheInputStream$new(),env)
assign('rook.errors',.rApacheErrorStream$new(),env)
env
},
call = function(app){
if (is(app,'refClass')) res <- try(app$call(build_env()))
else if (is(app,'function')) res <- try(app(build_env()))
else stop('App not Rook aware')
if (inherits(res,'try-error')){
warning('App returned try-error object')
return(HTTP_INTERNAL_SERVER_ERROR)
}
setStatus(res$status)
setContentType(res$headers$`Content-Type`)
res$headers$`Content-Type` <- NULL
lapply(names(res$headers),function(n)setHeader(n,res$headers[[n]]))
# If body is named, then better be a file.
if (!is.null(names(res$body)) && names(res$body)[1] == 'file'){
sendBin(readBin(res$body[1],'raw',n=file.info(res$body[1])$size))
} else {
if ((is.character(res$body) && nchar(res$body)>0) ||
(is.raw(res$body) && length(res$body)>0) )
sendBin(res$body)
}
OK
}
)
)$new()
Request$methods(
GET = function(){
if (!exists('rook.request.query_list',env))
env[['rook.request.query_list']] <<- base::get('GET','rapache')
env[['rook.request.query_list']]
},
POST = function() {
if (exists('rook.request.form_list',env))
return(env[['rook.request.form_list']])
postvar <- base::get('POST','rapache')
filevar <- base::get('FILES','rapache')
if (length(postvar) <= 0 && length(filevar) <= 0) return(NULL)
if (length(filevar) > 0){
if (length(postvar) <= 0) postvar <- list()
for (n in names(filevar)){
if (length(filevar[[n]])>0){
postvar[[n]] <- list(
filename = filevar[[n]]$name,
tempfile = filevar[[n]]$tmp_name,
content_type = Mime$mime_type(Mime$file_extname(filevar[[n]]$name))
)
}
}
}
for (n in names(postvar)){
if (is.null(postvar[[n]])) postvar[[n]] <- NULL
}
env[['rook.request.form_list']] <<- postvar
postvar
}
)
Rook/inst/exampleApps/ 0000755 0001751 0000144 00000000000 12332170455 014440 5 ustar hornik users Rook/inst/exampleApps/RookTestApp.R 0000644 0001751 0000144 00000003140 12332170455 016774 0 ustar hornik users app <- function(env){
req <- Request$new(env)
res <- Response$new()
envstr <- paste(capture.output(str(as.list(env)),file=NULL),collapse='\n')
poststr <- paste(capture.output(str(req$POST()),file=NULL),collapse='\n')
getstr <- paste(capture.output(str(req$GET()),file=NULL),collapse='\n')
randomString <- function() paste(letters[floor(runif(10,0,26))],collapse='')
randomNumber <- function() runif(1,0,26)
res$write( c(
'
',
'
',
'Welcome to Rook
\n',
sprintf('\n
')
res$finish()
}
Rook/inst/exampleApps/helloworldref.R 0000644 0001751 0000144 00000000350 12332170455 017431 0 ustar hornik users app <- setRefClass(
'HelloWorld',
methods = list(
call = function(env){
list(
status=200,
headers = list(
'Content-Type' = 'text/html'
),
body = paste('Hello World!
')
)
}
)
)$new()
Rook/inst/exampleApps/rnorm.R 0000644 0001751 0000144 00000002117 12332170455 015721 0 ustar hornik users app <- Builder$new(
URLMap$new(
'^/.*\\.html$' = function(env){
req <- Request$new(env)
res <- Response$new()
if (is.null(req$GET()$n)){
n <- 100
} else {
n <- as.integer(req$GET()$n)
}
res$write('How many squares?\n')
res$write('\n
')
if (n>0){
res$write(paste('
',sep=''))
}
res$finish()
},
'^/.*\\.png$' = function(env){
req <- Request$new(env)
res <- Response$new()
res$header('Content-type','image/png')
if (is.null(req$GET()$n)){
n <- 100
} else {
n <- as.integer(req$GET()$n)
}
t <- tempfile()
png(file=t)
png(t,type="cairo",width=200,height=200)
par(mar=rep(0,4))
plot(rnorm(n),col=rainbow(n,alpha=runif(n,0,1)),pch='.',cex=c(2,3,4,5,10,50))
dev.off()
res$body <- t
names(res$body) <- 'file'
res$finish()
},
'.*' = Redirect$new('/index.html')
)
)
Rook/inst/exampleApps/exampleData/ 0000755 0001751 0000144 00000000000 12332170455 016665 5 ustar hornik users Rook/inst/exampleApps/exampleData/index.html 0000644 0001751 0000144 00000001356 12332170455 020667 0 ustar hornik users
R Dataset Explorer
R Dataset Explorer with Rook
This example demonstrates Rook by exploring the R datasets package. Each dataset is presented below. By clicking on one, you will be able to explore the dataset with a plot or by returning the dataset in its entirety as a JSON object.
<%
counter <- 0
numcols <- 6
for (i in sort(ls('package:datasets'))){
if (counter %% numcols == 0) cat("
")
%>
<%=i%>
[ json]
[ png]
|
<%
counter <- counter + 1;
}
%>
Rook/inst/exampleApps/exampleData/error.html 0000644 0001751 0000144 00000000115 12332170455 020701 0 ustar hornik users
ERROR! <%=dataset%> not found.
Rook/inst/exampleApps/exampleData/config.R 0000644 0001751 0000144 00000011744 12332170455 020264 0 ustar hornik users library(datasets)
library(RJSONIO)
render_json <- function(object) {
# Some objects are instances of a sub-class of data.frame
# and RJSONIO doesn't know what to do with them, so we just
# use trickery.
if (inherits(object,'data.frame',which = TRUE) > 0){
class(object) <- 'data.frame'
# Even these may have ts objects as columns so lets
# just punt for right now and assign it an NA column.
for (i in names(object)){
if (inherits(object[[i]],'ts')){
object[[i]] <- NA
}
}
}
# Unclassing here is unclassy. Would be nice to use as.data.frame
# but it seems that the original ts object is stuffed into the result
# somehow.
if (inherits(object,'ts')){
object <- unclass(object)
}
if (inherits(object,'table') || inherits(object,'array')){
object <- as.data.frame(object)
}
RJSONIO::toJSON(object)
}
app <- Builder$new(
Brewery$new(url='.*\\.html$',root='.'),
URLMap$new(
'^/.*\\.csv$' = function(env){
req <- Request$new(env)
res <- Response$new()
datasets <- ls('package:datasets')
tmpdataset <- sub('^/(.*)\\.csv','\\1',req$path_info())
dataset <- datasets[datasets %in% tmpdataset][1]
if (is.na(dataset)) dataset <- 'iris'
res$header('Content-type','text/csv')
res$write(
paste(
capture.output(eval(parse(text=sprintf('write.csv(%s)',dataset)))),
collapse="\n"
)
)
res$finish()
},
'^/.*\\.json$' = function(env){
req <- Request$new(env)
res <- Response$new()
datasets <- ls('package:datasets')
tmpdataset <- sub('^/(.*)\\.json','\\1',req$path_info())
dataset <- datasets[datasets %in% tmpdataset][1]
if (is.na(dataset)) dataset <- 'iris'
res$header('Content-type','application/json')
res$write(eval(parse(text=sprintf('render_json(%s)',dataset))))
res$finish()
},
'^/.*\\.png$' = function(env){
req <- Request$new(env)
res <- Response$new()
datasets <- ls('package:datasets')
tmpdataset <- sub('^/(.*)\\.csv','\\1',req$path_info())
dataset <- datasets[datasets %in% tmpdataset][1]
if (is.na(dataset)) dataset <- 'iris'
res$finish()
},
'.*' = Redirect$new('/index.html')
)
)
############################################
## Top level HTML pages
############################################
#
#render_brew <- function(template, params = list(), path = getwd()) {
# if (is.list(params)) {
# env <- new.env(TRUE)
# for(name in names(params)) {
# env[[name]] <- params[[name]]
# }
# params <- env
# }
#
# path <- file.path(path, "views", stringr::str_c(template, ".html"))
# if (!file.exists(path)) stop("Can not find ", template, " template ",
# call. = FALSE)
# setContentType('text/html')
# brew::brew(path, envir = params)
# OK
#}
#
#router$get("/", function(...) {
# # brews the file index.html in the /views dir
# render_brew("index",list(...))
#})
#
## This is the RESTful part of the application. Each
## dataset found in the datasets package has its own
## URL
#router$get("/dataset/:dataset.html", function(dataset) {
# if (any(ls('package:datasets') == dataset))
# render_brew("dataset",list(dataset=dataset))
# else
# render_brew("error",list(dataset=dataset))
#})
#
#router$get("/dataset/:dataset.csv", function(dataset) {
# setContentType('text/csv')
# eval(parse(text=paste('write.csv(',dataset,',file=stdout())')))
# OK
#})
#
#
#
############################################
## Web services
############################################
#
#router$get('/dataset/:dataset.json', function(dataset){
# if (!any(ls('package:datasets') == dataset))
# render_brew("error",list(dataset=dataset))
# else
# render_json(get(dataset))
#})
#
## Returned when no dataset's example renders a plot
#bad_plot <- function(dataset){
# t <- tempfileWithExtension()
# png(t)
# #par(mar=rep(0,4))
# plot(rnorm(100),main=paste('Fail for',dataset,' but Check it!'),col=rainbow(100,alpha=runif(100,0,1)),pch='.',cex=c(2,3,4,5,10,50,100))
# dev.off()
# payday <- readBin(t,'raw',file.info(t)$size)
# unlink(t)
# payday
#}
#
#router$get('/dataset/:dataset.png', function(dataset){
#
# if (!any(ls('package:datasets') == dataset))
# render_brew("error",list(dataset=dataset))
#
# setContentType('image/png')
#
# t <- tempfileWithExtension()
# #cat('tempfile is',t,'\n')
# png(t)
#
# # This is a bit of magic. R has an example function
# # which runs example code located at the end of a
# # particular help topic. Fortunately, there's a help
# # topic for all datasets exported from the 'datasets'
# # package. Unfortunately, not all of them produce a plot,
# # and they can be noisy.
# #
# # This is where you would place your own data and plot routines, FYI
# #
# capture.output(
# suppressWarnings(
# eval(
# substitute(
# example(dataset,package='datasets',ask=FALSE),
# list(dataset=dataset)
# )
# )
# ))
#
#
# dev.off()
# payday <- try(readBin(t,'raw',file.info(t)$size))
# unlink(t)
#
# if (inherits(payday,'try-error') || length(payday) <=1 ){
# payday <- bad_plot(dataset)
# }
#
# sendBin(payday)
#
# OK
#})
#
Rook/inst/exampleApps/exampleData/dataset.html 0000644 0001751 0000144 00000001141 12332170455 021175 0 ustar hornik users <%
datasets <- ls('package:datasets')
dataset <- datasets[datasets %in% req$GET()[['data']]][1]
if (is.na(dataset)) dataset <- 'iris'
%>
<%=dataset%> Summary
<%=paste(capture.output(eval(parse(text=sprintf("summary(%s)",dataset)))),collapse='
')%>
Click on the below:
Rook/inst/exampleApps/Hmisc/ 0000755 0001751 0000144 00000000000 12332170455 015503 5 ustar hornik users Rook/inst/exampleApps/Hmisc/images/ 0000755 0001751 0000144 00000000000 12332170455 016750 5 ustar hornik users Rook/inst/exampleApps/Hmisc/images/spinner.gif 0000644 0001751 0000144 00000003765 12332170455 021130 0 ustar hornik users GIF89a 鵵<<<۪&&&عˮRRRꅅJJJѤ)))]]]̷YYYfffʦุzzzNNNjjjֺnnnޖaaatttTTTFFFWWW222www|||666qqqAAAlllxxx---###Ҭ!NETSCAPE2.0 ! , Ȁ -h _ W -% Mo> j` = ^:Q!6 53p6ZO/Q,);Q G@l^ba"-$
R:σ1?T" !J `Ą %* ċl4 HDa +Q4\"
R a Vg @ ! ,
o tp8 _sZ7L2>n g w hP7'tbcAr.: *2 rb"K[\ ,A?B=
M"-aɊ H!1? ! , d
d =b efN>] Ic. lF