1
###########################################################################/**
2
# @RdocDefault rcompile
3
# @alias rcompile.RspString
4
# @alias rcompile.RspDocument
5
#
6
# @title "Compiles an RSP document"
7
#
8
# \description{
9
#  @get "title".
10
# }
11
#
12
# @synopsis
13
#
14
# \arguments{
15
#   \item{...}{@character strings with RSP markup.}
16
#   \item{file, path}{Alternatively, a file, a URL or a @connection from
17
#      with the strings are read.
18
#      If a file, the \code{path} is prepended to the file, iff given.}
19
#   \item{output}{A @character string or a @connection specifying where
20
#      output should be directed.
21
#      The default is a file with a filename where the input filename
22
#      has been prepended by \code{compiled-} and saved
23
#      in the directory given by the \code{workdir} argument.}
24
#   \item{workdir}{The working directory to use after parsing and
25
#      preprocessing.
26
#      If argument \code{output} specifies an absolute pathname,
27
#      then the directory of \code{output} is used, otherwise the
28
#      current directory is used.}
29
#   \item{envir}{The @environment in which the RSP string is
30
#      preprocessed and evaluated.}
31
#   \item{args}{A named @list of arguments assigned to the environment
32
#     in which the RSP string is parsed and evaluated.
33
#     See @see "R.utils::cmdArgs".}
34
#   \item{until}{Specifies how far the compilation should proceed.}
35
#   \item{verbose}{See @see "R.utils::Verbose".}
36
# }
37
#
38
# \value{
39
#   Returns an @see "RspString", @see "RspDocument" or
40
#   an @see "RspFileProduct" (depending on argument \code{output}).
41
# }
42
#
43
# @author
44
#
45
# \seealso{
46
#  @see "rcat" and @see "rfile".
47
# }
48
#
49
# @keyword file
50
# @keyword IO
51
# @keyword internal
52
#*/###########################################################################
53
setMethodS3("rcompile", "default", function(..., file=NULL, path=NULL, output=NULL, workdir=NULL, envir=parent.frame(), args="*", until="*", verbose=FALSE) {
54
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
55
  # Validate arguments
56
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
57
  # Argument 'file' & 'path':
58 1
  if (inherits(file, "connection")) {
59 1
  } else if (is.character(file)) {
60 1
    if (!is.null(path)) {
61 1
      file <- file.path(path, file)
62
    }
63 1
    if (!isUrl(file)) {
64 1
      file <- Arguments$getReadablePathname(file, absolute=TRUE)
65
    }
66
  }
67

68
  # Argument 'workdir':
69 1
  if (is.null(workdir)) {
70 1
    if (isAbsolutePath(output)) {
71 0
      workdir <- getParent(output)
72
    } else {
73 1
      workdir <- "."
74
    }
75
  }
76 1
  workdir <- Arguments$getWritablePath(workdir)
77 1
  if (is.null(workdir)) workdir <- "."
78

79
  # Argument 'output':
80 1
  if (is.null(output)) {
81
    # Default is to return an RSP source code object
82 0
    output <- RspString()
83

84 0
    if (inherits(file, "connection")) {
85 0
      throw("When argument 'file' is a connection, then 'output' must be specified.")
86 0
    } else if (is.character(file)) {
87
      # Is the input a filename or an URI?
88 0
      if (isUrl(file)) {
89
        # If URI, drop any URI arguments
90 0
        url <- splitUrl(file)
91 0
        filename <- basename(url$path)
92 0
        filename <- Arguments$getReadablePathname(filename, adjust="url", mustExist=FALSE)
93 0
        filename <- basename(file)
94
      } else {
95 0
        filename <- basename(file)
96
      }
97

98 0
      outputF <- sprintf("compiled-%s", filename)
99 0
      withoutGString({
100 0
        output <- Arguments$getWritablePathname(outputF, path=workdir)
101
      })
102 0
      output <- getAbsolutePath(output)
103
      # Don't overwrite the input file
104 0
      if (output == file) {
105 0
        throw("Cannot process RSP file. The inferred argument 'output' is the same as argument 'file' & 'path': ", output, " == ", file)
106
      }
107
    }
108 1
  } else if (inherits(output, "connection")) {
109 1
  } else if (identical(output, "")) {
110 0
    output <- RspString()
111 1
  } else if (inherits(output, "RspString")) {
112 1
  } else if (inherits(output, "RspDocument")) {
113 0
  } else if (is.character(output)) {
114 0
    withoutGString({
115 0
      if (isAbsolutePath(output)) {
116 0
        output <- Arguments$getWritablePathname(output)
117
      } else {
118 0
        output <- Arguments$getWritablePathname(output, path=workdir)
119 0
        output <- getAbsolutePath(output)
120
      }
121
    })
122 0
    if (is.character(file) && (output == file)) {
123 0
      throw("Cannot process RSP file. Argument 'output' specifies the same file as argument 'file' & 'path': ", output, " == ", file)
124
    }
125
  } else {
126 0
    throw("Argument 'output' of unknown type: ", class(output)[1L])
127
  }
128

129
  # Argument 'until':
130
##  until <- match.arg(until)
131

132
  # Argument 'verbose':
133 1
  verbose <- Arguments$getVerbose(verbose)
134 1
  if (verbose) {
135 1
    pushState(verbose)
136 1
    on.exit(popState(verbose))
137
  }
138

139

140 1
  verbose && enter(verbose, "rcompile() for default")
141 1
  verbose && cat(verbose, "Compile until: ", sQuote(until))
142 1
  verbose && cat(verbose, "Workdir: ", workdir)
143 1
  verbose && cat(verbose, "Output: ", output)
144

145 1
  if (is.null(file)) {
146 0
    s <- RspString(...)
147
  } else {
148 1
    verbose && cat(verbose, "Input: ", file)
149 1
    s <- .readText(file)
150 1
    s <- RspString(s, source=file)
151 1
    s <- setMetadata(s, name="source", value=file)
152
  }
153 1
  verbose && cat(verbose, "Length of RSP string: ", nchar(s))
154

155 1
  res <- rcompile(s, envir=envir, output=output, workdir=workdir, args=args, until=until, verbose=verbose)
156

157 1
  verbose && exit(verbose)
158

159 1
  res
160
}) # rcompile()
161

162

163
setMethodS3("rcompile", "RspString", function(object, envir=parent.frame(), output=NULL, workdir=NULL, args="*", ..., until="*", verbose=FALSE) {
164
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
165
  # Validate arguments
166
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
167
  # Argument 'workdir':
168 1
  if (is.null(workdir)) {
169 0
    workdir <- "."
170 0
    if (inherits(output, "RspString")) {
171 0
    } else if (inherits(output, "RspDocument")) {
172 0
    } else if (isAbsolutePath(output)) {
173 0
      workdir <- getParent(output)
174
    }
175
  }
176

177
  # Argument 'output':
178 1
  if (!is.null(output)) {
179 1
    if (inherits(output, "connection")) {
180 1
    } else if (inherits(output, "RspString")) {
181 1
    } else if (inherits(output, "RspDocument")) {
182
    } else {
183 0
      withoutGString({
184 0
        if (isAbsolutePath(output)) {
185 0
          output <- Arguments$getWritablePathname(output)
186
        } else {
187 0
          output <- Arguments$getWritablePathname(output, path=workdir)
188 0
          output <- getAbsolutePath(output)
189
        }
190
      })
191
    }
192
  }
193

194
  # Argument 'args':
195 1
  args <- cmdArgs(args=args)
196

197
  # Argument 'until':
198
##  until <- match.arg(until)
199

200
  # Argument 'verbose':
201 1
  verbose <- Arguments$getVerbose(verbose)
202 1
  if (verbose) {
203 1
    pushState(verbose)
204 1
    on.exit(popState(verbose))
205
  }
206

207 1
  verbose && enter(verbose, "rcompile() for ", class(object)[1L])
208 1
  verbose && cat(verbose, "Compile until: ", sQuote(until))
209

210 1
  if (length(args) > 0L) {
211 0
    verbose && enter(verbose, "Assigning RSP arguments to processing environment")
212 0
    verbose && cat(verbose, "Environment: ", getName(envir))
213

214 0
    verbose && cat(verbose, "RSP arguments:")
215 0
    verbose && str(verbose, args)
216

217
    # Assign arguments to the parse/evaluation environment
218 0
    names <- attachLocally(args, envir=envir)
219 0
    if (verbose) {
220 0
      if (length(names) > 0L) {
221 0
        printf(verbose, "Variables assigned: [%d] %s\n", length(names), hpaste(names))
222 0
        member <- NULL; rm(list="member"); # To please R CMD check
223 0
        ll <- subset(ll(envir=envir), member %in% names)
224 0
        print(verbose, ll)
225
      }
226
    }
227 0
    verbose && exit(verbose)
228
  } else {
229 1
    names <- NULL
230
  }
231

232 1
  if (verbose) {
233 1
    enter(verbose, "Parse RSP string")
234 1
    cat(verbose, "Parse environment: ", getName(envir))
235 1
    if (length(names) > 0L) {
236 0
      ll <- subset(ll(envir=envir), member %in% names)
237 0
      print(verbose, ll)
238
    }
239
  }
240

241
  # Class to parse to
242 1
  as <- if (inherits(output, "RspDocument")) "RspDocument" else "RspString"
243 1
  res <- parseDocument(object, envir=envir, ..., until=until, as=as, verbose=verbose)
244 1
  verbose && print(verbose, res)
245 1
  verbose && exit(verbose)
246

247
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
248
  # Return as RspSourceCode, write to file, or ...?
249
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
250 1
  if (inherits(output, "RspDocument")) {
251 1
  } else if (inherits(output, "RspString")) {
252 0
  } else if (!is.null(output)) {
253
    # Write to file
254 0
    verbose && enter(verbose, "Writing to output")
255 0
    cat(res, file=output)
256 0
    verbose && exit(verbose)
257 0
    res <- RspFileProduct(output, type=getType(res), metadata=getMetadata(res, local=TRUE), mustExist=FALSE)
258
  }
259

260 1
  verbose && exit(verbose)
261

262 1
  res
263
}) # rcompile()
264

265

266

267
setMethodS3("rcompile", "RspDocument", function(object, envir=parent.frame(), ..., verbose=FALSE) {
268
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
269
  # Validate arguments
270
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
271
  # Argument 'verbose':
272 0
  verbose <- Arguments$getVerbose(verbose)
273 0
  if (verbose) {
274 0
    pushState(verbose)
275 0
    on.exit(popState(verbose))
276
  }
277

278 0
  verbose && enter(verbose, "rcompile() for ", class(object)[1L])
279

280 0
  verbose && enter(verbose, "Coercing RSP document to RSP string")
281 0
  s <- asRspString(object)
282 0
  verbose && exit(verbose)
283

284 0
  res <- rcompile(s, ..., envir=envir, verbose=verbose)
285

286 0
  verbose && exit(verbose)
287

288 0
  res
289
}) # rcompile()

Read our documentation on viewing source code .

Loading