1.RookeryApp <- setRefClass(
2   'RookeryApp',
3   fields = c('app','name','appEnv','configured','workingDir'),
4   methods = list(
5      initialize = function(app=NULL,name=NULL,...){
6         if (is.null(name) || !is.character(name)){
7            base::warning("Need a proper app 'name'")
8            .self$configured <- FALSE
9            return(callSuper(...))
10         }
11
12         .self$name <- name
13
14         if (is.character(app) && file.exists(app)){
15            .self$workingDir <- dirname(app)
16            oldwd <- setwd(.self$workingDir)
17            on.exit(setwd(oldwd))
18            appEnv <<- new.env(parent=globalenv())
19            appEnv$.appFile <<- normalizePath(basename(app))
20            appEnv$.mtime <<- as.integer(file.info(appEnv$.appFile)$mtime)
21            sys.source(appEnv$.appFile,envir=.self$appEnv)
22
23            if (exists(.self$name,.self$appEnv,inherits=FALSE))
24               .self$app <- get(.self$name,.self$appEnv)
25            else if (exists('app',.self$appEnv,inherits=FALSE))
26               .self$app <- get('app',.self$appEnv)
27            else {
28               base::warning("Cannot find a suitable app in file ",app)
29               .self$app <- NULL
30            }
31         } else {
32            base::warning("File does not exist: ",app)
33            .self$configured <- FALSE;
34         }
35
36         if (!is_rookable(.self$app)){
37            base::warning("App ",name," is not rookable'")
38            .self$configured <- FALSE;
39         } else {
40            .self$configured <- TRUE;
41         }
42
43         callSuper(...)
44      }
45   )
46)
47
48.Rookery <- setRefClass(
49   'Rookery',
50   fields = c('req','res','appHash','messages'),
51   methods = list(
52      initialize = function(...){
53         appHash <<- new.env()
54         messages <<- list(
55            emptypath = c(
56               '<h2>Oops! option Rook.Rookery.paths is NULL</h2>',
57               '<p>You must set this to a character vector containing',
58               'valid directories where Rook apps live.</p>'
59            ),
60            nodots = c(
61               '<h2>Apps cannot be named . or ..</h2>'
62            )
63         )
64         callSuper(...)
65      },
66      message = function(name,opt=NULL){
67         msg <- paste(messages,collapse='\n')
68         if (!is.null(opt))
69            msg <- sprintf(msg,opt)
70         res$header('Content-Type','text/html')
71         res$write(msg)
72      },
73      findSuitableApp = function(appName){
74         if (appName %in% c('.','..')){
75            message('nodots')
76            return(NULL)
77         }
78         paths <- getOption('Rook.Rookery.paths')
79
80         if (is.null(paths)){
81            message('emptypath')
82            return(NULL)
83         }
84         #for (p in paths){
85         #   appReg <- paste('^',appName,'$',sep='')
86         #   if (any(grepl(appReg,basename(list.dirs(p,recursive=FALSE))))){
87         #   } else if (
88         #}
89      },
90      listAllApps = function(){
91      },
92      call = function(env){
93         req <<- Request$new(env)
94         res <<- Response$new()
95
96         # Captures foo from "/foo/.*". Presumes leading /.
97         appName <- strsplit(req$path_info(),'/',fixed=TRUE)[[1]][2]
98         if (is.na(appName)){
99            listAllApps()
100         } else {
101            app <- findSuitableApp(appName)
102
103            if (!is.null(app)){
104               new_path_info <- req$path_info()
105               req$path_info(sub(paste("/",appName,sep=''),'',new_path_info))
106               oldwd <- setwd(app$workingDir)
107               on.exit(setwd(oldwd))
108               if (is(app$app,'function')) {
109                  return(app$app(env))
110               } else {
111                  return(app$app$call(env))
112               }
113            }
114         }
115
116         #res$write("<pre>")
117         #res$write(paste(capture.output(ls.str(env)),collapse='\n'))
118         #res$write("</pre>")
119
120         res$finish()
121      }
122   )
123)
124