Merged rstudio/master into branch.

2026-04-07 03:00:20 -04:00 · 2013-12-03 15:15:14 -06:00
parent 0088e9ae77 916ad6535a
commit a4e8907c95
39 changed files with 8687 additions and 6746 deletions
--- a/R/bootstrap.R
+++ b/R/bootstrap.R
@@ -27,12 +27,6 @@ bootstrapPage <- function(...) {
    bs <- "shared/bootstrap/"
    
    result <- tags$head(
-      tags$link(rel="stylesheet", 
-                type="text/css", 
-                href="shared/slider/css/jquery.slider.min.css"),
-      
-      tags$script(src="shared/slider/js/jquery.slider.min.js"),
-      
      tags$link(rel="stylesheet", 
                type="text/css", 
                href=paste(bs, "css/bootstrap", cssExt, sep="")),
@@ -745,7 +739,7 @@ sliderInput <- function(inputId, label, min, max, value, step = NULL,
 #' @param language The language used for month and day names. Default is "en".
 #'   Other valid values include "bg", "ca", "cs", "da", "de", "el", "es", "fi",
 #'   "fr", "he", "hr", "hu", "id", "is", "it", "ja", "kr", "lt", "lv", "ms",
-#'   "nb", "nl", "pl", "pt", "pt", "ro", "rs", "rs-latin", "ru", "sk", "sl",
+#'   "nb", "nl", "pl", "pt", "pt-BR", "ro", "rs", "rs-latin", "ru", "sk", "sl",
 #'   "sv", "sw", "th", "tr", "uk", "zh-CN", and "zh-TW".
 #'
 #' @family input elements
@@ -1152,6 +1146,20 @@ tableOutput <- function(outputId) {
  div(id = outputId, class="shiny-html-output")
 }

+#' @rdname tableOutput
+#' @export
+dataTableOutput <- function(outputId) {
+  tagList(
+    singleton(tags$head(
+      tags$link(rel = "stylesheet", type = "text/css",
+                href = "shared/datatables/css/DT_bootstrap.css"),
+      tags$script(src = "shared/datatables/js/jquery.dataTables.min.js"),
+      tags$script(src = "shared/datatables/js/DT_bootstrap.js")
+    )),
+    div(id = outputId, class="shiny-datatable-output")
+  )
+}
+
 #' Create an HTML output element
 #' 
 #' Render a reactive output variable as HTML within an application page. The 
--- a/R/react.R
+++ b/R/react.R
@@ -101,7 +101,7 @@ ReactiveEnvironment <- setRefClass(
      old.ctx <- .currentContext
      .currentContext <<- ctx
      on.exit(.currentContext <<- old.ctx)
-      func()
+      shinyCallingHandlers(func())
    },
    addPendingFlush = function(ctx, priority) {
      .pendingFlush$enqueue(ctx, priority)
--- a/R/shiny.R
+++ b/R/shiny.R
@@ -49,7 +49,8 @@ ShinySession <- setRefClass(
    downloads = 'Map',
    closed = 'logical',
    session = 'environment',      # Object for the server app to access session stuff
-    .workerId = 'character'
+    .workerId = 'character',
+    singletons = 'character'  # Tracks singleton HTML fragments sent to the page
  ),
  methods = list(
    initialize = function(websocket, workerId) {
@@ -71,6 +72,12 @@ ShinySession <- setRefClass(
      clientData <<- .createReactiveValues(.clientData, readonly=TRUE)
      .setLabel(clientData, 'clientData')
      
+      observe({
+        # clientData$singletons tells us what singletons were part of the
+        # initial page render
+        singletons <<- strsplit(clientData$singletons, ',')[[1]]
+      })
+      
      output     <<- .createOutputWriter(.self)
      
      token <<- createUniqueId(16)
@@ -88,6 +95,15 @@ ShinySession <- setRefClass(
      session$input             <<- .self$input
      session$output            <<- .self$output
      session$.impl             <<- .self
+
+      if (!is.null(websocket$request$HTTP_SHINY_SERVER_CREDENTIALS)) {
+        try({
+          creds <- fromJSON(websocket$request$HTTP_SHINY_SERVER_CREDENTIALS)
+          session$user <<- creds$user
+          session$groups <<- creds$groups
+        }, silent=FALSE)
+      }
+
      # session$request should throw an error if httpuv doesn't have
      # websocket$request, but don't throw it until a caller actually
      # tries to access session$request
@@ -423,6 +439,18 @@ ShinySession <- setRefClass(
            ),
            'Cache-Control'='no-cache')))
      }
+
+      if (matches[2] == 'datatable') {
+        # /session/$TOKEN/datatable/$NAME
+        dlmatches <- regmatches(matches[3],
+                                regexec("^([^/]+)(/[^/]+)?$",
+                                        matches[3]))[[1]]
+        dlname <- utils::URLdecode(dlmatches[2])
+        download <- downloads$get(dlname)
+        return(httpResponse(
+          200, 'application/json', dataTablesJSON(download$data, req$QUERY_STRING)
+        ))
+      }
      
      return(httpResponse(404, 'text/html', '<h1>Not Found</h1>'))
    },
@@ -464,6 +492,15 @@ ShinySession <- setRefClass(
                     URLencode(name, TRUE),
                     .workerId))
    },
+    # this can be more general registrations; not limited to data tables
+    registerDataTable = function(name, data) {
+      # abusing downloads at the moment
+      downloads$set(name, list(data = data))
+      return(sprintf('session/%s/datatable/%s?w=%s',
+                     URLencode(token, TRUE),
+                     URLencode(name, TRUE),
+                     .workerId))
+    },
    .getOutputOption = function(outputName, propertyName, defaultValue) {
      opts <- .outputOptions[[outputName]]
      if (is.null(opts))
@@ -764,7 +801,7 @@ dynamicHandler <- function(filePath, dependencyFiles=filePath) {
      if (file.exists(filePath)) {
        local({
          cacheContext$with(function() {
-            source(filePath, local=new.env(parent=.GlobalEnv))
+            sys.source(filePath, envir=new.env(parent=globalenv()), keep.source=TRUE)
          })
        })
      }
@@ -1044,7 +1081,7 @@ file.path.ci <- function(dir, name) {

 # Instantiates the app in the current working directory.
 # port - The TCP port that the application should listen on.
-startAppDir <- function(port=8101L, workerId) {
+startAppDir <- function(port, host, workerId, quiet) {
  globalR <- file.path.ci(getwd(), 'global.R')
  uiR <- file.path.ci(getwd(), 'ui.R')
  serverR <- file.path.ci(getwd(), 'server.R')
@@ -1056,11 +1093,11 @@ startAppDir <- function(port=8101L, workerId) {
    stop(paste("server.R file was not found in", getwd()))
  
  if (file.exists(globalR))
-    source(globalR, local=FALSE)
+    sys.source(globalR, envir=globalenv(), keep.source=TRUE)
  
  shinyServer(NULL)
  serverFileTimestamp <- file.info(serverR)$mtime
-  local(source(serverR, local=new.env(parent=.GlobalEnv)))
+  sys.source(serverR, envir=new.env(parent=globalenv()), keep.source=TRUE)
  if (is.null(.globals$server))
    stop("No server was defined in server.R")
  
@@ -1070,7 +1107,7 @@ startAppDir <- function(port=8101L, workerId) {
    if (!identical(mtime, serverFileTimestamp)) {
      shinyServer(NULL)
      serverFileTimestamp <<- mtime
-      local(source(serverR, local=new.env(parent=.GlobalEnv)))
+      sys.source(serverR, envir=new.env(parent=globalenv()), keep.source=TRUE)
      if (is.null(.globals$server))
        stop("No server was defined in server.R")
    }
@@ -1081,11 +1118,13 @@ startAppDir <- function(port=8101L, workerId) {
    c(dynamicHandler(uiR), wwwDir),
    serverFuncSource,
    port,
-    workerId
+    host,
+    workerId,
+    quiet
  )
 }

-startAppObj <- function(ui, serverFunc, port, workerId) {
+startAppObj <- function(ui, serverFunc, port, host, workerId, quiet) {
  uiHandler <- function(req) {
    if (!identical(req$REQUEST_METHOD, 'GET'))
      return(NULL)
@@ -1102,11 +1141,11 @@ startAppObj <- function(ui, serverFunc, port, workerId) {
  }
  
  startApp(uiHandler,
-             function() { serverFunc },
-             port, workerId)
+           function() { serverFunc },
+           port, host, workerId, quiet)
 }

-startApp <- function(httpHandlers, serverFuncSource, port, workerId) {
+startApp <- function(httpHandlers, serverFuncSource, port, host, workerId, quiet) {
  
  sys.www.root <- system.file('www', package='shiny')
  
@@ -1266,21 +1305,22 @@ startApp <- function(httpHandlers, serverFuncSource, port, workerId) {
  )
  
  if (is.numeric(port) || is.integer(port)) {
-    message('\n', 'Listening on port ', port)
-    return(startServer("0.0.0.0", port, httpuvCallbacks))
+    if (!quiet) {
+      message('\n', 'Listening on http://', host, ':', port)
+    }
+    return(startServer(host, port, httpuvCallbacks))
  } else if (is.character(port)) {    
-    message('\n', 'Listening on domain socket ', port)
+    if (!quiet) {
+      message('\n', 'Listening on domain socket ', port)
+    }
    mask <- attr(port, 'mask')
    return(startPipeServer(port, mask, httpuvCallbacks))
  }
 }

-# NOTE: we de-roxygenized this comment because the function isn't exported
 # Run an application that was created by \code{\link{startApp}}. This
 # function should normally be called in a \code{while(TRUE)} loop.
-# 
-# @param ws_env The return value from \code{\link{startApp}}.
-serviceApp <- function(ws_env) {
+serviceApp <- function() {
  if (timerCallbacks$executeElapsed()) {
    for (shinysession in appsByToken$values()) {
      shinysession$manageHiddenOutputs()
@@ -1307,6 +1347,12 @@ serviceApp <- function(ws_env) {
 #' 
 #' Runs a Shiny application. This function normally does not return; interrupt
 #' R to stop the application (usually by pressing Ctrl+C or Esc).
+#'
+#' The host parameter was introduced in Shiny 0.9.0. Its default value of
+#' \code{"127.0.0.1"} means that, contrary to previous versions of Shiny, only
+#' the current machine can access locally hosted Shiny apps. To allow other
+#' clients to connect, use the value \code{"0.0.0.0"} instead (which was the
+#' value that was hard-coded into Shiny in 0.8.0 and earlier).
 #' 
 #' @param appDir The directory of the application. Should contain
 #'   \code{server.R}, plus, either \code{ui.R} or a \code{www} directory that
@@ -1316,9 +1362,13 @@ serviceApp <- function(ws_env) {
 #' @param launch.browser If true, the system's default web browser will be 
 #'   launched automatically after the app is started. Defaults to true in 
 #'   interactive sessions only. This value of this parameter can also be a 
-#'   function to call with the application's URL. 
+#'   function to call with the application's URL.
+#' @param host The IPv4 address that the application should listen on. Defaults
+#'   to the \code{shiny.host} option, if set, or \code{"127.0.0.1"} if not. See
+#'   Details.
 #' @param workerId Can generally be ignored. Exists to help some editions of
 #'   Shiny Server Pro route requests to the correct process.
+#' @param quiet Should Shiny status messages be shown? Defaults to FALSE.
 #'
 #' @examples
 #' \dontrun{
@@ -1344,8 +1394,11 @@ serviceApp <- function(ws_env) {
 runApp <- function(appDir=getwd(),
                   port=NULL,
                   launch.browser=getOption('shiny.launch.browser',
-                                            interactive()), 
-                   workerId="") {
+                                            interactive()),
+                   host=getOption('shiny.host', '127.0.0.1'),
+                   workerId="", quiet=FALSE) {
+  if (is.null(host) || is.na(host))
+    host <- '0.0.0.0'

  # Make warnings print immediately
  ops <- options(warn = 1)
@@ -1386,7 +1439,7 @@ runApp <- function(appDir=getwd(),
      }

      # Test port to see if we can use it
-      tmp <- try(startServer('0.0.0.0', port, list()), silent=TRUE)
+      tmp <- try(startServer(host, port, list()), silent=TRUE)
      if (!is(tmp, 'try-error')) {
        stopServer(tmp)
        .globals$lastPort <- port
@@ -1399,9 +1452,10 @@ runApp <- function(appDir=getwd(),
    orig.wd <- getwd()
    setwd(appDir)
    on.exit(setwd(orig.wd), add = TRUE)
-    server <- startAppDir(port=port, workerId)
+    server <- startAppDir(port=port, host=host, workerId=workerId, quiet=quiet)
  } else {
-    server <- startAppObj(appDir$ui, appDir$server, port=port, workerId)
+    server <- startAppObj(appDir$ui, appDir$server, port=port,
+                          host=host, workerId=workerId, quiet=quiet)
  }
  
  on.exit({
@@ -1409,7 +1463,7 @@ runApp <- function(appDir=getwd(),
  }, add = TRUE)
  
  if (!is.character(port)) {
-    appUrl <- paste("http://localhost:", port, sep="")
+    appUrl <- paste("http://", host, ":", port, sep="")
    if (is.function(launch.browser))
      launch.browser(appUrl)
    else if (launch.browser)
@@ -1418,12 +1472,12 @@ runApp <- function(appDir=getwd(),
  
  .globals$retval <- NULL
  .globals$stopped <- FALSE
-  tryCatch(shinyCallingHandlers(
+  shinyCallingHandlers(
    while (!.globals$stopped) {
      serviceApp()
      Sys.sleep(0.001)
    }
-  ), finally = timerCallbacks$clear())
+  )
  
  return(.globals$retval)
 }
@@ -1470,7 +1524,8 @@ stopApp <- function(returnValue = NULL) {
 runExample <- function(example=NA,
                       port=NULL,
                       launch.browser=getOption('shiny.launch.browser',
-                                                interactive())) {
+                                                interactive()),
+                       host=getOption('shiny.host', '127.0.0.1')) {
  examplesDir <- system.file('examples', package='shiny')
  dir <- resolve(examplesDir, example)
  if (is.null(dir)) {
@@ -1489,7 +1544,7 @@ runExample <- function(example=NA,
           '"')
  }
  else {
-    runApp(dir, port = port, launch.browser = launch.browser)
+    runApp(dir, port = port, host = host, launch.browser = launch.browser)
  }
 }

--- a/R/shinyui.R
+++ b/R/shinyui.R
@@ -136,37 +136,8 @@ singleton <- function(x) {

 renderPage <- function(ui, connection) {
  
-  # provide a filter so we can intercept head tag requests
-  context <- new.env()
-  context$head <- character()
-  context$singletons <- character()
-  context$filter <- function(content) {
-    if (inherits(content, 'shiny.singleton')) {
-      sig <- digest(content, algo='sha1')
-      if (sig %in% context$singletons)
-        return(FALSE)
-      context$singletons <- c(sig, context$singletons)
-    }
-    
-    if (isTag(content) && identical(content$name, "head")) {
-      textConn <- textConnection(NULL, "w") 
-      textConnWriter <- function(text) cat(text, file = textConn)
-      tagWrite(content$children, textConnWriter, 1, context)
-      context$head <- append(context$head, textConnectionValue(textConn))
-      close(textConn)
-      return (FALSE)
-    }
-    else {
-      return (TRUE)
-    }
-  }
-  
-  # write ui HTML to a character vector
-  textConn <- textConnection(NULL, "w") 
-  tagWrite(ui, function(text) cat(text, file = textConn), 0, context)
-  uiHTML <- textConnectionValue(textConn)
-  close(textConn)
- 
+  result <- renderTags(ui)
+
  # write preamble
  writeLines(c('<!DOCTYPE html>',
               '<html>',
@@ -175,14 +146,17 @@ renderPage <- function(ui, connection) {
               '  <script src="shared/jquery.js" type="text/javascript"></script>',
               '  <script src="shared/shiny.js" type="text/javascript"></script>',
               '  <link rel="stylesheet" type="text/css" href="shared/shiny.css"/>',
-               context$head,
+               sprintf('  <script type="application/shiny-singletons">%s</script>',
+                       paste(result$singletons, collapse = ',')
+               ),
+               result$head,
               '</head>',
               '<body>', 
               recursive=TRUE),
             con = connection)
  
  # write UI html to connection
-  writeLines(uiHTML, con = connection)
+  writeLines(result$html, con = connection)
  
  # write end document
  writeLines(c('</body>',
--- a/R/shinywrappers.R
+++ b/R/shinywrappers.R
@@ -413,12 +413,21 @@ renderUI <- function(expr, env=parent.frame(), quoted=FALSE, func=NULL) {
    installExprFunction(expr, "func", env, quoted)
  }

-  function() {
+  function(shinysession, name, ...) {
    result <- func()
    if (is.null(result) || length(result) == 0)
      return(NULL)
-    # Wrap result in tagList in case it is an ordinary list
-    return(as.character(tagList(result)))
+
+    # renderTags returns a list with head, singletons, and html
+    output <- renderTags(result, shinysession$singletons)
+    shinysession$singletons <- output$singletons
+    output$singletons <- NULL
+    
+    # If there's stuff in head, then return a list; otherwise, just a string.
+    if (isTRUE(nchar(output$head) > 0))
+      return(output)
+    else
+      return(output$html)
  }
 }

@@ -469,6 +478,32 @@ downloadHandler <- function(filename, content, contentType=NA) {
  })
 }

+#' Table output with the JavaScript library DataTables
+#'
+#' Makes a reactive version of the given function that returns a data frame (or
+#' matrix), which will be rendered with the DataTables library. Paging,
+#' searching, filtering, and sorting can be done on the R side using Shiny as
+#' the server infrastructure.
+#' @param expr An expression that returns a data frame or a matrix.
+#' @param options A list of initialization options to be passed to DataTables.
+#' @param searchDelay The delay for searching, in milliseconds (to avoid too
+#'   frequent search requests).
+#' @references \url{http://datatables.net}
+#' @export
+#' @inheritParams renderPlot
+renderDataTable <- function(expr, options = NULL, searchDelay = 500,
+                            env=parent.frame(), quoted=FALSE) {
+  installExprFunction(expr, "func", env, quoted)
+
+  function(shinysession, name, ...) {
+    data <- func()
+    if (length(dim(data)) != 2) return() # expects a rectangular data object
+    action <- shinysession$registerDataTable(name, data)
+    list(colnames = colnames(data), action = action, options = options,
+         searchDelay = searchDelay)
+  }
+}
+

 # Deprecated functions ------------------------------------------------------

--- a/R/slider.R
+++ b/R/slider.R
@@ -101,13 +101,23 @@ slider <- function(inputId, min, max, value, step = NULL, ...,
  }
  
  # build slider
-  sliderFragment <- list(tags$input(
-    id=inputId, type="slider", 
-    name=inputId, value=paste(value, collapse=';'), class="jslider",
-    'data-from'=min, 'data-to'=max, 'data-step'=step,
-    'data-skin'='plastic', 'data-round'=round, 'data-locale'=locale,
-    'data-format'=format, 'data-scale'=ticks,
-    'data-smooth'=FALSE))
+  sliderFragment <- list(
+    singleton(tags$head(
+      tags$link(rel="stylesheet", 
+                type="text/css", 
+                href="shared/slider/css/jquery.slider.min.css"),
+      
+      tags$script(src="shared/slider/js/jquery.slider.min.js")
+    )),
+    tags$input(
+      id=inputId, type="slider", 
+      name=inputId, value=paste(value, collapse=';'), class="jslider",
+      'data-from'=min, 'data-to'=max, 'data-step'=step,
+      'data-skin'='plastic', 'data-round'=round, 'data-locale'=locale,
+      'data-format'=format, 'data-scale'=ticks,
+      'data-smooth'=FALSE
+    )
+  )

  if (identical(animate, TRUE))
    animate <- animationOptions()
--- a/R/tags.R
+++ b/R/tags.R
@@ -55,13 +55,7 @@ format.shiny.tag <- function(x, ...) {

 #' @S3method as.character shiny.tag
 as.character.shiny.tag <- function(x, ...) {
-  f = file()
-  on.exit(close(f))
-  textWriter <- function(text) {
-    cat(text, file=f)
-  }
-  tagWrite(x, textWriter)
-  return(HTML(paste(readLines(f, warn=FALSE), collapse='\n')))
+  renderTags(x)$html
 }

 #' @S3method print shiny.tag.list
@@ -199,6 +193,42 @@ tagWrite <- function(tag, textWriter, indent=0, context = NULL, eol = "\n") {
  }
 }

+renderTags <- function(ui, singletons = character(0)) {
+  # provide a filter so we can intercept head tag requests
+  context <- new.env()
+  context$head <- character()
+  context$singletons <- singletons
+  context$filter <- function(content) {
+    if (inherits(content, 'shiny.singleton')) {
+      sig <- digest(content, algo='sha1')
+      if (sig %in% context$singletons)
+        return(FALSE)
+      context$singletons <- c(sig, context$singletons)
+    }
+    
+    if (isTag(content) && identical(content$name, "head")) {
+      textConn <- textConnection(NULL, "w") 
+      textConnWriter <- function(text) cat(text, file = textConn)
+      tagWrite(content$children, textConnWriter, 1, context)
+      context$head <- append(context$head, textConnectionValue(textConn))
+      close(textConn)
+      return (FALSE)
+    }
+    else {
+      return (TRUE)
+    }
+  }
+  
+  # write ui HTML to a character vector
+  textConn <- textConnection(NULL, "w") 
+  tagWrite(ui, function(text) cat(text, file = textConn), 0, context)
+  uiHTML <- paste(textConnectionValue(textConn), collapse = "\n")
+  close(textConn)
+  
+  return(list(head = paste(context$head, collapse = "\n"),
+              singletons = context$singletons,
+              html = uiHTML))
+}

 # environment used to store all available tags
 #' @export
--- a/R/utils.R
+++ b/R/utils.R
@@ -199,11 +199,10 @@ exprToFunction <- function(expr, env=parent.frame(2), quoted=FALSE,
 #' Installs an expression in the given environment as a function, and registers
 #' debug hooks so that breakpoints may be set in the function.
 #' 
-#' Can replace \code{exprToFunction} as follows:
-#' 
-#' Before: \code{func <- exprToFunction(expr)}
-#' 
-#' After: \code{installExprFunction(expr, "func")}
+#' This function can replace \code{exprToFunction} as follows: we may use
+#' \code{func <- exprToFunction(expr)} if we do not want the debug hooks, or
+#' \code{installExprFunction(expr, "func")} if we do. Both approaches create a
+#' function named \code{func} in the current environment.
 #' 
 #' @seealso Wraps \code{exprToFunction}; see that method's documentation for 
 #'   more documentation and examples.
@@ -288,8 +287,7 @@ parseQueryString <- function(str) {
 shinyCallingHandlers <- function(expr) {
  withCallingHandlers(expr, error = function(e) {
    handle <- getOption('shiny.error')
-    if (is.null(handle) || !is.function(handle)) return()
-    if (length(formals(handle)) > 0) handle(e) else handle()
+    if (is.function(handle)) handle()
  })
 }

@@ -370,3 +368,57 @@ Callbacks <- setRefClass(
    }
  )
 )
+
+# convert a data frame to JSON as required by DataTables request
+dataTablesJSON <- function(data, query) {
+  n <- nrow(data)
+  with(parseQueryString(query), {
+    # global searching
+    i <- seq_len(n)
+    if (nzchar(sSearch)) {
+      i0 <- apply(data, 2, function(x) grep(sSearch, as.character(x)))
+      i <- intersect(i, unique(unlist(i0)))
+    }
+    # search by columns
+    if (length(i)) for (j in seq_len(as.integer(iColumns)) - 1) {
+      if (is.null(k <- get_exists(sprintf('sSearch_%d', j), 'character'))) next
+      if (nzchar(k)) i <- intersect(grep(k, as.character(data[, j + 1])), i)
+      if (length(i) == 0) break
+    }
+    if (length(i) != n) data <- data[i, , drop = FALSE]
+    # sorting
+    oList <- list()
+    for (j in seq_len(as.integer(iSortingCols)) - 1) {
+      if (is.null(k <- get_exists(sprintf('iSortCol_%d', j), 'character'))) break
+      desc = get_exists(sprintf('sSortDir_%d', j), 'character')
+      if (is.character(desc)) {
+        col <- data[, as.integer(k) + 1]
+        oList[[length(oList) + 1]] <- (if (desc == 'asc') identity else `-`)(
+          if (is.numeric(col)) col else xtfrm(col)
+        )
+      }
+    }
+    if (length(oList)) {
+      i <- do.call(order, oList)
+      data <- data[i, , drop = FALSE]
+    }
+    # paging
+    i <- seq(as.integer(iDisplayStart) + 1L, length.out = as.integer(iDisplayLength))
+    i <- i[i <= n]
+    fdata <- data[i, , drop = FALSE]  # filtered data
+    fdata <- unname(as.matrix(fdata))
+    if (nrow(fdata) == 0) fdata = list()
+
+    toJSON(list(
+      sEcho = as.integer(sEcho),
+      iTotalRecords = n,
+      iTotalDisplayRecords = nrow(data),
+      aaData = fdata
+    ))
+  })
+}
+
+get_exists = function(x, mode) {
+  if (exists(x, envir = parent.frame(), mode = mode, inherits = FALSE))
+    get(x, envir = parent.frame(), mode = mode, inherits = FALSE)
+}