1
###########################################################################/**
2
# @RdocDefault rfile
3
# @alias rfile.RspString
4
# @alias rfile.RspDocument
5
# @alias rfile.RspRSourceCode
6
# @alias rfile.RspShSourceCode
7
# @alias rfile.function
8
# @alias rfile.expression
9
#
10
# @title "Evaluates and postprocesses an RSP document and outputs the final RSP document file"
11
#
12
# \description{
13
#  @get "title".
14
# }
15
#
16
# @synopsis
17
#
18
# \arguments{
19
#   \item{file, path}{Specifies the RSP file to processed, which can
20
#      be a file, a URL or a @connection.
21
#      If a file, the \code{path} is prepended to the file, iff given.}
22
#   \item{output}{A @character string or a @connection specifying where
23
#      output should be directed.
24
#      The default is a file with a filename where the file extension
25
#      (typically \code{".rsp"}) has been dropped from \code{file}
26
#      in the directory given by the \code{workdir} argument.}
27
#   \item{workdir}{The working directory to use after parsing and
28
#      preprocessing, but while \emph{evaluating} and \emph{postprocessing}
29
#      the RSP document.
30
#      If argument \code{output} specifies an absolute pathname,
31
#      then the directory of \code{output} is used, otherwise the
32
#      current directory is used.}
33
#   \item{type}{The default content type of the RSP document.  By default, it
34
#      is inferred from the \code{output} filename extension, iff possible.}
35
#   \item{envir}{The @environment in which the RSP document is
36
#      preprocessed and evaluated.}
37
#   \item{args}{A named @list of arguments assigned to the environment
38
#     in which the RSP string is parsed and evaluated.
39
#     See @see "R.utils::cmdArgs".}
40
#   \item{postprocess}{If @TRUE, and a postprocessing method exists for
41
#      the generated RSP product, it is postprocessed as well.}
42
#   \item{...}{Additional arguments passed to the RSP engine.}
43
#   \item{verbose}{See @see "R.utils::Verbose".}
44
# }
45
#
46
# \value{
47
#   Returns an @see "RspProduct".
48
#   If argument \code{output} specifies a file, then this is
49
#   an @see "RspFileProduct".
50
# }
51
#
52
# \section{Processing RSP files from the command line}{
53
#   Using @see "Rscript" and \code{rfile()}, it is possible to process
54
#   an RSP file from the command line.  For example,
55
#
56
#   \code{Rscript -e "R.rsp::rfile('RSP_refcard.tex.rsp')"}
57
#
58
#   parses and evaluates \file{RSP_refcard.tex.rsp} and output \file{RSP_refcard.pdf} in the current directory.
59
#   A CLI-friendly alternative to the above is:
60
#
61
#   \code{Rscript -e R.rsp::rfile RSP_refcard.tex.rsp}
62
# }
63
#
64
# \examples{
65
# @include "../incl/rfile.Rex"
66
#
67
# \dontrun{
68
# # Compile and display the main vignette (requires LaTeX)
69
# if (isCapableOf(R.rsp, "latex")) {
70
#   path <- system.file("doc", package="R.rsp")
71
#   pdf <- rfile("Dynamic_document_creation_using_RSP.tex.rsp", path=path)
72
#   cat("Created document: ", pdf, "\n", sep="")
73
#   if (interactive()) browseURL(pdf)
74
# }
75
# }
76
# }
77
#
78
# @author
79
#
80
# \seealso{
81
#  @see "rstring" and @see "rcat".
82
# }
83
#
84
# @keyword file
85
# @keyword IO
86
#*/###########################################################################
87
setMethodS3("rfile", "default", function(file, path=NULL, output=NULL, workdir=NULL, type=NA, envir=parent.frame(), args="*", postprocess=TRUE, ..., verbose=FALSE) {
88
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
89
  # Validate arguments
90
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
91
  # Argument 'file' & 'path':
92 1
  if (inherits(file, "connection")) {
93 1
  } else if (inherits(file, "RspFileProduct")) {
94 1
  } else if (is.character(file)) {
95 1
    if (!is.null(path)) {
96 1
      file <- file.path(path, file)
97
    }
98 1
    if (!isUrl(file)) {
99 1
      withoutGString({
100 1
        file <- Arguments$getReadablePathname(file, absolute=TRUE)
101
      })
102
    }
103
  }
104

105
  # Argument 'workdir':
106 1
  if (is.null(workdir)) {
107 1
    if (isAbsolutePath(output)) {
108 0
      workdir <- getParent(output)
109
    } else {
110 1
      workdir <- "."
111
    }
112
  }
113 1
  workdir <- Arguments$getWritablePath(workdir)
114 1
  if (is.null(workdir)) workdir <- "."
115

116
  # Argument 'output':
117 1
  if (is.null(output)) {
118 1
    if (inherits(file, "connection")) {
119 0
      throw("When argument 'file' is a connection, then 'output' must be specified.")
120
    }
121

122
    # Is the input a filename or an URI?
123 1
    if (isUrl(file)) {
124
      # If URI, drop any URI arguments
125 0
      url <- splitUrl(file)
126 0
      filename <- basename(url$path)
127 0
      filename <- Arguments$getReadablePathname(filename, adjust="url", mustExist=FALSE)
128
    } else {
129 1
      filename <- basename(file)
130
    }
131

132 1
    pattern <- "((.*)[.]([^.]+)|([^.]+))[.]([^.]+)$"
133 1
    outputF <- gsub(pattern, "\\1", filename, ignore.case=TRUE)
134 1
    withoutGString({
135 1
      output <- Arguments$getWritablePathname(outputF, path=workdir)
136
    })
137 1
    output <- getAbsolutePath(output)
138
    # Don't overwrite the input file
139 1
    if (output == file) {
140 0
      throw("Cannot process RSP file. The inferred argument 'output' is the same as argument 'file' & 'path': ", output, " == ", file)
141
    }
142 0
  } else if (inherits(output, "connection")) {
143 0
  } else if (identical(output, "")) {
144 0
    output <- stdout()
145 0
  } else if (is.character(output)) {
146 0
    withoutGString({
147 0
      if (isAbsolutePath(output)) {
148 0
        output <- Arguments$getWritablePathname(output)
149
      } else {
150 0
        output <- Arguments$getWritablePathname(output, path=workdir)
151 0
        output <- getAbsolutePath(output)
152
      }
153
    })
154 0
    if (is.character(file) && (output == file)) {
155 0
      throw("Cannot process RSP file. Argument 'output' specifies the same file as argument 'file' & 'path': ", output, " == ", file)
156
    }
157
  } else {
158 0
    throw("Argument 'output' of unknown type: ", class(output)[1L])
159
  }
160

161
  # Argument 'type':
162 1
  if (is.null(type)) {
163 0
    if (is.character(output)) {
164 0
      type <- extensionToIMT(output)
165 0
      attr(type, "fixed") <- TRUE
166
    } else {
167 0
      type <- NA
168
    }
169
  }
170 1
  if (is.na(type)) {
171 1
    if (is.character(output)) {
172 1
      type <- extensionToIMT(output)
173
    }
174
  }
175 1
  fixed <- attr(type, "fixed")
176 1
  type <- Arguments$getCharacter(type)
177 1
  attr(type, "fixed") <- fixed
178

179
  # Argument 'envir':
180 1
  stop_if_not(is.environment(envir))
181

182
  # Argument 'args':
183 1
  args <- cmdArgs(args=args)
184

185
  # Argument 'verbose':
186 1
  verbose <- Arguments$getVerbose(verbose)
187 1
  if (verbose) {
188 1
    pushState(verbose)
189 1
    on.exit(popState(verbose), add=TRUE)
190
  }
191

192

193 1
  verbose && enter(verbose, "Processing RSP file")
194

195
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
196
  # Information on input and output
197
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
198 1
  if (verbose) {
199
    # Information on input
200 1
    if (inherits(file, "RspFileProduct")) {
201 0
      cat(verbose, "Input file:")
202 0
      print(verbose, file)
203 1
    } else if (is.character(file)) {
204 1
      if (isUrl(file)) {
205 0
        cat(verbose, "Input URL: ", file)
206
      } else {
207 1
        cat(verbose, "Input pathname: ", file)
208
      }
209 0
    } else if (inherits(file, "connection")) {
210 0
      ci <- summary(file)
211 0
      printf(verbose, "Input '%s' connection: %s\n",
212 0
          class(ci)[1L], ci$description)
213
    }
214

215
    # Information on output
216 1
    if (is.character(output)) {
217 1
      cat(verbose, "Output pathname: ", output)
218 0
    } else if (inherits(output, "connection")) {
219 0
      ci <- summary(output)
220 0
      printf(verbose, "Output '%s' connection: %s\n",
221 0
          class(ci)[1L], ci$description)
222
    }
223

224
    # Information on content *output* type
225 1
    printf(verbose, "Default content type: %s\n", type)
226
  }
227

228

229
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
230
  # Assign RSP arguments
231
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
232 1
  verbose && enter(verbose, "Assigning RSP arguments")
233 1
  verbose && cat(verbose, "Environment: ", getName(envir))
234 1
  if (length(args) > 0L) {
235 1
    verbose && cat(verbose, "Arguments assigned: ", hpaste(names(args)))
236
    # Assign arguments to the parse/evaluation environment
237 1
    attachLocally(args, envir=envir)
238
  } else {
239 1
    verbose && cat(verbose, "Arguments assigned: <none>")
240
  }
241 1
  verbose && exit(verbose)
242

243

244
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
245
  # Processing
246
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
247
  # Coerce to an RspFileProduct
248
  # FIXME: Would be nice to be able to handle unknown file extensions,
249
  # e.g. when an RSP file is downloaded from online wihtout a filename ext.
250 1
  if (!inherits(file, "RspFileProduct")) {
251 1
    file <- RspFileProduct(file, mustExist=FALSE)
252 1
    processor <- findProcessor(file)
253 1
    if (is.null(processor)) {
254
      # Assume an RSP document if type cannot be inferred by filename etc.
255 0
      file <- RspFileProduct(file, type="application/x-rsp", mustExist=FALSE)
256
    }
257
  }
258

259
  # Process...
260 1
  if (getType(file, default="text/plain") == "application/x-rsp") {
261
    # (a) An RSP document, or...
262 1
    verbose && enter(verbose, "Reading RSP document")
263 1
    str <- .readText(file)
264 1
    verbose && printf(verbose, "Number of characters: %d\n", nchar(str))
265 1
    verbose && str(verbose, str)
266 1
    verbose && exit(verbose)
267

268 1
    verbose && enter(verbose, "Parsing RSP document")
269 1
    rstr <- RspString(str, type=type, source=file)
270 1
    rstr <- setMetadata(rstr, name="source", value=file)
271 1
    doc <- parseDocument(rstr, envir=envir, ...)
272 1
    verbose && print(verbose, doc)
273 1
    rstr <- str <- NULL; # Not needed anymore
274 1
    verbose && exit(verbose)
275

276 1
    res <- rfile(doc, output=output, workdir=workdir, envir=envir, args=NULL, postprocess=postprocess, ..., verbose=verbose)
277
  } else {
278
    # (b) ...other type of document.
279 0
    res <- process(file, workdir=workdir, envir=envir, args=NULL, recursive=postprocess, ..., verbose=verbose)
280 0
    res <- setMetadata(res, name="source", value=file)
281
  }
282

283 1
  verbose && exit(verbose)
284

285 1
  res
286
}) # rfile()
287

288

289

290
setMethodS3("rfile", "RspString", function(rstr, ..., verbose=FALSE) {
291
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
292
  # Validate arguments
293
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
294
  # Argument 'verbose':
295 0
  verbose <- Arguments$getVerbose(verbose)
296 0
  if (verbose) {
297 0
    pushState(verbose)
298 0
    on.exit(popState(verbose))
299
  }
300

301 0
  verbose && enter(verbose, "Processing RSP string")
302

303 0
  verbose && enter(verbose, "Parsing RSP document")
304 0
  doc <- parseDocument(rstr, ...)
305 0
  verbose && print(verbose, doc)
306 0
  rstr <- str <- NULL; # Not needed anymore
307 0
  verbose && exit(verbose)
308

309 0
  verbose && enter(verbose, "Translating RSP document (to R)")
310 0
  rcode <- toR(doc, ...)
311 0
  verbose && printf(verbose, "Number of R source code lines: %d\n", length(rcode))
312 0
  doc <- NULL; # Not needed anymore
313 0
  verbose && exit(verbose)
314

315 0
  res <- rfile(rcode, ..., verbose=verbose)
316

317 0
  verbose && exit(verbose)
318

319 0
  res
320
}, protected=TRUE) # rfile()
321

322

323

324
setMethodS3("rfile", "RspDocument", function(doc, ..., verbose=FALSE) {
325
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
326
  # Validate arguments
327
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
328
  # Argument 'verbose':
329 1
  verbose <- Arguments$getVerbose(verbose)
330 1
  if (verbose) {
331 1
    pushState(verbose)
332 1
    on.exit(popState(verbose))
333
  }
334

335 1
  verbose && enter(verbose, "Processing RSP document")
336

337 1
  verbose && enter(verbose, "Translating RSP document (to R)")
338 1
  rcode <- toR(doc, ...)
339 1
  verbose && printf(verbose, "Number of R source code lines: %d\n", length(rcode))
340 1
  doc <- NULL; # Not needed anymore
341 1
  verbose && exit(verbose)
342

343 1
  res <- rfile(rcode, ..., verbose=verbose)
344

345 1
  verbose && exit(verbose)
346

347 1
  res
348
}, protected=TRUE) # rfile()
349

350

351
setMethodS3("rfile", "RspRSourceCode", function(rcode, output, workdir=NULL, envir=parent.frame(), args="*", postprocess=TRUE, ..., verbose=FALSE) {
352
  # In-string variable substitute
353 1
  vsub <- function(pathname, ...) {
354 1
    gstr <- GString(pathname)
355 1
    str <- gstring(gstr, where=c("envir", "Sys.getenv", "getOption"),
356 1
                         envir=envir, inherits=FALSE)[1L]
357 1
    str <- wstring(str, envir=envir)
358 1
    str
359 1
  } # vsub()
360

361

362
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
363
  # Validate arguments
364
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
365
  # Argument 'workdir':
366 1
  if (is.null(workdir)) {
367 1
    if (isAbsolutePath(output)) {
368 0
      workdir <- getParent(output)
369
    } else {
370 1
      workdir <- "."
371
    }
372
  }
373 1
  workdir <- Arguments$getWritablePath(workdir)
374 1
  if (is.null(workdir)) workdir <- "."
375

376
  # Argument 'output':
377 1
  if (inherits(output, "connection")) {
378 1
  } else if (identical(output, "")) {
379 1
    output <- stdout()
380 1
  } else if (is.character(output)) {
381 1
    withoutGString({
382 1
      if (isAbsolutePath(output)) {
383 1
        output <- Arguments$getWritablePathname(output)
384
      } else {
385 1
        output <- Arguments$getWritablePathname(output, path=workdir)
386 1
        output <- getAbsolutePath(output)
387
      }
388
    })
389
  } else {
390 0
    throw("Argument 'output' of unknown type: ", class(output)[1L])
391
  }
392

393
  # Argument 'envir':
394 1
  stop_if_not(is.environment(envir))
395

396
  # Argument 'args':
397 1
  args <- cmdArgs(args=args)
398

399
  # Argument 'verbose':
400 1
  verbose <- Arguments$getVerbose(verbose)
401 1
  if (verbose) {
402 1
    pushState(verbose)
403 1
    on.exit(popState(verbose), add=TRUE)
404
  }
405

406

407 1
  verbose && enter(verbose, "Processing RSP R source code")
408

409 1
  if (verbose) {
410 1
    if (is.character(output)) {
411 1
      cat(verbose, "Output pathname: ", output)
412 0
    } else if (inherits(output, "connection")) {
413 0
      ci <- summary(output)
414 0
      printf(verbose, "Output '%s' connection: %s\n",
415 0
          class(ci)[1L], ci$description)
416
    }
417
  }
418

419

420 1
  verbose && enter(verbose, "Assigning RSP arguments")
421 1
  verbose && cat(verbose, "Environment: ", getName(envir))
422 1
  if (length(args) > 0L) {
423 0
    verbose && cat(verbose, "Arguments assigned: ", hpaste(names(args)))
424
    # Assign arguments to the parse/evaluation environment
425 0
    attachLocally(args, envir=envir)
426
  } else {
427 1
    verbose && cat(verbose, "Arguments assigned: <none>")
428
  }
429 1
  verbose && exit(verbose)
430

431

432 1
  verbose && enter(verbose, "Evaluating RSP R source code")
433

434
  # Change working directory
435 1
  opwd <- NULL
436 1
  if ((workdir != ".") && (workdir != getwd())) {
437 1
    opwd <- getwd()
438 0
    on.exit({ if (!is.null(opwd)) setwd(opwd) }, add=TRUE)
439 1
    verbose && cat(verbose, "Temporary working directory: ", getAbsolutePath(workdir))
440 1
    setwd(workdir)
441
  }
442

443 1
  res <- rcat(rcode, output=output, envir=envir, args=NULL, ..., verbose=less(verbose, 10))
444

445 1
  withoutGString({
446 1
    if (isFile(output)) {
447 1
      res <- RspFileProduct(output, attrs=getAttributes(res))
448

449
      # Rename output file via GString substitution of the filename?
450 1
      resG <- vsub(res)
451 1
      if (resG != res) {
452 0
        if (renameFile(res, resG, overwrite=TRUE)) {
453
          # FIXME: res <- newInstance(res, resG)
454 0
          res <- RspFileProduct(resG, attrs=getAttributes(res))
455
        } else {
456 0
          warning(sprintf("Failed to rename output file containing variable substitutions in its name (keeping the current one): ", sQuote(res), " -> ", sQuote(resG)))
457
        }
458
      }
459 1
      resG <- NULL; # Not needed anymore
460
    } else {
461 1
      res <- RspProduct(output, attrs=getAttributes(res))
462
    }
463 1
  }) # withoutGString()
464

465 1
  verbose && print(verbose, res)
466 1
  rcode <- output <- NULL; # Not needed anymore
467

468
  # Reset the working directory?
469 1
  if (!is.null(opwd)) {
470 1
    setwd(opwd)
471 1
    opwd <- NULL
472
  }
473

474 1
  verbose && exit(verbose)
475

476 1
  if (postprocess && hasProcessor(res)) {
477 1
    res <- process(res, workdir=workdir, ..., verbose=verbose)
478
  }
479

480 1
  verbose && exit(verbose)
481

482 1
  res
483
}, protected=TRUE) # rfile()
484

485

486
setMethodS3("rfile", "function", function(object, ..., envir=parent.frame(), verbose=FALSE) {
487
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
488
  # Validate arguments
489
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
490
  # Argument 'object':
491

492
  # Argument 'verbose':
493 1
  verbose <- Arguments$getVerbose(verbose)
494 1
  if (verbose) {
495 0
    pushState(verbose)
496 0
    on.exit(popState(verbose))
497
  }
498

499 1
  verbose && enter(verbose, "rfile() for ", class(object)[1L])
500

501
  ## Temporarily assign the function to the evaluation environment
502
  ## and set its own environment also to the evaluation environment
503 1
  fcn <- object
504 1
  environment(fcn) <- envir
505 1
  fcnName <- tempvar(".rfcn", value=fcn, envir=envir)
506 1
  on.exit({
507 1
    rm(list=fcnName, envir=envir, inherits=FALSE)
508 1
  }, add=TRUE)
509 1
  code <- sprintf("%s()", fcnName)
510 1
  rcode <- RspRSourceCode(code)
511 1
  res <- rfile(rcode, ..., envir=envir, verbose=verbose)
512

513 1
  verbose && exit(verbose)
514

515 1
  res
516
}, protected=TRUE) # rfile()
517

518

519
setMethodS3("rfile", "expression", function(object, ..., envir=parent.frame(), verbose=FALSE) {
520
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
521
  # Validate arguments
522
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
523
  # Argument 'object':
524

525
  # Argument 'verbose':
526 0
  verbose <- Arguments$getVerbose(verbose)
527 0
  if (verbose) {
528 0
    pushState(verbose)
529 0
    on.exit(popState(verbose))
530
  }
531

532 0
  verbose && enter(verbose, "rfile() for ", class(object)[1L])
533
  # Deparsing 'object[[1L]]' instead of 'object' in order to drop
534
  # the 'expression({ ... })' wrapper.
535 0
  code <- deparse(object[[1L]])
536 0
  rcode <- RspRSourceCode(code)
537 0
  res <- rfile(rcode, ..., envir=envir, verbose=verbose)
538 0
  verbose && exit(verbose)
539

540 0
  res
541
}, protected=TRUE) # rfile()
542

543

544

545
setMethodS3("rfile", "RspShSourceCode", function(rcode, output, workdir=NULL, envir=parent.frame(), args="*", postprocess=TRUE, ..., verbose=FALSE) {
546
  # In-string variable substitute
547 0
  vsub <- function(pathname, ...) {
548 0
    gstr <- GString(pathname)
549 0
    str <- gstring(gstr, where=c("envir", "Sys.getenv", "getOption"),
550 0
                         envir=envir, inherits=FALSE)[1L]
551 0
    str <- wstring(str, envir=envir)
552 0
    str
553 0
  } # vsub()
554

555

556
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
557
  # Validate arguments
558
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
559
  # Argument 'workdir':
560 0
  if (is.null(workdir)) {
561 0
    if (isAbsolutePath(output)) {
562 0
      workdir <- getParent(output)
563
    } else {
564 0
      workdir <- "."
565
    }
566
  }
567 0
  workdir <- Arguments$getWritablePath(workdir)
568 0
  if (is.null(workdir)) workdir <- "."
569

570
  # Argument 'output':
571 0
  if (inherits(output, "connection")) {
572 0
  } else if (identical(output, "")) {
573 0
    output <- stdout()
574 0
  } else if (is.character(output)) {
575 0
    withoutGString({
576 0
      if (isAbsolutePath(output)) {
577 0
        output <- Arguments$getWritablePathname(output)
578
      } else {
579 0
        output <- Arguments$getWritablePathname(output, path=workdir)
580 0
        output <- getAbsolutePath(output)
581
      }
582
    })
583
  } else {
584 0
    throw("Argument 'output' of unknown type: ", class(output)[1L])
585
  }
586

587
  # Argument 'envir':
588 0
  stop_if_not(is.environment(envir))
589

590
  # Argument 'args':
591 0
  args <- cmdArgs(args=args)
592

593
  # Argument 'verbose':
594 0
  verbose <- Arguments$getVerbose(verbose)
595 0
  if (verbose) {
596 0
    pushState(verbose)
597 0
    on.exit(popState(verbose), add=TRUE)
598
  }
599

600

601 0
  verbose && enter(verbose, "Processing RSP R source code")
602

603 0
  if (verbose) {
604 0
    if (is.character(output)) {
605 0
      cat(verbose, "Output pathname: ", output)
606 0
    } else if (inherits(output, "connection")) {
607 0
      ci <- summary(output)
608 0
      printf(verbose, "Output '%s' connection: %s\n",
609 0
          class(ci)[1L], ci$description)
610
    }
611
  }
612

613

614 0
  verbose && enter(verbose, "Assigning RSP arguments")
615 0
  verbose && cat(verbose, "Environment: ", getName(envir))
616 0
  if (length(args) > 0L) {
617 0
    verbose && cat(verbose, "Arguments assigned: ", hpaste(names(args)))
618
    # Assign arguments to the parse/evaluation environment
619 0
    attachLocally(args, envir=envir)
620
  } else {
621 0
    verbose && cat(verbose, "Arguments assigned: <none>")
622
  }
623 0
  verbose && exit(verbose)
624

625

626 0
  verbose && enter(verbose, "Evaluating RSP R source code")
627

628
  # Change working directory
629 0
  opwd <- NULL
630 0
  if ((workdir != ".") && (workdir != getwd())) {
631 0
    opwd <- getwd()
632 0
    on.exit({ if (!is.null(opwd)) setwd(opwd) }, add=TRUE)
633 0
    verbose && cat(verbose, "Temporary working directory: ", getAbsolutePath(workdir))
634 0
    setwd(workdir)
635
  }
636

637 0
  res <- rcat(rcode, output=output, envir=envir, args=NULL, ..., verbose=less(verbose, 10))
638

639 0
  withoutGString({
640 0
    if (isFile(output)) {
641 0
      res <- RspFileProduct(output, attrs=getAttributes(res))
642

643
      # Rename output file via GString substitution of the filename?
644 0
      resG <- vsub(res)
645 0
      if (resG != res) {
646 0
        if (renameFile(res, resG, overwrite=TRUE)) {
647
          # FIXME: res <- newInstance(res, resG)
648 0
          res <- RspFileProduct(resG, attrs=getAttributes(res))
649
        } else {
650 0
          warning(sprintf("Failed to rename output file containing variable substitutions in its name (keeping the current one): ", sQuote(res), " -> ", sQuote(resG)))
651
        }
652
      }
653 0
      resG <- NULL; # Not needed anymore
654
    } else {
655 0
      res <- RspProduct(output, attrs=getAttributes(res))
656
    }
657 0
  }) # withoutGString()
658

659 0
  verbose && print(verbose, res)
660 0
  rcode <- output <- NULL; # Not needed anymore
661

662
  # Reset the working directory?
663 0
  if (!is.null(opwd)) {
664 0
    setwd(opwd)
665 0
    opwd <- NULL
666
  }
667

668 0
  verbose && exit(verbose)
669

670 0
  if (postprocess && hasProcessor(res)) {
671 0
    res <- process(res, workdir=workdir, ..., verbose=verbose)
672
  }
673

674 0
  verbose && exit(verbose)
675

676 0
  res
677
}, protected=TRUE) # rfile()

Read our documentation on viewing source code .

Loading