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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
### =========================================================================
### Formal declaration of media types
### -------------------------------------------------------------------------
setClass("Media", representation(cacheInfo = "CacheInfo"))
setClass("application/*", contains = "Media")
setClass("audio/*", contains = "Media")
setClass("image/*", contains = "Media")
setClass("message/*", contains = "Media")
setClass("model/*", contains = "Media")
setClass("multipart/*",
representation(boundary = "character"),
contains = "Media")
setClass("text/*",
representation(charset = "character"),
prototype(charset = "us-ascii"),
contains = c("character", "Media"))
setClass("video/*", contains = "Media")
setClass("text/plain", contains = "text/*")
setClass("text/html", contains = "text/*")
setClass("text/csv", contains = "text/*")
setClass("application/xml",
representation(charset = "character"),
prototype(charset = "us-ascii"),
contains = c("character", "application/*"))
setClass("application/xhtml+xml", contains="application/xml")
setClass("application/json",
contains = c("character", "application/*"))
##setClass("application/R", contains = "application/*")
setClass("application/x-www-form-urlencoded",
contains = c("character", "application/*"))
setClass("NullMedia", contains = "Media")
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Accessors
###
setGeneric("cacheInfo", function(x, ...) standardGeneric("cacheInfo"))
setMethod("cacheInfo", "Media", function(x) x@cacheInfo)
setMethod("cacheInfo", "NULL", function(x) NULL)
setGeneric("cacheInfo<-", function(x, ..., value) standardGeneric("cacheInfo<-"))
setReplaceMethod("cacheInfo", c("Media", "CacheInfo"), function(x, value) {
x@cacheInfo <- value
x
})
setMethod("expired", "Media", function(x) expired(cacheInfo(x)))
setMethod("length", "NullMedia", function(x) 0L)
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Coercion
###
## Default R <-> media type mapping
setGeneric("mediaTarget", function(x, ...) standardGeneric("mediaTarget"))
setMethod("mediaTarget", "application/json", function(x) "list")
setMethod("mediaTarget", "application/xml", function(x) "XMLAbstractNode")
setMethod("mediaTarget", "text/html", function(x) "XMLAbstractNode")
setMethod("mediaTarget", "text/csv", function(x) "data.frame")
setMethod("mediaTarget", "text/*", function(x) "character")
setMethod("mediaTarget", "NullMedia", function(x) "NULL")
setAs("application/xml", "XMLAbstractNode", function(from) {
xmlInternalTreeParse(from, asText=TRUE)
})
setAs("text/html", "XMLAbstractNode", function(from) {
htmlTreeParse(from, asText=TRUE, useInternalNodes=TRUE)
})
setAs("application/json", "list", function(from) {
fromJSON(from)
})
`as.data.frame.application/json` <- function(x, row.names = NULL,
optional = FALSE, ...)
{
df <- raggedListToDF(as.list(x), optional=optional, ...)
if (!is.null(row.names))
rownames(df) <- row.names
df
}
`as.data.frame.text/csv` <- function(x, row.names = NULL, optional = FALSE, ...)
{
chr <- as.character(x)
if (identical(chr, "") || identical(chr, "\n")) {
return(data.frame())
}
con <- file()
on.exit(close(con))
writeLines(chr, con)
### FIXME: we are assuming a header, but there is no guarantee
df <- read.csv(con, check.names=!optional, stringsAsFactors=FALSE, ...)
if (!is.null(row.names))
rownames(df) <- row.names
df
}
setAs("Media", "data.frame", function(from) {
as.data.frame(from, optional=TRUE)
})
setAs("ANY", "Media", function(from) {
as(from, "application/json")
})
setAs("list", "application/json", function(from) {
new("application/json", toJSON(from))
})
setAs("data.frame", "Media", function(from) {
as(from, "text/csv")
})
setAs("data.frame", "text/csv", function(from) {
con <- file()
on.exit(close(con))
df <- as(from, "data.frame")
df[] <- lapply(df, function(x) {
if (is.list(x)) {
unstrsplit(x, ",")
} else {
x
}
})
write.csv(df, con, row.names=FALSE)
new("text/csv", paste(readLines(con), collapse="\n"))
})
as.list.Media <- function(x, ...) as(x, "list")
contentType <- function(x) {
slots <- setdiff(slotNames(class(x)), c(".Data", "cacheInfo"))
params <- vapply(slots, function(nm) as.character(slot(x, nm)), character(1L))
paste(c(class(x), paste(names(params), params, sep="=")), collapse=";")
}
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Show
###
setMethod("show", "Media", function(object) {
cat("Media of type '", class(object), "'\n", sep = "")
cat("length: ", length(object), "\n", sep = "")
})
|
