diff --git a/radiant.data/inst/app/tools/data/init_load_data.R b/radiant.data/inst/app/tools/data/init_load_data.R index a31f485e6864247fd32f78b13fe906b49505bfd7..fd57f81355f922bfe54dcd88b9dc541879ee6e4b 100644 --- a/radiant.data/inst/app/tools/data/init_load_data.R +++ b/radiant.data/inst/app/tools/data/init_load_data.R @@ -1,94 +1,182 @@ -# ============================================================ -# [新增功能] 企业级集成:Token鉴权 + 环境变量 + 自动加载 -# ============================================================ +library(httr) +library(glue) + +# ------------------------------------------------------------------------- +# 1. CRIC 系统处理函数 +# ------------------------------------------------------------------------- +download_handler_cric <- function(base_url, id, token, dest_file) { + # 注意:这里假设 base_url 结尾没有 /,且 target 开头有 / + target_url <- glue::glue("{base_url}/research-project/generate-project-dataset/{id}") + + response <- httr::POST( + url = target_url, + httr::add_headers(authentication = paste(token)), + httr::write_disk(dest_file, overwrite = TRUE) + ) + return(response) +} + +# ------------------------------------------------------------------------- +# 2. 专病库系统 处理函数 +# ------------------------------------------------------------------------- +# 场景 1: 批量导出患者 (List) +download_handler_disease_batch <- function(base_url, id, token, dest_file) { + # URL 拼接:base_url + /disease-data/... + target_url <- glue::glue("{base_url}/disease-data/export/patient/list") + + # 参数预处理:逗号分隔字符串转向量 + id_list <- strsplit(id, ",")[[1]] + + response <- httr::POST( + url = target_url, + httr::add_headers(Authorization = paste('Bearer ', token)), # 注意空格 + body = id_list, + encode = "json", # 自动将向量转为 JSON 数组 ["id1", "id2"] + httr::write_disk(dest_file, overwrite = TRUE) + ) + return(response) +} + +# 场景 2: 申请单导出 (Case) +download_handler_disease_apply <- function(base_url, id, token, dest_file) { + target_url <- glue::glue("{base_url}/disease-data/data/export/apply/apply/case") + + response <- httr::POST( + url = target_url, + query = list(applyId = id), # 自动拼接到 URL ?applyId=xxx + httr::add_headers(Authorization = paste('Bearer ', token)), + httr::write_disk(dest_file, overwrite = TRUE) + ) + return(response) +} + +# ------------------------------------------------------------------------- +# 系统注册表 +# ------------------------------------------------------------------------- +SYSTEM_REGISTRY <- list( + "cric" = list( + api_base = "https://ds.cixincloud.com/data-search-api", + handler = download_handler_cric, + file_ext = ".xlsx", + sys_description = "大数据检索系统" + ), + + "disease_batch" = list( + api_base = "https://ds.cixincloud.com/disease-api", + handler = download_handler_disease_batch, + file_ext = ".xls",# 注意这里是 xls + sys_description = "专病库系统" + ), + + "disease_apply" = list( + api_base = "https://ds.cixincloud.com/disease-api", + handler = download_handler_disease_apply, + file_ext = ".xlsx", + sys_description = "专病库系统" + ) +) + +# ------------------------------------------------------------------------- +# 主逻辑 (Observer) +# ------------------------------------------------------------------------- observe({ # 1. 解析 URL 参数 query <- parseQueryString(session$clientData$url_search) dataset_id <- query[['datasetId']] - token <- query[['token']] + token <- query[['token']] + sys_name <- query[['system']] - # 初始化一个 session 级别的变量来记录已加载的 ID,防止刷新时的重复请求 + # 初始化已加载列表 if (is.null(session$userData$loaded_datasets)) { session$userData$loaded_datasets <- c() } - # 2. 仅当 ID 和 Token 均存在时执行 - if (!is.null(dataset_id) && !is.null(token)) { + # 2. 校验必要参数 + if (!is.null(dataset_id) && !is.null(token) && !is.null(sys_name)) { - # 3. [修改点] 检查 ID 是否已在本次会话中加载过 - # 因为现在数据集名称是动态的 Sheet 名,下载前无法预知,所以改为判断 ID + # 3. 防止重复加载 if (!(dataset_id %in% session$userData$loaded_datasets)) { - withProgress(message = '正在从业务系统同步数据...', value = 0.2, { + # 4. 获取系统配置 + sys_config <- SYSTEM_REGISTRY[[sys_name]] - # 4. 获取环境变量 - api_base <- Sys.getenv("HOST_API_BASE", "https://ds.cixincloud.com/data-search-api") + if (is.null(sys_config)) { + showNotification(paste0("配置错误:未知的系统类型 [", sys_config$sys_description, "]"), type = "error", duration = 10) + return() + } - # 5. 拼接完整 API 路径 - target_url <- paste0(api_base, "/research-project/generate-project-dataset/", dataset_id) - - # 6. 创建临时文件 - tmp_file <- tempfile(fileext = ".xlsx") + withProgress(message = paste0('正在连接 [', sys_config$sys_description, ']...'), value = 0.1, { tryCatch({ - incProgress(0.3, detail = "正在鉴权并下载...") - - # 7. HTTP 请求 - response <- httr::POST( - url = target_url, - httr::add_headers(authentication = paste(token)), - httr::write_disk(tmp_file, overwrite = TRUE) + # 5. 准备临时文件 + # 获取带点的后缀 (如 .xlsx) + file_suffix <- ifelse(is.null(sys_config$file_ext), ".xlsx", sys_config$file_ext) + tmp_file <- tempfile(fileext = file_suffix) + + # [修复点 1] 提前计算不带点的后缀变量 clean_ext,供后续使用 + clean_ext <- gsub("\\.", "", file_suffix) + + incProgress(0.3, detail = "执行下载策略...") + + # 6. 调用 Handler 下载 + response <- sys_config$handler( + base_url = sys_config$api_base, + id = dataset_id, + token = token, + dest_file = tmp_file ) - message("=== Request Log ===") - print(response$request) - message("===================") - + # 7. 检查状态码 if (httr::status_code(response) != 200) { - stop(paste("下载失败,HTTP状态码:", httr::status_code(response))) + err_msg <- tryCatch( + httr::content(response, "text", encoding = "UTF-8"), + error = function(e) "无详细错误信息" + ) + stop(paste0("下载失败 (HTTP ", httr::status_code(response), "): ", err_msg)) } - incProgress(0.7, detail = "解析并导入 Radiant...") + incProgress(0.7, detail = "正在导入 Radiant...") - # 8. 调用核心加载函数 - # 注意:这里的 fname 仅用于扩展名识别,实际数据集名称由 Sheet 名决定 + # 8. 调用 Radiant 加载函数 load_user_data( - fname = "downloaded_data.xlsx", + fname = paste0("data_", dataset_id, file_suffix), uFile = tmp_file, - ext = "xlsx", + ext = clean_ext, # [修复点 2] 使用定义好的变量 xlsx_header = TRUE, man_str_as_factor = TRUE ) - # 9. 界面联动:获取刚才加载的 Sheet 名称并选中第一个 - # 必须再次读取 Sheet 列表并做 make.names 处理,才能匹配到 r_data 中的 Key - loaded_sheets <- try(readxl::excel_sheets(tmp_file), silent = TRUE) + # 9. 界面联动:自动选中最后一个 Sheet + if (clean_ext %in% c("xlsx", "xls")) { - if (!inherits(loaded_sheets, "try-error") && length(loaded_sheets) > 0) { + # 读取 Sheet 名 -> 清洗 -> 取最后一个 + # 使用 try 包裹 readxl 以防空文件报错 + raw_sheets <- try(readxl::excel_sheets(tmp_file), silent = TRUE) - # 必须和 load_user_data 里的逻辑一致,使用 make.names 清洗 - valid_names <- make.names(loaded_sheets) - first_sheet_name <- valid_names[1] # 默认选第一个 + if (!inherits(raw_sheets, "try-error") && length(raw_sheets) > 0) { + target_sheet <- head(make.names(raw_sheets), 1) + message(target_sheet) - # 标记为已加载 - session$userData$loaded_datasets <- c(session$userData$loaded_datasets, dataset_id) + # 更新下拉框 + updateSelectInput(session, "dataset", choices = names(r_data), selected = target_sheet) - # 更新下拉框并选中第一个 Sheet - updateSelectInput(session, "dataset", selected = first_sheet_name) - updateTabsetPanel(session, "nav_radiant", selected = "Data") - updateTabsetPanel(session, "tabs_data", selected = "View") + # 切换页面 + updateTabsetPanel(session, "nav_radiant", selected = "Data") + updateTabsetPanel(session, "tabs_data", selected = "View") - showNotification(paste0("成功加载 ", length(valid_names), " 个数据集 (ID: ", dataset_id, ")"), type = "message") - } else { - showNotification("文件下载成功,但未发现有效的 Sheet", type = "warning") + # showNotification(paste0("已选中: ", target_sheet), type = "message") + } } + # 10. 标记为已加载 + session$userData$loaded_datasets <- c(session$userData$loaded_datasets, dataset_id) + }, error = function(e) { - showNotification(paste("数据同步失败:", e$message), type = "error", duration = 10) + showNotification(paste("同步失败:", e$message), type = "error", duration = 15) + print(e) # 在控制台打印详细错误堆栈 }) }) } } }) -# ============================================================ diff --git a/radiant.data/inst/app/tools/data/view_ui.R b/radiant.data/inst/app/tools/data/view_ui.R index 58105327b436dd7c95a2176073097bdd2cddc033..43b340b90807e3f4309dcdb304b3b9aeb15569fb 100644 --- a/radiant.data/inst/app/tools/data/view_ui.R +++ b/radiant.data/inst/app/tools/data/view_ui.R @@ -15,7 +15,7 @@ output$ui_view_vars <- renderUI({ selectInput( "view_vars", i18n$t("Select variables to show:"), choices = vars, - selected = state_multiple("view_vars", vars, vars), + selected = state_multiple("view_vars", vars, head(vars, 15)), # 默认查看前15行 multiple = TRUE, selectize = FALSE, size = min(15, length(vars)) )