1
###########################################################################/**
2
# @RdocClass RspProduct
3
#
4
# @title "The RspProduct class"
5
#
6
# \description{
7
#  @classhierarchy
8
#
9
#  An RspProduct object represents an RSP product generated by processing
10
#  an RSP document.
11
# }
12
#
13
# @synopsis
14
#
15
# \arguments{
16
#   \item{object}{The RSP product.}
17
#   \item{...}{Arguments passed to @see "RspObject".}
18
# }
19
#
20
# \section{Fields and Methods}{
21
#  @allmethods
22
# }
23
#
24
# @author
25
#
26
# @keyword internal
27
#*/###########################################################################
28
setConstructorS3("RspProduct", function(object=NA, ...) {
29 1
  extend(RspObject(object, ...), "RspProduct")
30
})
31

32

33
setMethodS3("print", "RspProduct", function(x, ...) {
34 1
  s <- sprintf("%s:", class(x)[1L])
35 1
  s <- c(s, sprintf("Content type: %s", getType(x)))
36 1
  md <- getMetadata(x, local=FALSE)
37 1
  for (key in names(md)) {
38 0
    s <- c(s, sprintf("Metadata '%s': '%s'", key, md[[key]]))
39
  }
40 1
  s <- c(s, sprintf("Has processor: %s", hasProcessor(x)))
41 1
  s <- paste(s, collapse="\n")
42 1
  cat(s, "\n", sep="")
43
}, protected=TRUE)
44

45

46

47
#########################################################################/**
48
# @RdocMethod view
49
# @alias view.RspFileProduct
50
# @alias !.RspProduct
51
#
52
# @title "Views the RSP product"
53
#
54
# \description{
55
#  @get "title".
56
# }
57
#
58
# @synopsis
59
#
60
# \arguments{
61
#   \item{...}{Not used.}
62
# }
63
#
64
# \value{
65
#  Returns the RSP product (invisibly).
66
# }
67
#
68
# @author
69
#
70
# \seealso{
71
#   @seeclass
72
# }
73
#*/#########################################################################
74
setMethodS3("view", "RspProduct", abstract=TRUE)
75

76

77
setMethodS3("!", "RspProduct", function(x) {
78 0
  view(x)
79
}, appendVarArgs=FALSE, protected=TRUE)
80

81

82

83
#########################################################################/**
84
# @RdocMethod getType
85
# @alias getType.RspFileProduct
86
#
87
# @title "Gets the type of an RSP product"
88
#
89
# \description{
90
#  @get "title".
91
# }
92
#
93
# @synopsis
94
#
95
# \arguments{
96
#   \item{default}{If unknown/not set, the default content type to return.}
97
#   \item{...}{Not used.}
98
# }
99
#
100
# \value{
101
#  Returns a @character string.
102
# }
103
#
104
# @author
105
#
106
# \seealso{
107
#   @seeclass
108
# }
109
#*/#########################################################################
110
setMethodS3("getType", "RspProduct", function(object, default=NA_character_, as=c("text", "IMT"), ...) {
111 1
  as <- match.arg(as)
112 1
  res <- getAttribute(object, "type", default=as.character(default))
113 1
  res <- tolower(res)
114 1
  if (as == "IMT" && !is.na(res)) {
115 0
    res <- parseInternetMediaType(res)
116
  }
117 1
  res
118
}, protected=TRUE)
119

120

121

122
###########################################################################/**
123
# @RdocMethod hasProcessor
124
#
125
# @title "Checks whether a processor exist or not for an RSP product"
126
#
127
# \description{
128
#  @get "title".
129
# }
130
#
131
# @synopsis
132
#
133
# \arguments{
134
#   \item{...}{Not used.}
135
# }
136
#
137
# \value{
138
#   Returns @TRUE if one exists, otherwise @FALSE.
139
# }
140
#
141
# @author
142
#
143
# @keyword file
144
# @keyword IO
145
#*/###########################################################################
146
setMethodS3("hasProcessor", "RspProduct", function(object, ...) {
147 1
  !is.null(findProcessor(object, ...))
148
}, protected=TRUE)
149

150

151

152
###########################################################################/**
153
# @RdocMethod findProcessor
154
# @alias findProcessor.RspFileProduct
155
#
156
# @title "Locates a processor for an RSP product"
157
#
158
# \description{
159
#  @get "title".
160
# }
161
#
162
# @synopsis
163
#
164
# \arguments{
165
#   \item{...}{Not used.}
166
# }
167
#
168
# \value{
169
#   Returns a @function that takes an @see "RspProduct" as input,
170
#   or @NULL if no processor was found.
171
# }
172
#
173
# @author
174
#
175
# @keyword file
176
# @keyword IO
177
#*/###########################################################################
178
setMethodS3("findProcessor", "RspProduct", function(object, ...) {
179 1
  NULL
180
}, protected=TRUE) # findProcessor()
181

182

183

184

185
###########################################################################/**
186
# @RdocMethod process
187
#
188
# @title "Processes an RSP file product"
189
#
190
# \description{
191
#  @get "title".
192
# }
193
#
194
# @synopsis
195
#
196
# \arguments{
197
#   \item{type}{A @character string specifying the content type.}
198
#   \item{workdir}{A temporary working directory to use during processing.
199
#      If @NULL, the working directory is not changed.}
200
#   \item{...}{Optional arguments passed to the processor @function.}
201
#   \item{recursive}{
202
#      If a positive number (or +@Inf), then processed output that can be
203
#      processed will be processed recursively (with this argument being
204
#      decreased by one).
205
#      A value @TRUE corresponds to +@Inf (infinite processing if possible).
206
#      A value @FALSE corresponds to 0 (no further processing).
207
#   }
208
#   \item{verbose}{See @see "R.utils::Verbose".}
209
# }
210
#
211
# \value{
212
#   Returns the processed RSP product output as another @see "RspProduct".
213
#   If no processor exists, the input object itself is returned.
214
# }
215
#
216
# @author
217
#
218
# @keyword file
219
# @keyword IO
220
#*/###########################################################################
221
setMethodS3("process", "RspProduct", function(object, type=NULL, envir=parent.frame(), workdir=NULL, ..., recursive=TRUE, verbose=FALSE) {
222
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
223
  # Validate arguments
224
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
225
  # Arguments 'type':
226 1
  if (is.null(type)) {
227 1
    type <- getType(object)
228
  }
229 1
  type <- Arguments$getCharacter(type, length=c(1L,1L))
230 1
  type <- tolower(type)
231

232
  # Arguments 'envir':
233 1
  stop_if_not(is.environment(envir))
234

235
  # Arguments 'workdir':
236 1
  if (!is.null(workdir)) {
237 1
    workdir <- Arguments$getWritablePath(workdir)
238 1
    if (is.null(workdir)) workdir <- getwd()
239 1
    workdir <- getAbsolutePath(workdir)
240
  }
241

242
  # Argument 'recursive':
243 1
  if (is.numeric(recursive)) {
244 1
    recursive <- Arguments$getNumeric(recursive)
245
  } else {
246 1
    recursive <- Arguments$getLogical(recursive)
247 1
    if (recursive) {
248 1
      recursive <- Inf
249
    } else {
250 0
      recursive <- 0
251
    }
252
  }
253

254
  # Argument 'verbose':
255 1
  verbose <- Arguments$getVerbose(verbose)
256 1
  if (verbose) {
257 1
    pushState(verbose)
258 1
    on.exit(popState(verbose))
259
  }
260

261

262 1
  verbose && enter(verbose, "Processing RSP product")
263 1
  verbose && print(verbose, object)
264

265 1
  processor <- findProcessor(object, verbose=verbose)
266

267
  # Nothing to do?
268 1
  if (is.null(processor)) {
269 0
    verbose && cat(verbose, "There is no known processor for this content type: ", type)
270 0
    verbose && exit(verbose)
271 0
    return(object)
272
  }
273

274 1
  verbose && enter(verbose, "Processing")
275

276
  # Change working directory?
277 1
  if (!is.null(workdir)) {
278 1
    opwd <- getwd()
279 1
    on.exit({ if (!is.null(opwd)) setwd(opwd) }, add=TRUE)
280 1
    setwd(workdir)
281
  }
282

283
  # Override type with user argument type, if given.
284 1
  if (identical(type, getType(object))) {
285 1
    object <- setAttribute(object, "type", type)
286
  }
287

288 1
  verbose && print(verbose, object)
289 1
  verbose && print(verbose, processor)
290 1
  res <- processor(object, envir=envir, ..., verbose=verbose)
291 1
  verbose && print(verbose, res)
292

293
  # Reset working directory
294 1
  if (!is.null(workdir)) {
295 1
    if (!is.null(opwd)) {
296 1
      setwd(opwd)
297 1
      opwd <- NULL
298
    }
299
  }
300

301 1
  if (!is.null(res) && recursive > 0L && hasProcessor(res)) {
302 1
    verbose && enter(verbose, "Recursive processing")
303 1
    verbose && cat(verbose, "Recursive depth: ", recursive)
304 1
    object <- res
305 1
    res <- process(object, type=type, envir=envir, workdir=workdir, ..., recursive=(recursive - 1), verbose=verbose)
306 1
    verbose && exit(verbose)
307
  }
308

309 1
  verbose && exit(verbose)
310

311 1
  verbose && exit(verbose)
312

313 1
  res
314
}) # process()

Read our documentation on viewing source code .

Loading