首页 > 解决方案 > ui 和服务器脚本作为一个脚本运行,运行良好。但是在不同的文件 ui.R 和 server.R 中运行脚本会引发错误

问题描述

我想在单独的文件中运行 ui.R 脚本和 server.R 脚本并一起运行以在闪亮的服务器中发布。但抛出错误: “serverFuncSource() 中的错误:server.R 返回了一个意外类型的对象:列表”

参考链接: 我想通过shinyApp中的登录页面渲染网站

我参考了上面的链接来运行脚本并在 shinyserver 中发布。在单个脚本中运行 ui 和服务器时,我无法发布它。因此,我想将 ui 脚本和服务器脚本拆分为单独的文件,并将其发布到闪亮的服务器中。

标签: rshiny

解决方案


Try separating as below.

global.R file:

library(shiny)
library(shinyauthr)
library(shinyjs)

# dataframe that holds usernames, passwords and other user data
user_base <- data.frame(
    user = c("user1", "sr1"),
    password = c("pass1", "USR@1"), 
    permissions = c("admin", "standard"),
    name = c("User One", "User Two"),
    stringsAsFactors = FALSE,
    row.names = NULL
)

jscode <- "
shinyjs.hrefAuto = function(url) { window.location.href = url;};
"

ui.R file:

ui <- fluidPage(
    # must turn shinyjs on
    shinyjs::useShinyjs(),
    extendShinyjs(text = jscode, functions = "hrefAuto"),
    # add logout button UI 
    div(class = "pull-right", shinyauthr::logoutUI(id = "logout")),
    # add login panel UI function
    shinyauthr::loginUI(id = "login"),
    # setup table output to show user info after login
    #tableOutput("user_table")
    uiOutput("hptm")
)

server.R file:

server <- function(input, output, session) {

    # call the logout module with reactive trigger to hide/show
    logout_init <- callModule(shinyauthr::logout, 
                              id = "logout", 
                              active = reactive(credentials()$user_auth))

    # call login module supplying data frame, user and password cols
    # and reactive trigger
    credentials <- callModule(shinyauthr::login, 
                              id = "login", 
                              data = user_base,
                              user_col = user,
                              pwd_col = password,
                              log_out = reactive(logout_init()))

    # pulls out the user information returned from login module
    user_data <- reactive({credentials()$info})

    #output$user_table <- renderTable({
    # use req to only render results when credentials()$user_auth is TRUE
    output$hptm <- renderUI({req(credentials()$user_auth)
        js$hrefAuto('https://stackoverflow.com')})
}

推荐阅读