Skip to content

Commit fa7c034

Browse files
jcheng5jcheng5
committed
Merge pull request rstudio#955 from rstudio/joe/feature/reactlog-bysession
Fix couple of issues with reactlog
2 parents ca870cc + 6718d37 commit fa7c034

File tree

9 files changed

+152
-126
lines changed

9 files changed

+152
-126
lines changed

‎R/graph.R

Lines changed: 14 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,11 @@
1-
writeReactLog <- function(file=stdout()) {
2-
cat(toJSON(.graphStack$as_list(), pretty=TRUE), file=file)
1+
writeReactLog <- function(file=stdout(), sessionToken = NULL) {
2+
log <- .graphStack$as_list()
3+
if (!is.null(sessionToken)) {
4+
log <- Filter(function(x) {
5+
is.null(x$session) || identical(x$session, sessionToken)
6+
}, log)
7+
}
8+
cat(toJSON(log, pretty=TRUE), file=file)
39
}
410

511
#' Reactive Log Visualizer
@@ -40,12 +46,12 @@ showReactLog <- function() {
4046
utils::browseURL(renderReactLog())
4147
}
4248

43-
renderReactLog <- function() {
49+
renderReactLog <- function(sessionToken = NULL) {
4450
templateFile <- system.file('www/reactive-graph.html', package='shiny')
4551
html <- paste(readLines(templateFile, warn=FALSE), collapse='\r\n')
4652
tc <- textConnection(NULL, 'w')
4753
on.exit(close(tc))
48-
writeReactLog(tc)
54+
writeReactLog(tc, sessionToken)
4955
cat('\n', file=tc)
5056
flush(tc)
5157
html <- sub('__DATA__', paste(textConnectionValue(tc), collapse='\r\n'), html, fixed=TRUE)
@@ -55,8 +61,10 @@ renderReactLog <- function() {
5561
}
5662

5763
.graphAppend <- function(logEntry, domain = getDefaultReactiveDomain()) {
58-
if (isTRUE(getOption('shiny.reactlog')))
59-
.graphStack$push(logEntry)
64+
if (isTRUE(getOption('shiny.reactlog'))) {
65+
sessionToken <- if (is.null(domain)) NULL else domain$token
66+
.graphStack$push(c(logEntry, list(session = sessionToken)))
67+
}
6068

6169
if (!is.null(domain)) {
6270
domain$reactlog(logEntry)

‎R/middleware-shiny.R

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -9,9 +9,11 @@ reactLogHandler <- function(req) {
99
return(NULL)
1010
}
1111

12+
sessionToken <- parseQueryString(req$QUERY_STRING)$s
13+
1214
return(httpResponse(
1315
status=200,
14-
content=list(file=renderReactLog(), owned=TRUE)
16+
content=list(file=renderReactLog(sessionToken), owned=TRUE)
1517
))
1618
}
1719

‎R/server.R

Lines changed: 116 additions & 114 deletions
Original file line numberDiff line numberDiff line change
@@ -207,140 +207,142 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
207207
shinysession$setShowcase(.globals$showcaseDefault)
208208

209209
ws$onMessage(function(binary, msg) {
210-
# To ease transition from websockets-based code. Should remove once we're stable.
211-
if (is.character(msg))
212-
msg <- charToRaw(msg)
213-
214-
if (isTRUE(getOption('shiny.trace'))) {
215-
if (binary)
216-
message("RECV ", '$$binary data$$')
217-
else
218-
message("RECV ", rawToChar(msg))
219-
}
210+
withReactiveDomain(shinysession, {
211+
# To ease transition from websockets-based code. Should remove once we're stable.
212+
if (is.character(msg))
213+
msg <- charToRaw(msg)
214+
215+
if (isTRUE(getOption('shiny.trace'))) {
216+
if (binary)
217+
message("RECV ", '$$binary data$$')
218+
else
219+
message("RECV ", rawToChar(msg))
220+
}
220221

221-
if (identical(charToRaw("\003\xe9"), msg))
222-
return()
222+
if (identical(charToRaw("\003\xe9"), msg))
223+
return()
223224

224-
msg <- decodeMessage(msg)
225+
msg <- decodeMessage(msg)
225226

226-
# Do our own list simplifying here. sapply/simplify2array give names to
227-
# character vectors, which is rarely what we want.
228-
if (!is.null(msg$data)) {
229-
for (name in names(msg$data)) {
230-
val <- msg$data[[name]]
227+
# Do our own list simplifying here. sapply/simplify2array give names to
228+
# character vectors, which is rarely what we want.
229+
if (!is.null(msg$data)) {
230+
for (name in names(msg$data)) {
231+
val <- msg$data[[name]]
231232

232-
splitName <- strsplit(name, ':')[[1]]
233-
if (length(splitName) > 1) {
234-
msg$data[[name]] <- NULL
233+
splitName <- strsplit(name, ':')[[1]]
234+
if (length(splitName) > 1) {
235+
msg$data[[name]] <- NULL
235236

236-
if (!inputHandlers$containsKey(splitName[[2]])){
237-
# No input handler registered for this type
238-
stop("No handler registered for for type ", name)
239-
}
237+
if (!inputHandlers$containsKey(splitName[[2]])){
238+
# No input handler registered for this type
239+
stop("No handler registered for for type ", name)
240+
}
240241

241-
msg$data[[ splitName[[1]] ]] <-
242+
msg$data[[ splitName[[1]] ]] <-
242243
inputHandlers$get(splitName[[2]])(
243-
val,
244-
shinysession,
245-
splitName[[1]] )
246-
}
247-
else if (is.list(val) && is.null(names(val))) {
248-
val_flat <- unlist(val, recursive = TRUE)
249-
250-
if (is.null(val_flat)) {
251-
# This is to assign NULL instead of deleting the item
252-
msg$data[name] <- list(NULL)
253-
} else {
254-
msg$data[[name]] <- val_flat
244+
val,
245+
shinysession,
246+
splitName[[1]] )
247+
}
248+
else if (is.list(val) && is.null(names(val))) {
249+
val_flat <- unlist(val, recursive = TRUE)
250+
251+
if (is.null(val_flat)) {
252+
# This is to assign NULL instead of deleting the item
253+
msg$data[name] <- list(NULL)
254+
} else {
255+
msg$data[[name]] <- val_flat
256+
}
255257
}
256258
}
257259
}
258-
}
259260

260-
switch(
261-
msg$method,
262-
init = {
263-
264-
serverFunc <- serverFuncSource()
265-
if (!identicalFunctionBodies(serverFunc, appvars$server)) {
266-
appvars$server <- serverFunc
267-
if (!is.null(appvars$server))
268-
{
269-
# Tag this function as the Shiny server function. A debugger may use this
270-
# tag to give this function special treatment.
271-
# It's very important that it's appvars$server itself and NOT a copy that
272-
# is invoked, otherwise new breakpoints won't be picked up.
273-
attr(appvars$server, "shinyServerFunction") <- TRUE
274-
registerDebugHook("server", appvars, "Server Function")
261+
switch(
262+
msg$method,
263+
init = {
264+
265+
serverFunc <- withReactiveDomain(NULL, serverFuncSource())
266+
if (!identicalFunctionBodies(serverFunc, appvars$server)) {
267+
appvars$server <- serverFunc
268+
if (!is.null(appvars$server))
269+
{
270+
# Tag this function as the Shiny server function. A debugger may use this
271+
# tag to give this function special treatment.
272+
# It's very important that it's appvars$server itself and NOT a copy that
273+
# is invoked, otherwise new breakpoints won't be picked up.
274+
attr(appvars$server, "shinyServerFunction") <- TRUE
275+
registerDebugHook("server", appvars, "Server Function")
276+
}
275277
}
276-
}
277278

278-
# Check for switching into/out of showcase mode
279-
if (.globals$showcaseOverride &&
280-
exists(".clientdata_url_search", where = msg$data)) {
281-
mode <- showcaseModeOfQuerystring(msg$data$.clientdata_url_search)
282-
if (!is.null(mode))
283-
shinysession$setShowcase(mode)
284-
}
279+
# Check for switching into/out of showcase mode
280+
if (.globals$showcaseOverride &&
281+
exists(".clientdata_url_search", where = msg$data)) {
282+
mode <- showcaseModeOfQuerystring(msg$data$.clientdata_url_search)
283+
if (!is.null(mode))
284+
shinysession$setShowcase(mode)
285+
}
285286

286-
shinysession$manageInputs(msg$data)
287+
shinysession$manageInputs(msg$data)
287288

288-
# The client tells us what singletons were rendered into
289-
# the initial page
290-
if (!is.null(msg$data$.clientdata_singletons)) {
291-
shinysession$singletons <<- strsplit(
292-
msg$data$.clientdata_singletons, ',')[[1]]
293-
}
289+
# The client tells us what singletons were rendered into
290+
# the initial page
291+
if (!is.null(msg$data$.clientdata_singletons)) {
292+
shinysession$singletons <<- strsplit(
293+
msg$data$.clientdata_singletons, ',')[[1]]
294+
}
294295

295-
local({
296-
args <- list(
297-
input=shinysession$input,
298-
output=.createOutputWriter(shinysession))
296+
local({
297+
args <- list(
298+
input=shinysession$input,
299+
output=.createOutputWriter(shinysession))
299300

300-
# The clientData and session arguments are optional; check if
301-
# each exists
302-
if ('clientData' %in% names(formals(serverFunc)))
303-
args$clientData <- shinysession$clientData
301+
# The clientData and session arguments are optional; check if
302+
# each exists
303+
if ('clientData' %in% names(formals(serverFunc)))
304+
args$clientData <- shinysession$clientData
304305

305-
if ('session' %in% names(formals(serverFunc)))
306-
args$session <- shinysession
306+
if ('session' %in% names(formals(serverFunc)))
307+
args$session <- shinysession
307308

308-
withReactiveDomain(shinysession, {
309-
do.call(appvars$server, args)
309+
withReactiveDomain(shinysession, {
310+
do.call(appvars$server, args)
311+
})
310312
})
311-
})
312-
},
313-
update = {
314-
shinysession$manageInputs(msg$data)
315-
},
316-
shinysession$dispatch(msg)
317-
)
318-
shinysession$manageHiddenOutputs()
319-
320-
if (exists(".shiny__stdout", globalenv()) &&
321-
exists("HTTP_GUID", ws$request)) {
322-
# safe to assume we're in shiny-server
323-
shiny_stdout <- get(".shiny__stdout", globalenv())
324-
325-
# eNter a flushReact
326-
writeLines(paste("_n_flushReact ", get("HTTP_GUID", ws$request),
327-
" @ ", sprintf("%.3f", as.numeric(Sys.time())),
328-
sep=""), con=shiny_stdout)
329-
flush(shiny_stdout)
330-
331-
flushReact()
332-
333-
# eXit a flushReact
334-
writeLines(paste("_x_flushReact ", get("HTTP_GUID", ws$request),
335-
" @ ", sprintf("%.3f", as.numeric(Sys.time())),
336-
sep=""), con=shiny_stdout)
337-
flush(shiny_stdout)
338-
} else {
339-
flushReact()
340-
}
341-
lapply(appsByToken$values(), function(shinysession) {
342-
shinysession$flushOutput()
343-
NULL
313+
},
314+
update = {
315+
shinysession$manageInputs(msg$data)
316+
},
317+
shinysession$dispatch(msg)
318+
)
319+
shinysession$manageHiddenOutputs()
320+
321+
if (exists(".shiny__stdout", globalenv()) &&
322+
exists("HTTP_GUID", ws$request)) {
323+
# safe to assume we're in shiny-server
324+
shiny_stdout <- get(".shiny__stdout", globalenv())
325+
326+
# eNter a flushReact
327+
writeLines(paste("_n_flushReact ", get("HTTP_GUID", ws$request),
328+
" @ ", sprintf("%.3f", as.numeric(Sys.time())),
329+
sep=""), con=shiny_stdout)
330+
flush(shiny_stdout)
331+
332+
flushReact()
333+
334+
# eXit a flushReact
335+
writeLines(paste("_x_flushReact ", get("HTTP_GUID", ws$request),
336+
" @ ", sprintf("%.3f", as.numeric(Sys.time())),
337+
sep=""), con=shiny_stdout)
338+
flush(shiny_stdout)
339+
} else {
340+
flushReact()
341+
}
342+
lapply(appsByToken$values(), function(shinysession) {
343+
shinysession$flushOutput()
344+
NULL
345+
})
344346
})
345347
})
346348

‎inst/www/shared/shiny.js

Lines changed: 12 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎inst/www/shared/shiny.js.map

Lines changed: 1 addition & 1 deletion
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎inst/www/shared/shiny.min.js

Lines changed: 2 additions & 2 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎inst/www/shared/shiny.min.js.map

Lines changed: 1 addition & 1 deletion
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎srcjs/reactlog.js

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,8 @@
11
$(document).on('keydown', function(e) {
22
if (e.which !== 114 || (!e.ctrlKey && !e.metaKey) || (e.shiftKey || e.altKey))
33
return;
4-
var url = 'reactlog?w=' + exports.shinyapp.config.workerId;
4+
var url = 'reactlog?w=' + window.escape(exports.shinyapp.config.workerId) +
5+
"&s=" + window.escape(exports.shinyapp.config.sessionId);
56
window.open(url);
67
e.preventDefault();
78
});

‎tools/Gruntfile.js

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,7 @@ module.exports = function(grunt) {
5555
js_srcdir + 'input_binding_tabinput.js',
5656
js_srcdir + 'input_binding_fileinput.js',
5757
js_srcdir + 'init_shiny.js',
58+
js_srcdir + 'reactlog.js',
5859
js_srcdir + '_end.js'
5960
],
6061
dest: instdir + 'www/shared/shiny.js',

0 commit comments

Comments
 (0)