1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
#########################################################################/**
# @set "class=HttpDaemon"
# @RdocMethod processRsp
#
# @title "Processes an RSP page"
#
# \description{
# @get "title".
# }
#
# @synopsis
#
# \arguments{
# \item{pathname}{The RSP file to be processed.}
# \item{version}{The version of the RSP processor to use.}
# \item{...}{Not used.}
# }
#
# \value{
# Returns nothing.
# }
#
# \section{Settings}{
# The \pkg{R.rsp} package implements different RSP engines.
# It is possible to specify which version the Tcl HTTP daemon
# should use via the option \code{R.rsp/HttpDaemon/RspVersion}.
# The default is now to use the new RSP engine, which corresponds
# \code{options("R.rsp/HttpDaemon/RspVersion"="1.0.0")}.
# The old legacy RSP engine \code{"0.1.0"} is defunct.
# }
#
# @author
#
# \seealso{
# @seeclass
# }
#
# @keyword IO
#*/#########################################################################
setMethodS3("processRsp", "HttpDaemon", function(static=getStaticInstance(HttpDaemon), pathname=tcltk::tclvalue("mypath"), version=getOption("R.rsp/HttpDaemon/RspVersion", "1.0.0"), ...) {
# If processRsp() was called from Tcl, then it is called without
# arguments, which is why we need this rather ad hoc solution to
# default 'static' to getStaticInstance().
daemon <- static
# Use a "global" tryCatch() to catch and respond to RSP processing errors
tryCatch({
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Validate arguments
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Argument 'pathname':
pathname <- as.character(pathname)
# Validate pathname
pathname <- Arguments$getReadablePathname(pathname)
# Argment 'version':
if (!is.element(version, c("0.1.0", "1.0.0"))) {
throw("Unknown HttpDaemon RSP version: ", version)
}
if (version == "0.1.0") {
.Defunct(msg = "RSP HTTP daemon v0.1.0 is defunct, because it relies on an old legacy RSP engine, which has been removed. Use v1.0.0 instead, by removing options 'R.rsp/HttpDaemon/RspVersion' or setting it to '1.0.0'.")
}
debug <- isTRUE(daemon$.debug)
if (debug) {
mcat("DEBUG: RSP version: ", version, "\n", sep="")
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Setup
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
path <- getParent(pathname)
filename <- basename(pathname)
# Record the current directory
opwd <- getwd()
on.exit(setwd(opwd))
# Set the current working directory of the HTTP daemon
daemon$pwd <- opwd
setwd(path)
# Get the HTTP request information
request <- getHttpRequest(daemon)
if (debug) {
mcat("DEBUG: RSP file: ", pathname, "\n", sep="")
mcat("DEBUG: Working directory: ", path, "\n", sep="")
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Process RSP file
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (version == "1.0.0") {
response <- HttpDaemonRspResponse(httpDaemon=daemon)
page <- RspPage(pathname)
pathnameR <- rfile(file=filename, workdir=opwd, args=list(page=page, request=request, response=response))
s <- readLines(pathnameR, warn=FALSE)
s <- paste(s, collapse="\n")
if (nchar(s) > 0L) writeResponse(daemon, s)
}
}, error = function(ex) {
mcat("ERROR:")
mprint(ex)
writeResponse(daemon, as.character(ex))
if (!is.null(ex$code)) {
code <- paste(ex$code, collapse="\n")
mcat(code, "\n")
mprint(ex)
writeResponse(daemon, code)
}
}) # tryCatch()
}, static=TRUE, protected=TRUE)
|
