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']] sys_name <- query[['system']] # 初始化已加载列表 if (is.null(session$userData$loaded_datasets)) { session$userData$loaded_datasets <- c() } # 2. 校验必要参数 if (!is.null(dataset_id) && !is.null(token) && !is.null(sys_name)) { # 3. 防止重复加载 if (!(dataset_id %in% session$userData$loaded_datasets)) { # 4. 获取系统配置 sys_config <- SYSTEM_REGISTRY[[sys_name]] if (is.null(sys_config)) { showNotification(paste0("配置错误:未知的系统类型 [", sys_config$sys_description, "]"), type = "error", duration = 10) return() } withProgress(message = paste0('正在连接 [', sys_config$sys_description, ']...'), value = 0.1, { tryCatch({ # 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 ) # 7. 检查状态码 if (httr::status_code(response) != 200) { 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...") # 8. 调用 Radiant 加载函数 load_user_data( fname = paste0("data_", dataset_id, file_suffix), uFile = tmp_file, ext = clean_ext, # [修复点 2] 使用定义好的变量 xlsx_header = TRUE, man_str_as_factor = TRUE ) # 9. 界面联动:自动选中最后一个 Sheet if (clean_ext %in% c("xlsx", "xls")) { # 读取 Sheet 名 -> 清洗 -> 取最后一个 # 使用 try 包裹 readxl 以防空文件报错 raw_sheets <- try(readxl::excel_sheets(tmp_file), silent = TRUE) if (!inherits(raw_sheets, "try-error") && length(raw_sheets) > 0) { target_sheet <- head(make.names(raw_sheets), 1) message(target_sheet) # 更新下拉框 updateSelectInput(session, "dataset", choices = names(r_data), selected = target_sheet) # 切换页面 updateTabsetPanel(session, "nav_radiant", selected = "Data") updateTabsetPanel(session, "tabs_data", selected = "View") # 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 = 15) print(e) # 在控制台打印详细错误堆栈 }) }) } } })