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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
|
#' Upload a file to RPubs
#'
#' This function publishes a file to rpubs.com. If the upload succeeds a
#' list that includes an `id` and `continueUrl` is returned. A browser
#' should be opened to the `continueUrl` to complete publishing of the
#' document. If an error occurs then a diagnostic message is returned in the
#' `error` element of the list.
#'
#' @param title The title of the document.
#' @param contentFile The path to the content file to upload.
#' @param originalDoc The document that was rendered to produce the
#' `contentFile`. May be `NULL` if the document is not known.
#' @param id If this upload is an update of an existing document then the id
#' parameter should specify the document id to update. Note that the id is
#' provided as an element of the list returned by successful calls to
#' `rpubsUpload`.
#' @param properties A named list containing additional document properties
#' (RPubs doesn't currently expect any additional properties, this parameter
#' is reserved for future use).
#'
#' @return A named list. If the upload was successful then the list contains a
#' `id` element that can be used to subsequently update the document as
#' well as a `continueUrl` element that provides a URL that a browser
#' should be opened to in order to complete publishing of the document. If the
#' upload fails then the list contains an `error` element which contains
#' an explanation of the error that occurred.
#'
#' @examples
#' \dontrun{
#' # upload a document
#' result <- rpubsUpload("My document title", "Document.html")
#' if (!is.null(result$continueUrl))
#' browseURL(result$continueUrl)
#' else
#' stop(result$error)
#'
#' # update the same document with a new title
#' updateResult <- rpubsUpload("My updated title", "Document.html",
#' id = result$id)
#' }
#' @export
rpubsUpload <- function(title,
contentFile,
originalDoc,
id = NULL,
properties = list()) {
check_string(title, allow_empty = FALSE)
check_file(contentFile)
if (!is.list(properties))
stop("properties paramater must be a named list")
pathFromId <- function(id) {
split <- strsplit(id, "^https?://[^/]+")[[1]]
if (length(split) == 2)
return(split[2])
else
return(NULL)
}
buildPackage <- function(title,
contentFile,
properties = list()) {
# build package.json
properties$title <- title
packageJson <- toJSON(properties)
# create a tempdir to build the package in and copy the files to it
fileSep <- .Platform$file.sep
packageDir <- dirCreate(tempfile())
packageFile <- function(fileName) {
paste(packageDir, fileName, sep = fileSep)
}
writeLines(packageJson, packageFile("package.json"))
file.copy(contentFile, packageFile("index.html"))
# create the tarball
tarfile <- tempfile("package", fileext = ".tar.gz")
writeBundle(packageDir, tarfile)
# return the full path to the tarball
return(tarfile)
}
# build the package
packageFile <- buildPackage(title, contentFile, properties)
# determine whether this is a new doc or an update
isUpdate <- FALSE
method <- "POST"
path <- "/api/v1/document"
headers <- list()
headers$Connection <- "close"
if (!is.null(id)) {
isUpdate <- TRUE
path <- pathFromId(id)
method <- "PUT"
}
# use https if using a curl R package, and vanilla HTTP otherwise
http <- httpFunction()
if (identical(http, httpRCurl) || identical(http, httpLibCurl)) {
protocol <- "https"
port <- 443
} else {
protocol <- "http"
port <- 80
}
# send the request
result <- http(protocol = protocol,
host = "api.rpubs.com",
port = port,
method = method,
path = path,
headers = headers,
contentType = "application/x-compressed",
contentFile = packageFile)
# check for success
succeeded <- FALSE
if (isUpdate && (result$status == 200))
succeeded <- TRUE
else if (result$status == 201)
succeeded <- TRUE
# mark content as UTF-8
content <- result$content
Encoding(content) <- "UTF-8"
# return either id & continueUrl or error
if (succeeded) {
parsedContent <- jsonlite::fromJSON(content)
id <- ifelse(isUpdate, id, result$location)
url <- as.character(parsedContent["continueUrl"])
# we use the source doc as the key for the deployment record as long as
# it's a recognized document path; otherwise we use the content file
recordSource <- ifelse(!is.null(originalDoc) && isDocumentPath(originalDoc),
originalDoc, contentFile)
# use the title if given, and the filename name of the document if not
recordName <- ifelse(is.null(title) || nchar(title) == 0,
basename(recordSource), title)
rpubsRec <- deploymentRecord(name = recordName,
title = "",
username = "",
account = "rpubs",
server = "rpubs.com",
hostUrl = "rpubs.com",
appId = id,
bundleId = id,
url = url)
rpubsRecFile <- deploymentConfigFile(recordSource, recordName, "rpubs",
"rpubs.com")
write.dcf(rpubsRec, rpubsRecFile, width = 4096)
# record in global history
if (!is.null(originalDoc) && nzchar(originalDoc))
addToDeploymentHistory(originalDoc, rpubsRec)
# return the publish information
return(list(id = id,
continueUrl = url))
} else {
return(list(error = content))
}
}
|
