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
|
### =========================================================================
### RestContainer objects
### -------------------------------------------------------------------------
###
### A means for accessing a URI using vector-like syntax.
###
setClass("RestContainer", representation(uri="RestUri"))
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Constructor
###
RestContainer <- function(...) {
container(RestUri(...))
}
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### CREATE
###
## How about: service$objects[] <- new.objects.
## The syntax service$objects[] means extract everything, because the
## default index is the wildcard. Intuitively, one would expect the
## same for []<-, i.e., replace-all; however, we could take the
## default to be the IDs of the elements being added. This is a
## primary difference from a DB API and R vectors: with databases, the
## IDs tend to be inherent in the objects.
setMethod("[<-", "RestContainer", function(x, i, j, ..., value) {
if (!missing(j))
warning("argument 'j' is ignored")
if (missing(i)) {
create(x@uri, value, ...)
} else {
value <- recycleArg(value, "value", length(i))
for (ii in i)
x[[ii, ...]] <- value[[ii]]
}
x
})
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### READ
###
setMethod("$", "RestContainer", function(x, name) {
x[[name]]
})
setMethod("[[", "RestContainer", function(x, i, ...) {
if (!is.character(i))
stop("'i' must be a character vector")
read(x@uri[[i]], ...)
})
setMethod("[", "RestContainer", function(x, i, j, ..., drop = TRUE) {
if (!missing(j))
warning("argument 'j' is ignored")
if (!isTRUE(drop))
warning("argument 'drop' must be TRUE")
if (missing(i)) {
read(x, ...)
}
else {
if (!is.character(i))
stop("'i' must be a character vector")
sapply(i, function(ii, ...) x[[ii, ...]], ..., simplify=FALSE)
}
})
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### UPDATE/DELETE
###
setMethod("$<-", "RestContainer", function(x, name, value) {
x[[name]] <- value
x
})
setMethod("[[<-", "RestContainer", function(x, i, j, ..., value) {
if (missing(i))
stop("argument 'i' cannot be missing")
if (!missing(j))
warning("argument 'j' is ignored")
if (is.null(value))
delete(x@uri[[i]], ...)
else update(x@uri[[i]], ..., value=value)
x
})
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Show
###
setMethod("show", "RestContainer", function(object) {
cat("RestContainer object\n")
cat("uri:", as.character(object@uri), "\n")
})
|
