1
###########################################################################/**
2
# @RdocClass HttpRequest
3
#
4
# @title "The HttpRequest class"
5
#
6
# \description{
7
#  @classhierarchy
8
# }
9
#
10
# @synopsis
11
#
12
# \arguments{
13
#   \item{requestUri}{A @character string of the requested URI.}
14
#   \item{parameters}{A named @list of parameter values.}
15
#   \item{...}{Not used.}
16
# }
17
#
18
# \section{Fields and Methods}{
19
#  @allmethods
20
# }
21
#
22
# @author
23
# @keyword internal
24
#*/###########################################################################
25
setConstructorS3("HttpRequest", function(requestUri=NULL, parameters=list(), ...) {
26 1
  if (is.list(requestUri)) {
27 0
    request <- requestUri
28 0
    requestUri <- request$requestUri
29 0
    parameters <- request$parameters
30
  }
31

32
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
33
  # Validate arguments
34
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
35
  # Argument 'requestUri':
36 1
  requestUri <- Arguments$getCharacter(requestUri)
37

38
  # Argument 'parameters':
39 1
  if (!is.list(parameters))
40 0
    stop("Argument 'parameters' must be a list: ", mode(parameters))
41

42 1
  extend(Object(), "HttpRequest",
43 1
    serverPort = NA,
44 1
    serverName = NA,
45 1
    contextRoot = ".",
46 1
    contextType = NA,
47 1
    contextLength = -1,
48 1
    remoteAddress = NA,
49 1
    remoteHost = NA,
50 1
    scheme = NA,
51 1
    protocol = NA,
52 1
    requestUri = requestUri,
53 1
    parameters = parameters,
54
    ...
55
  )
56
})
57

58

59
###########################################################################/**
60
# @RdocMethod as.character
61
#
62
# @title "Returns a short string describing the HTTP request"
63
#
64
# \description{
65
#  @get "title".
66
# }
67
#
68
# @synopsis
69
#
70
# \arguments{
71
#   \item{...}{Not used.}
72
# }
73
#
74
# \value{
75
#  Returns a @character string.
76
# }
77
#
78
# @author
79
#
80
# \seealso{
81
#   @seeclass
82
# }
83
#
84
# @keyword IO
85
# @keyword programming
86
#*/###########################################################################
87
setMethodS3("as.character", "HttpRequest", function(x, ...) {
88
  # To please R CMD check
89 0
  this <- x
90

91 0
  s <- paste(class(this)[1], ":", sep="")
92

93 0
  if (is.null(this$requestUri)) {
94 0
    s <- paste(s, " Request URI: <none>.", sep="")
95
  } else {
96 0
    s <- paste(s, " Request URI: ", this$requestUri, ".", sep="")
97
  }
98

99 0
  if (nbrOfParameters(this) > 0) {
100 0
    params <- unlist(this$parameters, use.names=TRUE)
101 0
    params <- paste(names(params), params, sep="=")
102 0
    params <- paste(params, collapse=", ")
103 0
    s <- paste(s, " Parameters: ", params, ".", sep="")
104
  } else {
105 0
    s <- paste(s, " Parameters: <none>.", sep="")
106
  }
107 0
  s
108
})
109

110

111

112

113

114
#########################################################################/**
115
# @RdocMethod nbrOfParameters
116
#
117
# @title "Gets the number of parameters"
118
#
119
# \description{
120
#  @get "title".
121
# }
122
#
123
# @synopsis
124
#
125
# \arguments{
126
#   \item{...}{Not used.}
127
# }
128
#
129
# \value{
130
#  Returns an @integer.
131
# }
132
#
133
# @author
134
#
135
# \seealso{
136
#   @seemethod "getParameter".
137
#   @seemethod "hasParameter".
138
#   @seeclass
139
# }
140
#
141
# @keyword IO
142
#*/#########################################################################
143
setMethodS3("nbrOfParameters", "HttpRequest", function(this, ...) {
144 0
  length(this$parameters)
145
})
146

147

148

149
#########################################################################/**
150
# @RdocMethod getParameters
151
#
152
# @title "Gets all parameters"
153
#
154
# \description{
155
#  @get "title".
156
# }
157
#
158
# @synopsis
159
#
160
# \arguments{
161
#   \item{trim}{If @TRUE, each parameter value is trimmed of whitespace.}
162
#   \item{...}{Not used.}
163
# }
164
#
165
# \value{
166
#  Returns a named @list.
167
# }
168
#
169
# @author
170
#
171
# \seealso{
172
#   @seemethod "getParameter".
173
#   @seeclass
174
# }
175
#
176
# @keyword IO
177
#*/#########################################################################
178
setMethodS3("getParameters", "HttpRequest", function(this, trim=FALSE, ...) {
179 0
  params <- as.list(this$parameters)
180 0
  if (trim) {
181 0
    params <- lapply(params, FUN=trim)
182
  }
183 0
  params
184
})
185

186

187

188
#########################################################################/**
189
# @RdocMethod getParameter
190
#
191
# @title "Gets a parameter"
192
#
193
# \description{
194
#  @get "title".
195
# }
196
#
197
# @synopsis
198
#
199
# \arguments{
200
#   \item{name}{Name of parameter to be retrieved.}
201
#   \item{default}{Value to be returned if parameter is missing.}
202
#   \item{drop}{If @TRUE and the number of returned values is one, then
203
#    this single value is returned, otherwise a named @vector.}
204
#   \item{...}{Additional arguments passed to @seemethod "getParameters".}
205
# }
206
#
207
# \value{
208
#  Returns the value(s) of the parameter either as a single value or
209
#  as a named @list.
210
#  If the parameter does not exist, the default value is returned as is.
211
# }
212
#
213
# @author
214
#
215
# \seealso{
216
#   @seemethod "hasParameter".
217
#   @seemethod "getParameters".
218
#   @seeclass
219
# }
220
#
221
# @keyword IO
222
#*/#########################################################################
223
setMethodS3("getParameter", "HttpRequest", function(this, name, default=NULL, drop=TRUE, ...) {
224 0
  if (hasParameter(this, name)) {
225 0
    params <- getParameters(this, ...)
226 0
    idxs <- which(names(params) == name)
227 0
    params <- params[idxs]
228

229 0
    if (drop && length(params) == 1L) {
230 0
      params <- params[[1L]]
231
    }
232
  } else {
233 0
    params <- default
234
  }
235

236 0
  params
237
})
238

239

240

241

242

243
#########################################################################/**
244
# @RdocMethod hasParameter
245
#
246
# @title "Checks if a parameter exists"
247
#
248
# \description{
249
#  @get "title".
250
# }
251
#
252
# @synopsis
253
#
254
# \arguments{
255
#   \item{name}{Name of parameter to be checked.}
256
#   \item{...}{Not used.}
257
# }
258
#
259
# \value{
260
#  Returns @TRUE if the parameter exists, otherwise @FALSE.
261
# }
262
#
263
# @author
264
#
265
# \seealso{
266
#   @seemethod "getParameter".
267
#   @seeclass
268
# }
269
#
270
# @keyword IO
271
#*/#########################################################################
272
setMethodS3("hasParameter", "HttpRequest", function(this, name, ...) {
273 0
  name <- Arguments$getCharacter(name, nchar=c(1,256))
274 0
  is.element(name, names(this$parameters))
275
})
276

277

278

279

280

281
#########################################################################/**
282
# @RdocMethod getRemoteAddress
283
#
284
# @title "Gets the IP address of the client that sent the request"
285
#
286
# \description{
287
#  @get "title".
288
# }
289
#
290
# @synopsis
291
#
292
# \arguments{
293
#   \item{...}{Not used.}
294
# }
295
#
296
# \value{
297
#  Returns a @character string.
298
# }
299
#
300
# @author
301
#
302
# \seealso{
303
#   @see "getRemoteHost".
304
#   @seeclass
305
# }
306
#
307
# @keyword IO
308
#*/#########################################################################
309
setMethodS3("getRemoteAddress", "HttpRequest", function(this, ...) {
310 0
  this$remoteAddress
311
})
312

313

314

315
#########################################################################/**
316
# @RdocMethod getRemoteHost
317
#
318
# @title "Gets the fully qualified name of the client that sent the request"
319
#
320
# \description{
321
#  @get "title".
322
#  If it cannot resolve the hostname, this method returns the dotted-string
323
#  form of the IP address.
324
# }
325
#
326
# @synopsis
327
#
328
# \arguments{
329
#   \item{...}{Not used.}
330
# }
331
#
332
# \value{
333
#  Returns a @character string.
334
# }
335
#
336
# @author
337
#
338
# \seealso{
339
#   @see "getRemoteAddress".
340
#   @seeclass
341
# }
342
#
343
# @keyword IO
344
#*/#########################################################################
345
setMethodS3("getRemoteHost", "HttpRequest", function(this, ...) {
346 0
  this$remoteHost
347
})
348

349

350

351

352
#########################################################################/**
353
# @RdocMethod getServerName
354
#
355
# @title "Gets the host name of the server that reviewed the request"
356
#
357
# \description{
358
#  @get "title".
359
# }
360
#
361
# @synopsis
362
#
363
# \arguments{
364
#   \item{...}{Not used.}
365
# }
366
#
367
# \value{
368
#  Returns a @character string.
369
# }
370
#
371
# @author
372
#
373
# \seealso{
374
#   @see "getServerPort".
375
#   @seeclass
376
# }
377
#
378
# @keyword IO
379
#*/#########################################################################
380
setMethodS3("getServerName", "HttpRequest", function(this, ...) {
381 0
  this$serverName
382
})
383

384

385

386

387
#########################################################################/**
388
# @RdocMethod getServerPort
389
#
390
# @title "Gets the port number on which this request was received"
391
#
392
# \description{
393
#  @get "title".
394
# }
395
#
396
# @synopsis
397
#
398
# \arguments{
399
#   \item{...}{Not used.}
400
# }
401
#
402
# \value{
403
#  Returns an @integer.
404
# }
405
#
406
# @author
407
#
408
# \seealso{
409
#   @see "getServerPort".
410
#   @seeclass
411
# }
412
#
413
# @keyword IO
414
#*/#########################################################################
415
setMethodS3("getServerPort", "HttpRequest", function(this, ...) {
416 0
  as.integer(this$serverPort)
417
})
418

419

420

421
#########################################################################/**
422
# @RdocMethod getScheme
423
#
424
# @title "Gets the scheme used to make this request"
425
#
426
# \description{
427
#  @get "title", e.g. http, https, or ftp.
428
# }
429
#
430
# @synopsis
431
#
432
# \arguments{
433
#   \item{...}{Not used.}
434
# }
435
#
436
# \value{
437
#  Returns a @character string.
438
# }
439
#
440
# @author
441
#
442
# \seealso{
443
#   @see "getProtocol".
444
#   @seeclass
445
# }
446
#
447
# @keyword IO
448
#*/#########################################################################
449
setMethodS3("getScheme", "HttpRequest", function(this, ...) {
450 0
  this$scheme
451
})
452

453

454
#########################################################################/**
455
# @RdocMethod getProtocol
456
#
457
# @title "Gets the name and version of the protocol used to make this request"
458
#
459
# \description{
460
#  @get "title", e.g. HTTP/1.1.
461
# }
462
#
463
# @synopsis
464
#
465
# \arguments{
466
#   \item{...}{Not used.}
467
# }
468
#
469
# \value{
470
#  Returns a @character string.
471
# }
472
#
473
# @author
474
#
475
# \seealso{
476
#   @see "getScheme".
477
#   @seeclass
478
# }
479
#
480
# @keyword IO
481
#*/#########################################################################
482
setMethodS3("getProtocol", "HttpRequest", function(this, ...) {
483 0
  this$protocol
484
})
485

486

487

488
#########################################################################/**
489
# @RdocMethod getContentType
490
#
491
# @title "Gets the MIME type of the body of the request"
492
#
493
# \description{
494
#  @get "title", or @NULL if the type is not known.
495
# }
496
#
497
# @synopsis
498
#
499
# \arguments{
500
#   \item{...}{Not used.}
501
# }
502
#
503
# \value{
504
#  Returns a @character string.
505
# }
506
#
507
# @author
508
#
509
# \seealso{
510
#   @seeclass
511
# }
512
#
513
# @keyword IO
514
#*/#########################################################################
515
setMethodS3("getContentType", "HttpRequest", function(this, ...) {
516 0
  this$contentType
517
})
518

519

520
#########################################################################/**
521
# @RdocMethod getContentLength
522
#
523
# @title "Gets the length of contents"
524
#
525
# \description{
526
#  @get "title" (in bytes), or -1 if the length is not known.
527
# }
528
#
529
# @synopsis
530
#
531
# \arguments{
532
#   \item{...}{Not used.}
533
# }
534
#
535
# \value{
536
#  Returns an @integer.
537
# }
538
#
539
# @author
540
#
541
# \seealso{
542
#   @seeclass
543
# }
544
#
545
# @keyword IO
546
#*/#########################################################################
547
setMethodS3("getContentLength", "HttpRequest", function(this, ...) {
548 0
  len <- this$contentLength
549 0
  if (is.null(len))
550 0
    len <- -1
551 0
  as.integer(len)
552
})
553

554
setMethodS3("getDateHeader", "HttpRequest", function(this, ...) {
555
}, protected=TRUE)
556

557
setMethodS3("getHeader", "HttpRequest", function(this, ...) {
558
}, protected=TRUE)
559

560

561
setMethodS3("getContextPath", "HttpRequest", function(this, ...) {
562
}, protected=TRUE)
563

564

565
setMethodS3("getQueryString", "HttpRequest", function(this, ...) {
566 0
  this$queryString
567
}, protected=TRUE)
568

569
setMethodS3("getRemoteUser", "HttpRequest", function(this, ...) {
570
}, protected=TRUE)
571

572
setMethodS3("getRequestUri", "HttpRequest", function(this, ...) {
573 0
  this$requestUri
574
}, protected=TRUE)
575

576
setMethodS3("getRequestUrl", "HttpRequest", function(this, ...) {
577
}, protected=TRUE)
578

579
setMethodS3("getServletPath", "HttpRequest", function(this, ...) {
580
}, protected=TRUE)
581

582

583

584
#########################################################################/**
585
# @RdocMethod getRealPath
586
#
587
# @title "Gets the file system path for a given URI"
588
#
589
# \description{
590
#  @get "title".
591
# }
592
#
593
# @synopsis
594
#
595
# \arguments{
596
#   \item{uri}{A URI as a @character string.}
597
#   \item{...}{Not used.}
598
# }
599
#
600
# \value{
601
#  Returns a @character string.
602
# }
603
#
604
# @author
605
#
606
# \seealso{
607
#   @seeclass
608
# }
609
#
610
# @keyword IO
611
#*/#########################################################################
612
setMethodS3("getRealPath", "HttpRequest", function(this, uri, ...) {
613 0
  contextRoot <- this$contextRoot
614 0
  realPath <- filePath(contextRoot, uri)
615 0
  realPath
616
})

Read our documentation on viewing source code .

Loading