Merge branch 'master' of https://ds.cixincloud.com/gitlab/wuzekai/radiant

radiant.data/inst/app/tools/data/init_load_data.R

-# ============================================================
-# [新增功能] 企业级集成：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) # 在控制台打印详细错误堆栈
         })
       })
     }
   }
 })
-# ============================================================

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))
   )