Rook: software and specification for R web applications and servers

Rook apps can be run using the httpd built into R (great feature!), and can 
be deployed using rApache server. 
For those who prefer to deploy the apps under FastRWeb, below is the code 
to do so:

-- in your web.R/myrookapp.R file, we ran the Rook app instance (stored in 
variable app): 

run <- function( ... ) {
  run_rook_app(app);
}

-- somewhere from code/rserve.R source the following definitions:
library(Rook)
run_rook_app <- function(app,env=build_rook_env(request)) {
  res <- app$call(env);
  if (inherits(res,'try-error')){
    warning('App returned try-error object')
    str(res)
    return(paste("ERROR!",res,capture.output(traceback())))
  }
  ctype <- res$headers$`Content-Type`;
  res$headers$`Content-Type` <- NULL;
  headers <- unlist(lapply(names(res$headers),function(nam) paste(nam,": 
",res$headers[[nam]],sep="")))

  if (!is.null(names(res$body)) && names(res$body)[1] == 'file'){
    # send fille

 return(WebResult(cmd="file",payload=res$body[1],content.type=ctype,headers=headers))
  } else {
    if ((is.character(res$body) && nchar(res$body)>0)) {
      # plain text response

 return(WebResult(cmd="html",payload=res$body,content.type=ctype,headers=headers))
    } else if (is.raw(res$body) && length(res$body)>0) {

 return(WebResult(cmd="raw",payload=res$body,content.type=ctype,headers=headers))
    }
  }
}

run_rook_app <- function(app,env=build_rook_env(request)) {
  res <- app$call(env);
  if (inherits(res,'try-error')){
    warning('App returned try-error object')
    str(res)
    return(paste("ERROR!",res,capture.output(traceback())))
  }
  ctype <- res$headers$`Content-Type`;
  res$headers$`Content-Type` <- NULL;
  headers <- unlist(lapply(names(res$headers),function(nam) paste(nam,": 
",res$headers[[nam]],sep="")))

  if (!is.null(names(res$body)) && names(res$body)[1] == 'file'){
    # send fille
    #print("multipart file response")

 return(WebResult(cmd="file",payload=res$body[1],content.type=ctype,headers=headers))
    #sendBin(readBin(res$body[1],'raw',n=file.info(res$body[1])$size))
  } else {
    if ((is.character(res$body) && nchar(res$body)>0)) {
      # plain text response
      #print("plaint text response")

 return(WebResult(cmd="html",payload=res$body,content.type=ctype,headers=headers))
    } else if (is.raw(res$body) && length(res$body)>0) {
      #print("raw response")

 return(WebResult(cmd="raw",payload=res$body,content.type=ctype,headers=headers))
    }
  }
}

.FastRWebInputStream <- setRefClass(
  '.FastRWebInputStream',
  fields=c('con','body'),
  methods = list(
    initialize = function(request) {
      body <<- request$body;
      if(!is.null(body) && is.raw(body)) {
        con <<- rawConnection(request$body)
      } else {
        con <<- NULL;
      }
    },
    read_lines = function(n = -1L){
      if (n<=0 || is.null(body) || is.null(con)) return(character())
      readLines(con,n=n,warn=FALSE)
    },
    read = function(l = -1L){
      if (is.null(body) || is.null(con)) return(character())
      body;
    },
    rewind = function(){
      if(!is.null(body) && is.raw(body))      
        con <<- rawConnection(body)
    })
  )

-peter.