From 004d1efadc34ef0c6e312f4dfb83c5f685d33a67 Mon Sep 17 00:00:00 2001 From: lum Date: Mon, 19 Jan 2026 16:05:45 -0800 Subject: [PATCH 1/3] Utility to generate URLs, centralize parameter generation/encoding. Refactor selectRows, makeFilter. --- Rlabkey/R/labkey.defaults.R | 30 +++- Rlabkey/R/labkey.selectRows.R | 135 +++++++++--------- Rlabkey/R/makeFilter.R | 249 ++++++++++++++++++---------------- 3 files changed, 229 insertions(+), 185 deletions(-) diff --git a/Rlabkey/R/labkey.defaults.R b/Rlabkey/R/labkey.defaults.R index c4af794..b9ce9a4 100644 --- a/Rlabkey/R/labkey.defaults.R +++ b/Rlabkey/R/labkey.defaults.R @@ -271,7 +271,6 @@ isWafEncoding <- function() return (.lkdefaults$wafEncode) } - isRequestError <- function(response, status_code) { status_code <- getStatusCode(response) @@ -357,4 +356,33 @@ encodeURIComponent <- function(value) value <- gsub("%28", "(", value) value <- gsub("%29", ")", value) return (value) +} + +# Construct a LabKey URL (path first format) +buildURL <- function(baseUrl=NULL, controller, action, folderPath = NULL, parameters = NULL) +{ + baseUrl=labkey.getBaseUrl(baseUrl) + + # check required parameters + if (missing(baseUrl) || missing(controller) || missing(action) || is.null(folderPath)) + stop (paste("A value must be specified for each of baseUrl, controller, action and folderPath.")) + + # normalize the folder path + folderPath <- encodeFolderPath(folderPath) + + myUrl <- paste(baseUrl, folderPath, controller, "-", action, sep="") + + if (!is.null(parameters)) + { + if (!is.list(parameters)) + stop (paste("parameters must be a list data structure.")) + + # add the parameters as a query string + url <- parse_url(myUrl) + url$query = parameters + + myUrl <- build_url(url) + } + print(myUrl) + return (myUrl) } \ No newline at end of file diff --git a/Rlabkey/R/labkey.selectRows.R b/Rlabkey/R/labkey.selectRows.R index 7795f94..b7b37f0 100755 --- a/Rlabkey/R/labkey.selectRows.R +++ b/Rlabkey/R/labkey.selectRows.R @@ -19,37 +19,33 @@ labkey.selectRows <- function(baseUrl=NULL, folderPath, schemaName, queryName, v containerFilter=NULL, parameters=NULL, includeDisplayValues=FALSE, method='POST') { baseUrl=labkey.getBaseUrl(baseUrl) + apiVersion = "8.3" - ## Empty string/NULL checking - if(is.null(viewName)==FALSE) {char <- nchar(viewName); if(char<1){viewName<-NULL}} - if(is.null(colSelect)==FALSE) {char <- nchar(colSelect[1]); if(char<1){colSelect<-NULL}} - if(is.null(maxRows)==FALSE) {char <- nchar(maxRows); if(char<1){maxRows<-NULL}} - if(is.null(rowOffset)==FALSE) {char <- nchar(rowOffset); if(char<1){rowOffset<-NULL}} - if(is.null(colSort)==FALSE) {char <- nchar(colSort); if(char<1){colSort<-NULL}} - if(is.null(colFilter)==FALSE) {char <- nchar(colFilter[1]); if(char<1){colFilter<-NULL}} - if(is.null(showHidden)==FALSE) {char <- nchar(showHidden); if(char<1){showHidden<-FALSE}} - if(is.null(containerFilter)==FALSE) {char <- nchar(containerFilter[1]); if(char<1){containerFilter<-NULL}} - if(is.null(parameters)==FALSE) {char <- nchar(parameters[1]); if(char<1){parameters<-NULL}} - if(is.null(includeDisplayValues)==FALSE) {char <- nchar(includeDisplayValues); if(char<1){includeDisplayValues<-FALSE}} + # Empty string/NULL checking + if (!is.null(viewName)) {char <- nchar(viewName); if(char<1){viewName<-NULL}} + if (!is.null(colSelect)) {char <- nchar(colSelect[1]); if(char<1){colSelect<-NULL}} + if (!is.null(maxRows)) {char <- nchar(maxRows); if(char<1){maxRows<-NULL}} + if (!is.null(rowOffset)) {char <- nchar(rowOffset); if(char<1){rowOffset<-NULL}} + if (!is.null(colSort)) {char <- nchar(colSort); if(char<1){colSort<-NULL}} + if (!is.null(colFilter)) {char <- nchar(colFilter[1]); if(char<1){colFilter<-NULL}} + if (!is.null(showHidden)) {char <- nchar(showHidden); if(char<1){showHidden<-FALSE}} + if (!is.null(containerFilter)) {char <- nchar(containerFilter[1]); if(char<1){containerFilter<-NULL}} + if (!is.null(parameters)) {char <- nchar(parameters[1]); if(char<1){parameters<-NULL}} + if (!is.null(includeDisplayValues)) {char <- nchar(includeDisplayValues); if(char<1){includeDisplayValues<-FALSE}} - ## Validate required parameters + # Validate required parameters if (missing(folderPath)) stop (paste("A value must be specified for folderPath.")) if (missing(schemaName)) stop (paste("A value must be specified for schemaName.")) if (missing(queryName)) stop (paste("A value must be specified for queryName.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - - apiVersion = "8.3" - - ## Format colSelect + # Format colSelect colSelect2=NULL - if(is.null(colSelect)==FALSE) { + if (!is.null(colSelect)) + { lencolSel <- length(colSelect) holder <- NULL - for(i in 1:length(colSelect)) { - holder <-paste(holder,URLencode(colSelect[i]),",",sep="") - } + for (i in 1:length(colSelect)) + holder <-paste(holder, colSelect[i],",",sep="") colSelect2 <- substr(holder, 1, nchar(holder)-1) colSelect <- paste(colSelect, collapse=",") @@ -57,63 +53,66 @@ labkey.selectRows <- function(baseUrl=NULL, folderPath, schemaName, queryName, v showHidden = TRUE } - if(is.null(method) == FALSE && method == "GET") + # Construct the query parameter list of named elements (key / value pairs) + params <- list("schemaName"=schemaName, "query.queryName"=queryName, "apiVersion"=apiVersion) + if (!is.null(includeDisplayValues) && includeDisplayValues == TRUE) + params <- c(params, list("includeDisplayValues"=includeDisplayValues)) + if (!is.null(viewName)) + params <- c(params, list("query.viewName"=viewName)) + if (!is.null(colSelect2)) + params <- c(params, list("query.columns"=colSelect2)) + if (!is.null(maxRows)) + params <- c(params, list("query.maxRows"=maxRows)) + if (is.null(maxRows)) + params <- c(params, list("query.maxRows"=-1)) + if (!is.null(rowOffset)) + params <- c(params, list("query.offset"=rowOffset)) + if (!is.null(colSort)) + params <- c(params, list("query.sort"=colSort)) + if (!is.null(colFilter)) { - ## URL encoding of schema, query, view, etc. (if not already encoded) - if(schemaName==URLdecode(schemaName)) {schemaName <- URLencode(schemaName)} - if(queryName==URLdecode(queryName)) {queryName <- URLencode(queryName)} - if(is.null(viewName)==FALSE) {if(viewName==URLdecode(viewName)) viewName <- URLencode(viewName)} - if(is.null(containerFilter)==FALSE) {if(containerFilter==URLdecode(containerFilter)) containerFilter<- URLencode(containerFilter)} - if(is.null(colSort)==FALSE) {if(colSort==URLdecode(colSort)) colSort <- URLencode(colSort)} - - ## Construct url - myurl <- paste(baseUrl,"query",folderPath,"selectRows.api?schemaName=",schemaName,"&query.queryName=",queryName,"&apiVersion=",apiVersion,sep="") - if (!is.null(includeDisplayValues) && includeDisplayValues == TRUE) {myurl <- paste(myurl,"&includeDisplayValues=true",sep="")} - if(is.null(viewName)==FALSE) {myurl <- paste(myurl,"&query.viewName=",viewName,sep="")} - if(is.null(colSelect2)==FALSE) {myurl <- paste(myurl,"&query.columns=",colSelect2,sep="")} - if(is.null(maxRows)==FALSE) {myurl <- paste(myurl,"&query.maxRows=",maxRows,sep="")} - if(is.null(maxRows)==TRUE) {myurl <- paste(myurl,"&query.maxRows=-1",sep="")} - if(is.null(rowOffset)==FALSE) {myurl <- paste(myurl,"&query.offset=",rowOffset,sep="")} - if(is.null(colSort)==FALSE) {myurl <- paste(myurl,"&query.sort=",colSort,sep="")} - if(is.null(colFilter)==FALSE) {for(j in 1:length(colFilter)) myurl <- paste(myurl,"&query.",colFilter[j],sep="")} - if(is.null(parameters)==FALSE) {for(k in 1:length(parameters)) myurl <- paste(myurl,"&query.param.",parameters[k],sep="")} - if(is.null(containerFilter)==FALSE) {myurl <- paste(myurl,"&containerFilter=",containerFilter,sep="")} + if (is.list(colFilter)) + params <- c(params, colFilter) + else + stop (paste("Argument colFilter must be a list generated from makeFilter")) + } + if (!is.null(parameters)) + { + # Support the legacy format. TODO: require a list with named elements that can + # be passed directly to the larger param list without needing to parse + for (k in 1:length(parameters)) + { + parts <- strsplit(parameters[k], "=")[[1]] + if (length(parts) == 2) + { + # add each parameter name / value pair to the select rows parameter list + paramList <- list(parts[2]) + names(paramList) <- paste("query.param.", parts[1], sep="") + params <- c(params, paramList) + } + else + stop (paste("Argument parameters is incorrectly formatted, it needs to be a list of string value pairs delimited by '='")) + } + } + if (!is.null(containerFilter)) + params <- c(params, list("containerFilter"=containerFilter)) - ## Execute via our standard GET function + if (!is.null(method) && method == "GET") + { + # Execute via our standard GET function + myurl <- buildURL(baseUrl, "query", "selectRows.api", folderPath, params) mydata <- labkey.get(myurl); } else { - ## Construct url and parameters - myurl <- paste(baseUrl, "query", folderPath, "selectRows.api", sep="") - params <- list(schemaName=schemaName, queryName=queryName, apiVersion=apiVersion) - if (!is.null(includeDisplayValues) && includeDisplayValues == TRUE) {params <- c(params, list(includeDisplayValues="true"))} - if(is.null(containerFilter)==FALSE) {params <- c(params, list(containerFilter=containerFilter))} - if(is.null(viewName)==FALSE) {params <- c(params, list(viewName=viewName))} - if(is.null(colSelect)==FALSE) {params <- c(params, list("query.columns"=colSelect))} - if(is.null(maxRows)==FALSE) {params <- c(params, list("query.maxRows"=maxRows))} - if(is.null(maxRows)==TRUE) {params <- c(params, list("query.maxRows"=-1))} - if(is.null(rowOffset)==FALSE) {params <- c(params, list("query.offset"=rowOffset))} - if(is.null(colSort)==FALSE) {params <- c(params, list("query.sort"=colSort))} - if(is.null(colFilter)==FALSE) {for(j in 1:length(colFilter)) { - # note that the makFilter call uses URLencode() so we need to unescape here - key = paste("query.",URLdecode(strsplit(colFilter[j],"=")[[1]][1]),sep="") - value = URLdecode(strsplit(colFilter[j],"=")[[1]][2]) - params[key] = value - }} - if(is.null(parameters)==FALSE) {for(k in 1:length(parameters)) { - key = paste("query.param.",strsplit(parameters[k],"=")[[1]][1],sep="") - value = strsplit(parameters[k],"=")[[1]][2] - params[key] = value - }} - - ## Execute via our standard POST function + # Execute via our standard POST function + myurl <- buildURL(baseUrl, "query", "selectRows.api", folderPath) mydata <- labkey.post(myurl, toJSON(params, auto_unbox=TRUE)) } newdata <- makeDF(mydata, colSelect, showHidden, colNameOpt) - ## Check for less columns returned than requested + # Check for less columns returned than requested if(is.null(colSelect)==FALSE){if(ncol(newdata) Date: Wed, 21 Jan 2026 17:05:07 -0800 Subject: [PATCH 2/3] Default to the legacy makeFilter behavior, modify selectRows to handle both newer and legacy filter formats. Update remaining functions to use the new labkey.buildURL utility. --- Rlabkey/DESCRIPTION | 4 +-- Rlabkey/NEWS | 5 +++ Rlabkey/R/labkey.defaults.R | 2 +- Rlabkey/R/labkey.deleteRows.R | 11 ++---- Rlabkey/R/labkey.domain.R | 28 ++++----------- Rlabkey/R/labkey.executeSql.R | 5 +-- Rlabkey/R/labkey.experiment.R | 15 ++------ Rlabkey/R/labkey.getFolders.R | 30 +++++++++++----- Rlabkey/R/labkey.getQueryInfo.R | 16 +++------ Rlabkey/R/labkey.getQueryLists.R | 18 ++++------ Rlabkey/R/labkey.getSchemas.R | 6 ++-- Rlabkey/R/labkey.importRows.R | 5 +-- Rlabkey/R/labkey.insertRows.R | 5 +-- Rlabkey/R/labkey.moduleProperty.R | 10 ++---- Rlabkey/R/labkey.moveRows.R | 5 +-- Rlabkey/R/labkey.pipeline.R | 20 +++-------- Rlabkey/R/labkey.provenance.R | 15 ++------ Rlabkey/R/labkey.query.import.R | 5 +-- Rlabkey/R/labkey.rstudio.R | 15 +++----- Rlabkey/R/labkey.saveBatch.R | 7 ++-- Rlabkey/R/labkey.security.R | 27 ++++---------- Rlabkey/R/labkey.selectRows.R | 59 +++++++++++++++++++++---------- Rlabkey/R/labkey.storage.R | 15 ++------ Rlabkey/R/labkey.updateRows.R | 6 +--- Rlabkey/R/makeFilter.R | 25 +++++++------ Rlabkey/man/makeFilter.Rd | 11 ++++-- 26 files changed, 146 insertions(+), 224 deletions(-) diff --git a/Rlabkey/DESCRIPTION b/Rlabkey/DESCRIPTION index c1e5130..62beef7 100755 --- a/Rlabkey/DESCRIPTION +++ b/Rlabkey/DESCRIPTION @@ -1,6 +1,6 @@ Package: Rlabkey -Version: 3.4.4 -Date: 2025-09-16 +Version: 3.4.5 +Date: 2026-01-20 Title: Data Exchange Between R and 'LabKey' Server Authors@R: c(person(given = "Peter", family = "Hussey", diff --git a/Rlabkey/NEWS b/Rlabkey/NEWS index b6c7fa4..7c08239 100644 --- a/Rlabkey/NEWS +++ b/Rlabkey/NEWS @@ -1,3 +1,8 @@ +Changes in 3.4.5 + o Switch to using path first URLs for LabKey server requests. + o Utilize httr to generate request query parameters. + o labkey.makeFilter will produce a list of named elements using the asList parameter. + Changes in 3.4.4 o Issue 53481: additional validation for assay run configurations. o Improve validation when a zero-row dataframe is passed to insertRows/updateRows/deleteRows diff --git a/Rlabkey/R/labkey.defaults.R b/Rlabkey/R/labkey.defaults.R index b9ce9a4..b4b7d9b 100644 --- a/Rlabkey/R/labkey.defaults.R +++ b/Rlabkey/R/labkey.defaults.R @@ -359,7 +359,7 @@ encodeURIComponent <- function(value) } # Construct a LabKey URL (path first format) -buildURL <- function(baseUrl=NULL, controller, action, folderPath = NULL, parameters = NULL) +labkey.buildURL <- function(baseUrl=NULL, controller, action, folderPath = NULL, parameters = NULL) { baseUrl=labkey.getBaseUrl(baseUrl) diff --git a/Rlabkey/R/labkey.deleteRows.R b/Rlabkey/R/labkey.deleteRows.R index 28d4a21..86a82e4 100644 --- a/Rlabkey/R/labkey.deleteRows.R +++ b/Rlabkey/R/labkey.deleteRows.R @@ -30,9 +30,6 @@ labkey.deleteRows <- function(baseUrl=NULL, folderPath, schemaName, queryName, t if (!missing(options) & !is.list(options)) stop (paste("The options parameter must be a list data structure.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - ## URL encode folder path, JSON encode post body (if not already encoded) toDelete <- convertFactorsToStrings(toDelete); @@ -43,8 +40,7 @@ labkey.deleteRows <- function(baseUrl=NULL, folderPath, schemaName, queryName, t params <- c(params, options) pbody <- jsonEncodeRowsAndParams(toDelete, params, NULL) - - myurl <- paste(baseUrl, "query", folderPath, "deleteRows.api", sep="") + myurl <- labkey.buildURL(baseUrl, "query", "deleteRows.api", folderPath) ## Execute via our standard POST function mydata <- labkey.post(myurl, pbody) @@ -65,10 +61,7 @@ labkey.truncateTable <- function(baseUrl=NULL, folderPath, schemaName, queryName if (missing(schemaName)) stop (paste("A value must be specified for schemaName.")) if (missing(queryName)) stop (paste("A value must be specified for queryName.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - - url <- paste(baseUrl, "query", folderPath, "truncateTable.api", sep="") + url <- labkey.buildURL(baseUrl, "query", "truncateTable.api", folderPath) params <- list(schemaName=schemaName, queryName=queryName) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) diff --git a/Rlabkey/R/labkey.domain.R b/Rlabkey/R/labkey.domain.R index 60184a4..b314fdb 100644 --- a/Rlabkey/R/labkey.domain.R +++ b/Rlabkey/R/labkey.domain.R @@ -24,11 +24,7 @@ labkey.domain.get <- function(baseUrl=NULL, folderPath, schemaName, queryName) if(missing(baseUrl) || is.null(baseUrl) || missing(folderPath) || missing(schemaName) || missing(queryName)) stop (paste("A value must be specified for each of baseUrl, folderPath, schemaName and queryName.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - - url <- paste(baseUrl, "property", folderPath, "getDomain.api", sep="") - + url <- labkey.buildURL(baseUrl, "property", "getDomain.api", folderPath) params <- list(schemaName=schemaName, queryName=queryName) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) @@ -63,11 +59,9 @@ labkey.domain.save <- function(baseUrl=NULL, folderPath, schemaName, queryName, if (!is.list(domainDesign)) stop (paste("domainDesign must be a list data structure.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) params <- list(schemaName = schemaName, queryName = queryName, domainDesign = domainDesign) + url <- labkey.buildURL(baseUrl, "property", "saveDomain.api", folderPath) - url <- paste(baseUrl, "property", folderPath, "saveDomain.api", sep="") response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) return (fromJSON(response)) @@ -157,10 +151,7 @@ labkey.domain.create <- function(baseUrl=NULL, folderPath, domainKind=NULL, doma createDomain = createDomain, importData = importData) } - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - - url <- paste(baseUrl, "property", folderPath, "createDomain.api", sep="") + url <- labkey.buildURL(baseUrl, "property", "createDomain.api", folderPath) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) return (fromJSON(response)) @@ -175,11 +166,7 @@ labkey.domain.drop <- function(baseUrl=NULL, folderPath, schemaName, queryName) if (missing(schemaName)) stop (paste("A value must be specified for schemaName.")) if (missing(queryName)) stop (paste("A value must be specified for queryName.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - - url <- paste(baseUrl, "property", folderPath, "deleteDomain.api", sep="") - + url <- labkey.buildURL(baseUrl, "property", "deleteDomain.api", folderPath) params <- list(schemaName=schemaName, queryName=queryName) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) @@ -194,17 +181,14 @@ labkey.domain.inferFields <- function(baseUrl=NULL, folderPath, df) if (missing(baseUrl) || is.null(baseUrl) || missing(folderPath) || missing(df)) stop (paste("A value must be specified for each of baseUrl, folderPath and df.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - ## write the dataframe to a tempfile to post to the server tf <- tempfile(fileext=".tsv") write.table(df, file=tf, sep="\t", quote=FALSE, row.names=FALSE) ## Execute via our standard POST function - url <- paste(baseUrl, "property", folderPath, "inferDomain.api", sep="") - + url <- labkey.buildURL(baseUrl, "property", "inferDomain.api", folderPath) rawdata <- labkey.post(url, list(file=upload_file(tf)), encoding="multipart") + ## delete the temp file file.remove(tf) response <- fromJSON(rawdata) diff --git a/Rlabkey/R/labkey.executeSql.R b/Rlabkey/R/labkey.executeSql.R index 6cf65e3..563a183 100755 --- a/Rlabkey/R/labkey.executeSql.R +++ b/Rlabkey/R/labkey.executeSql.R @@ -25,11 +25,8 @@ labkey.executeSql <- function(baseUrl=NULL, folderPath, schemaName, sql, maxRows if (missing(schemaName)) stop (paste("A value must be specified for schemaName.")) if (missing(sql)) stop (paste("A value must be specified for sql.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - ## Construct url - myurl <- paste(baseUrl, "query", folderPath, "executeSql.api", sep="") + myurl <- labkey.buildURL(baseUrl, "query", "executeSql.api", folderPath) ## Apply wafEncode, if requested if (isWafEncoding()) sql <- wafEncode(sql) diff --git a/Rlabkey/R/labkey.experiment.R b/Rlabkey/R/labkey.experiment.R index a3c2a82..d784d8a 100644 --- a/Rlabkey/R/labkey.experiment.R +++ b/Rlabkey/R/labkey.experiment.R @@ -156,11 +156,8 @@ labkey.experiment.saveBatch <- function(baseUrl=NULL, folderPath, assayConfig = if (is.null(assayConfig) && is.null(protocolName)) stop (paste("Either an assay config list or protocolName must be specified. The assay configuration must contain either an assayId or both assayName and providerName")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - ## Now post form with batch object filled out - url <- paste(baseUrl, "assay", folderPath, "saveAssayBatch.api", sep="") + url <- labkey.buildURL(baseUrl, "assay", "saveAssayBatch.api", folderPath) if (!is.null(assayConfig)) params = assayConfig @@ -185,11 +182,8 @@ labkey.experiment.saveRuns <- function(baseUrl=NULL, folderPath, protocolName, r if (missing(protocolName)) stop (paste("A value must be specified for protocolName.")) if (missing(runList)) stop (paste("A value must be specified for runList.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - ## Now post form with runs object filled out - url <- paste(baseUrl, "assay", folderPath, "saveAssayRuns.api", sep="") + url <- labkey.buildURL(baseUrl, "assay", "saveAssayRuns.api", folderPath) if (!is.null(runList)) { @@ -234,10 +228,7 @@ labkey.experiment.lineage <- function(baseUrl=NULL, folderPath, lsids, options = if (!missing(options)) params <- c(params, options) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - - url <- paste(baseUrl, "experiment", folderPath, "lineage.api", sep="") + url <- labkey.buildURL(baseUrl, "experiment", "lineage.api", folderPath) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) return (fromJSON(response, simplifyVector=FALSE, simplifyDataFrame=FALSE)) diff --git a/Rlabkey/R/labkey.getFolders.R b/Rlabkey/R/labkey.getFolders.R index 7a82b9c..b8a85d9 100644 --- a/Rlabkey/R/labkey.getFolders.R +++ b/Rlabkey/R/labkey.getFolders.R @@ -26,21 +26,33 @@ labkey.getFolders <- function(baseUrl=NULL, folderPath, includeEffectivePermissi folderPath <- encodeFolderPath(folderPath) ## Formatting - if(includeSubfolders) {inclsf <- paste("1&depth=", depth, sep="")} else {inclsf <- "0"} - if(includeEffectivePermissions) {inclep <- "1"} else {inclep <- "0"} - if(includeChildWorkbooks) {inclcw <- "1"} else {inclcw <- "0"} + params <- list() + if (includeSubfolders) + params <- c(params, list("includeSubfolders"=1, "depth"=depth)) + else + params <- c(params, list("includeSubfolders"=0)) + + if (includeEffectivePermissions) + params <- c(params, list("includeEffectivePermissions"=1)) + else + params <- c(params, list("includeEffectivePermissions"=0)) + + if (includeChildWorkbooks) + params <- c(params, list("includeChildWorkbooks"=1)) + else + params <- c(params, list("includeChildWorkbooks"=0)) - inclsp <- "0" resultCols = c("name", "path", "id", "effectivePermissions") - if(includeStandardProperties) { - inclsp <- "1" + if (includeStandardProperties) + { + params <- c(params, list("includeStandardProperties"=1)) resultCols = c("name", "path", "id", "title", "type", "folderType", "effectivePermissions") } + else + params <- c(params, list("includeStandardProperties"=0)) ## Construct url - myurl <- paste(baseUrl,"project",folderPath,"getContainers.view?","includeSubfolders=",inclsf, - "&includeEffectivePermissions=",inclep,"&includeChildWorkbooks=",inclcw,"&includeStandardProperties=",inclsp, - sep="") + myurl <- labkey.buildURL(baseUrl, "project", "getContainers.api", folderPath, params) ## Execute via our standard GET function mydata <- labkey.get(myurl); diff --git a/Rlabkey/R/labkey.getQueryInfo.R b/Rlabkey/R/labkey.getQueryInfo.R index c0bd773..2e45d7e 100644 --- a/Rlabkey/R/labkey.getQueryInfo.R +++ b/Rlabkey/R/labkey.getQueryInfo.R @@ -47,20 +47,14 @@ getQueryInfo <- function(baseUrl=NULL, folderPath, schemaName, queryName, showDe if (missing(folderPath)) stop (paste("A value must be specified for folderPath.")) if (missing(schemaName)) stop (paste("A value must be specified for schemaName.")) if (missing(queryName)) stop (paste("A value must be specified for queryName.")) + if (is.null(lookupKey)==FALSE) {char <- nchar(lookupKey); if(char<1) {lookupKey<-NULL} } - if(is.null(lookupKey)==FALSE) {char <- nchar(lookupKey); if(char<1) {lookupKey<-NULL} } - - ## URL encoding (if not already encoded) - if(schemaName==URLdecode(schemaName)) {schemaName <- URLencode(schemaName)} - if(queryName==URLdecode(queryName)) {queryName <- URLencode(queryName)} - if(is.null(lookupKey)==FALSE) {if(lookupKey==URLdecode(lookupKey)) lookupKey <- URLencode(lookupKey)} - - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) + params <- list("schemaName"=schemaName, "query.queryName"=queryName, "apiVersion"="8.3") + if (!is.null(lookupKey)) + params <- c(params, list("fk"=lookupKey)) ## Construct url - myurl <- paste(baseUrl,"query",folderPath,"getQueryDetails.api?schemaName=", schemaName, "&queryName=", queryName, "&apiVersion=8.3", sep="") - if(is.null(lookupKey)==FALSE) {myurl <- paste(myurl,"&fk=",lookupKey,sep="")} + myurl <- labkey.buildURL(baseUrl, "query", "getQueryDetails.api", folderPath, params) ## Execute via our standard GET function mydata <- labkey.get(myurl) diff --git a/Rlabkey/R/labkey.getQueryLists.R b/Rlabkey/R/labkey.getQueryLists.R index ce6ff0a..a00cb25 100644 --- a/Rlabkey/R/labkey.getQueryLists.R +++ b/Rlabkey/R/labkey.getQueryLists.R @@ -34,36 +34,30 @@ labkey.getQueryViews <- function(baseUrl=NULL, folderPath, schemaName, queryName getQueryLists <- function(baseUrl=NULL, folderPath, schemaName, queryName=NULL) { baseUrl=labkey.getBaseUrl(baseUrl) - if((length(queryName)>0) && (queryName==URLdecode(queryName)) ) { queryName <- URLencode(queryName) } ## Validate required parameters if (missing(folderPath)) stop (paste("A value must be specified for folderPath.")) if (missing(schemaName)) stop (paste("A value must be specified for schemaName.")) - ## URL encoding of schemaName (if not already encoded) - if(schemaName==URLdecode(schemaName)) {schemaName <- URLencode(schemaName)} - - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) + params <- list("schemaName"=schemaName, "apiVersion"="8.3") ## now setup the different columns for views vs queries - if(length(queryName)==0) + if (length(queryName)==0) { - serverAction <- "getQueries.view?schemaName=" - qParam <- "" + serverAction <- "getQueries.api" queryObjType <- "queries" columnNames <- c("queryName", "fieldName") } else { - serverAction <- "getQueryViews.api?schemaName=" - qParam <- paste("&queryName=",queryName, sep="") + serverAction <- "getQueryViews.api" + params <- c(params, list("queryName"=queryName)) queryObjType <- "views" columnNames <- c("viewName", "fieldName") } ## Construct url - myurl <- paste(baseUrl, "query", folderPath, serverAction, schemaName, qParam, "&apiVersion=8.3", sep="") + myurl <- labkey.buildURL(baseUrl, "query", serverAction, folderPath, params) ## Execute via our standard GET function mydata <- labkey.get(myurl); diff --git a/Rlabkey/R/labkey.getSchemas.R b/Rlabkey/R/labkey.getSchemas.R index a82f48a..17cb1cf 100644 --- a/Rlabkey/R/labkey.getSchemas.R +++ b/Rlabkey/R/labkey.getSchemas.R @@ -29,11 +29,9 @@ labkey.getSchemas <- function(baseUrl=NULL, folderPath) ## Validate required parameters if (missing(folderPath)) stop (paste("A value must be specified for folderPath.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - ## Construct url - myurl <- paste(baseUrl,"query",folderPath,"getSchemas.view?apiVersion=9.3", sep="") + params <- list("apiVersion"="9.3") + myurl <- labkey.buildURL(baseUrl, "query", "getSchemas.api", folderPath, params) ## Execute via our standard GET function mydata <- labkey.get(myurl) diff --git a/Rlabkey/R/labkey.importRows.R b/Rlabkey/R/labkey.importRows.R index 34c1b1e..b72514f 100644 --- a/Rlabkey/R/labkey.importRows.R +++ b/Rlabkey/R/labkey.importRows.R @@ -28,15 +28,12 @@ labkey.importRows <- function(baseUrl=NULL, folderPath, schemaName, queryName, t if (missing(toImport)) stop (paste("A value must be specified for toImport.")) if (nrow(toImport) == 0) stop (paste("toImport must contain at least one row.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - ## URL encode folder path, JSON encode post body (if not already encoded) toImport <- convertFactorsToStrings(toImport); params <- list(schemaName=schemaName, queryName=queryName, apiVersion=8.3) pbody <- jsonEncodeRowsAndParams(toImport, params, na) - myurl <- paste(baseUrl, "query", folderPath, "importRows.api", sep="") + myurl <- labkey.buildURL(baseUrl, "query", "importRows.api", folderPath) ## Execute via our standard POST function mydata <- labkey.post(myurl, pbody) diff --git a/Rlabkey/R/labkey.insertRows.R b/Rlabkey/R/labkey.insertRows.R index 77570c9..a8eb196 100644 --- a/Rlabkey/R/labkey.insertRows.R +++ b/Rlabkey/R/labkey.insertRows.R @@ -30,9 +30,6 @@ labkey.insertRows <- function(baseUrl=NULL, folderPath, schemaName, queryName, t ## Default showAllRows=TRUE showAllRows=TRUE - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - ## URL encode folder path, JSON encode post body (if not already encoded) toInsert <- convertFactorsToStrings(toInsert); @@ -44,7 +41,7 @@ labkey.insertRows <- function(baseUrl=NULL, folderPath, schemaName, queryName, t pbody <- jsonEncodeRowsAndParams(toInsert, params, na) - myurl <- paste(baseUrl, "query", folderPath, "insertRows.api", sep="") + myurl <- labkey.buildURL(baseUrl, "query", "insertRows.api", folderPath) ## Execute via our standard POST function mydata <- labkey.post(myurl, pbody) diff --git a/Rlabkey/R/labkey.moduleProperty.R b/Rlabkey/R/labkey.moduleProperty.R index c335401..14a66ec 100644 --- a/Rlabkey/R/labkey.moduleProperty.R +++ b/Rlabkey/R/labkey.moduleProperty.R @@ -26,10 +26,7 @@ labkey.getModuleProperty <- function(baseUrl=NULL, folderPath, moduleName, propN if (missing(moduleName)) stop (paste("A value must be specified for moduleName.")) if (missing(propName)) stop (paste("A value must be specified for propName.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - - url <- paste(baseUrl, "project", folderPath, "getContainers.api", sep="") + url <- labkey.buildURL(baseUrl, "project", "getContainers.api", folderPath) params <- list(moduleProperties=c(moduleName)) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) @@ -74,9 +71,6 @@ labkey.setModuleProperty <- function(baseUrl=NULL, folderPath, moduleName, propN if (missing(propName)) stop (paste("A value must be specified for propName.")) if (missing(propValue)) stop (paste("A value must be specified for propValue.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - property <- list() property$moduleName = moduleName property$userId = 0 ## Ignored and no longer required, as of 21.7. Remove this parameter once compatibility with < 21.7 is no longer needed. @@ -86,7 +80,7 @@ labkey.setModuleProperty <- function(baseUrl=NULL, folderPath, moduleName, propN params <- list(properties=list(property)) - url <- paste(baseUrl, "core", folderPath, "saveModuleProperties.api", sep="") + url <- labkey.buildURL(baseUrl, "core", "saveModuleProperties.api", folderPath) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) return (fromJSON(response, simplifyVector=FALSE, simplifyDataFrame=FALSE)) diff --git a/Rlabkey/R/labkey.moveRows.R b/Rlabkey/R/labkey.moveRows.R index d9c5343..51e0bc0 100644 --- a/Rlabkey/R/labkey.moveRows.R +++ b/Rlabkey/R/labkey.moveRows.R @@ -27,9 +27,6 @@ labkey.moveRows <- function(baseUrl=NULL, folderPath, targetFolderPath, schemaNa if (!missing(options) & !is.list(options)) stop (paste("The options parameter must be a list data structure.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - ## URL encode folder path, JSON encode post body (if not already encoded) toMove <- convertFactorsToStrings(toMove); @@ -39,7 +36,7 @@ labkey.moveRows <- function(baseUrl=NULL, folderPath, targetFolderPath, schemaNa pbody <- jsonEncodeRowsAndParams(toMove, params, NULL) - myurl <- paste(baseUrl, "query", folderPath, "moveRows.api", sep="") + myurl <- labkey.buildURL(baseUrl, "query", "moveRows.api", folderPath) ## Execute via our standard POST function mydata <- labkey.post(myurl, pbody) diff --git a/Rlabkey/R/labkey.pipeline.R b/Rlabkey/R/labkey.pipeline.R index ff98f60..e8c3856 100644 --- a/Rlabkey/R/labkey.pipeline.R +++ b/Rlabkey/R/labkey.pipeline.R @@ -22,10 +22,7 @@ labkey.pipeline.getPipelineContainer <- function(baseUrl=NULL, folderPath) if (missing(baseUrl) || is.null(baseUrl)) stop (paste("A value must be specified for baseUrl.")) if (missing(folderPath)) stop (paste("A value must be specified for folderPath.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - - url <- paste(baseUrl, "pipeline", folderPath, "getPipelineContainer.api", sep="") + url <- labkey.buildURL(baseUrl, "pipeline", "getPipelineContainer.api", folderPath) response <- labkey.get(url) return (fromJSON(response, simplifyVector=FALSE, simplifyDataFrame=FALSE)) @@ -41,12 +38,9 @@ labkey.pipeline.getProtocols <- function(baseUrl=NULL, folderPath, taskId, path, if (missing(taskId) || is.null(taskId)) stop (paste("A value must be specified for taskId.")) if (missing(path) || is.null(path)) stop (paste("A value must be specified for path.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - params <- list(taskId = taskId, path = path, includeWorkbooks = includeWorkbooks) - url <- paste(baseUrl, "pipeline-analysis", folderPath, "getSavedProtocols.api", sep="") + url <- labkey.buildURL(baseUrl, "pipeline-analysis", "getSavedProtocols.api", folderPath) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) return (fromJSON(response, simplifyVector=FALSE, simplifyDataFrame=FALSE)) @@ -67,12 +61,9 @@ labkey.pipeline.getFileStatus <- function(baseUrl=NULL, folderPath, taskId, prot ## check parameter types if (!is.list(files)) stop (paste("The files parameter must be a list of strings.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - params <- list(taskId = taskId, protocolName = protocolName, path = path, file = files) - url <- paste(baseUrl, "pipeline-analysis", folderPath, "getFileStatus.api", sep="") + url <- labkey.buildURL(baseUrl, "pipeline-analysis", "getFileStatus.api", folderPath) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) return (fromJSON(response, simplifyVector=FALSE, simplifyDataFrame=FALSE)) @@ -100,9 +91,6 @@ labkey.pipeline.startAnalysis <- function(baseUrl=NULL, folderPath, taskId, prot if (!is.null(jsonParameters) && !(is.list(jsonParameters) || is.character(jsonParameters))) stop (paste("The jsonParameters parameter must be a list of key / value pairs or a string representation of that list created using toJSON.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - params <- list(taskId = taskId, protocolName = protocolName, path = path, file = files, fileIds = fileIds, allowNonExistentFiles = allowNonExistentFiles, saveProtocol = saveProtocol) @@ -120,7 +108,7 @@ labkey.pipeline.startAnalysis <- function(baseUrl=NULL, folderPath, taskId, prot params$configureJson = toJSON(jsonParameters, auto_unbox=TRUE) } - url <- paste(baseUrl, "pipeline-analysis", folderPath, "startAnalysis.api", sep="") + url <- labkey.buildURL(baseUrl, "pipeline-analysis", "startAnalysis.api", folderPath) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE), haltOnError = FALSE) ## a successful response from this API call will contain a "status" property, so key off of that diff --git a/Rlabkey/R/labkey.provenance.R b/Rlabkey/R/labkey.provenance.R index 567c2cc..4a0d855 100644 --- a/Rlabkey/R/labkey.provenance.R +++ b/Rlabkey/R/labkey.provenance.R @@ -107,10 +107,7 @@ labkey.provenance.startRecording <- function(baseUrl=NULL, folderPath, provenanc if (is.null(provenanceParams)) stop (paste("Provenance start recording must include the provenanceParams.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - - url <- paste(baseUrl, "provenance", folderPath, "startRecording.api", sep="") + url <- labkey.buildURL(baseUrl, "provenance", "startRecording.api", folderPath) response <- labkey.post(url, toJSON(provenanceParams, auto_unbox=TRUE)) return (fromJSON(response)) @@ -127,10 +124,7 @@ labkey.provenance.addRecordingStep <- function(baseUrl=NULL, folderPath, provena if (is.null(provenanceParams)) stop (paste("Provenance start recording must include the provenanceParams.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - - url <- paste(baseUrl, "provenance", folderPath, "addRecordingStep.api", sep="") + url <- labkey.buildURL(baseUrl, "provenance", "addRecordingStep.api", folderPath) response <- labkey.post(url, toJSON(provenanceParams, auto_unbox=TRUE)) return (fromJSON(response)) @@ -147,10 +141,7 @@ labkey.provenance.stopRecording <- function(baseUrl=NULL, folderPath, provenance if (is.null(provenanceParams)) stop (paste("Provenance start recording must include the provenanceParams.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - - url <- paste(baseUrl, "provenance", folderPath, "stopRecording.api", sep="") + url <- labkey.buildURL(baseUrl, "provenance", "stopRecording.api", folderPath) response <- labkey.post(url, toJSON(provenanceParams, auto_unbox=TRUE)) return (fromJSON(response)) diff --git a/Rlabkey/R/labkey.query.import.R b/Rlabkey/R/labkey.query.import.R index 2860101..80e8e94 100644 --- a/Rlabkey/R/labkey.query.import.R +++ b/Rlabkey/R/labkey.query.import.R @@ -24,9 +24,6 @@ labkey.query.import <- function(baseUrl=NULL, folderPath, schemaName, queryName, if (!missing(options) & !is.list(options)) stop (paste("The options parameter must be a list data structure.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - ## write the dataframe to a tempfile to post to the server tf <- tempfile(fileext=".tsv") write.table(toImport, file=tf, sep="\t", quote=FALSE, row.names=FALSE) @@ -37,7 +34,7 @@ labkey.query.import <- function(baseUrl=NULL, folderPath, schemaName, queryName, options <- c(options, list(schemaName=schemaName, queryName=queryName, file=upload_file(tf))) ## Execute via our standard POST function - url <- paste(baseUrl, "query", folderPath, "import.api", sep="") + url <- labkey.buildURL(baseUrl, "query", "import.api", folderPath) rawdata <- labkey.post(url, options, encoding="multipart") response <- fromJSON(rawdata, simplifyVector=FALSE, simplifyDataFrame=FALSE) diff --git a/Rlabkey/R/labkey.rstudio.R b/Rlabkey/R/labkey.rstudio.R index f9fa72b..d563955 100644 --- a/Rlabkey/R/labkey.rstudio.R +++ b/Rlabkey/R/labkey.rstudio.R @@ -23,7 +23,8 @@ labkey.rstudio.initSession <- function(requestId, baseUrl) if(missing(requestId) || missing(baseUrl)) stop (paste("A value must be specified for each of requestId and baseUrl.")) - url <- paste(baseUrl, "rstudio-fetchCmd.api?id=", requestId, sep="") + params <- list("id"=requestId) + url <- labkey.buildURL(baseUrl, "rstudio", "fetchCmd.api", "", params) response <- labkey.get(url) lkResult <- (fromJSON(response)) if (lkResult$success == TRUE) @@ -75,10 +76,7 @@ labkey.rstudio.initReport <- function(apiKey="", baseUrl="", folderPath, reportE if(missing(folderPath) || missing(reportEntityId)) stop (paste("A value must be specified for each of folderPath and reportEntityId.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - - url <- paste(baseUrl, "rstudio", folderPath, "getRReportContent.api", sep="") + url <- labkey.buildURL(baseUrl, "rstudio", "getRReportContent.api", folderPath) params <- list(entityId=reportEntityId) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) @@ -163,13 +161,10 @@ labkey.rstudio.saveReport <- function(folderPath, reportEntityId, reportFilename } } - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - baseUrl=labkey.getBaseUrl(NULL) ## check valid report - url <- paste(baseUrl, "rstudio", folderPath, "ValidateRStudioReport.api", sep="") + url <- labkey.buildURL(baseUrl, "rstudio", "ValidateRStudioReport.api", folderPath) params <- list(entityId=reportEntityId) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) lkResult <- (fromJSON(response)) @@ -191,7 +186,7 @@ labkey.rstudio.saveReport <- function(folderPath, reportEntityId, reportFilename { return("Skipped saving updated source to LabKey Server"); } - url <- paste(baseUrl, "rstudio", folderPath, "SaveRReportContent.api", sep="") + url <- labkey.buildURL(baseUrl, "rstudio", "SaveRReportContent.api", folderPath) script <- readChar(reportFilename, file.info(reportFilename)$size) diff --git a/Rlabkey/R/labkey.saveBatch.R b/Rlabkey/R/labkey.saveBatch.R index 805fe20..d66a558 100644 --- a/Rlabkey/R/labkey.saveBatch.R +++ b/Rlabkey/R/labkey.saveBatch.R @@ -25,11 +25,8 @@ labkey.saveBatch <- function(baseUrl=NULL, folderPath, assayName, resultDataFram if (missing(assayName)) stop (paste("A value must be specified for assayName.")) if (missing(resultDataFrame)) stop (paste("A value must be specified for resultDataFrame.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - ## Translate assay name to an ID - myurl <- paste(baseUrl,"assay",folderPath,"assayList.api", sep="") + myurl <- labkey.buildURL(baseUrl, "assay", "assayList.api", folderPath) params <- list(name=assayName) assayInfoJSON <- labkey.post(myurl, toJSON(params, auto_unbox=TRUE)) assayDef <- NULL @@ -68,7 +65,7 @@ labkey.saveBatch <- function(baseUrl=NULL, folderPath, assayName, resultDataFram baseAssayList <- c(baseAssayList, list(batch=batchPropertyList)) ## Now post form with batch object filled out - myurl <- paste(baseUrl, "assay", folderPath, "saveAssayBatch.api", sep="") + myurl <- labkey.buildURL(baseUrl, "assay", "saveAssayBatch.api", folderPath) pbody <- toJSON(baseAssayList, auto_unbox=TRUE) ## Execute via our standard POST function diff --git a/Rlabkey/R/labkey.security.R b/Rlabkey/R/labkey.security.R index 358abd6..8959cec 100644 --- a/Rlabkey/R/labkey.security.R +++ b/Rlabkey/R/labkey.security.R @@ -34,16 +34,13 @@ labkey.security.createContainer <- function(baseUrl=NULL, parentPath, name = NUL if (missing(baseUrl) || is.null(baseUrl) || missing(parentPath)) stop (paste("A value must be specified for both baseUrl and parentPath.")) - ## normalize the folder path - parentPath <- encodeFolderPath(parentPath) - params <- list(isWorkbook = isWorkbook) if(is.null(name)==FALSE) {params <- c(params, list(name=name))} if(is.null(title)==FALSE) {params <- c(params, list(title=title))} if(is.null(description)==FALSE) {params <- c(params, list(description=description))} if(is.null(folderType)==FALSE) {params <- c(params, list(folderType=folderType))} - url <- paste(baseUrl, "core", parentPath, "createContainer.api", sep="") + myurl <- labkey.buildURL(baseUrl, "core", "createContainer.api", parentPath) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) return (fromJSON(response)) @@ -59,12 +56,9 @@ labkey.security.deleteContainer <- function(baseUrl=NULL, folderPath) if (missing(baseUrl) || is.null(baseUrl) || missing(folderPath)) stop (paste("A value must be specified for both baseUrl and folderPath.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - params <- list(folderPath = folderPath) # no params for this action but need an object for the post body - url <- paste(baseUrl, "core", folderPath, "deleteContainer.api", sep="") + url <- labkey.buildURL(baseUrl, "core", "deleteContainer.api", folderPath) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) return (fromJSON(response)) @@ -83,10 +77,7 @@ labkey.security.moveContainer <- function(baseUrl=NULL, folderPath, destinationP params <- list(container = folderPath, parent = destinationParent) if(is.null(addAlias)==FALSE) {params <- c(params, list(addAlias=addAlias))} - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - - url <- paste(baseUrl, "core", folderPath, "moveContainer.api", sep="") + url <- labkey.buildURL(baseUrl, "core", "moveContainer.api", folderPath) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) return (fromJSON(response)) @@ -110,10 +101,7 @@ labkey.security.renameContainer <- function(baseUrl=NULL, folderPath, name=NULL, if(is.null(title)==FALSE) {params <- c(params, list(title=title))} if(is.null(addAlias)==FALSE) {params <- c(params, list(addAlias=addAlias))} - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - - url <- paste(baseUrl, "admin", folderPath, "renameContainer.api", sep="") + url <- labkey.buildURL(baseUrl, "admin", "renameContainer.api", folderPath) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) return (fromJSON(response)) @@ -129,14 +117,11 @@ labkey.security.impersonateUser <- function(baseUrl = NULL, folderPath, userId = if (missing(userId) && missing(email)) stop (paste("A value must be specified for either userId or email.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - params <- list() if(!missing(userId)) {params <- c(params, list(userId = userId))} if(!missing(email)) {params <- c(params, list(email = email))} - url <- paste(baseUrl, "user", folderPath, "impersonateUser.api", sep="") + url <- labkey.buildURL(baseUrl, "user", "impersonateUser.api", folderPath) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) return (labkey.whoAmI()) @@ -150,7 +135,7 @@ labkey.security.stopImpersonating <- function(baseUrl = NULL) if (missing(baseUrl) || is.null(baseUrl)) stop (paste("A value must be specified for baseUrl.")) - url <- paste(baseUrl, "login/", "stopImpersonating.api", sep="") + url <- labkey.buildURL(baseUrl, "login", "stopImpersonating.api", "/") labkey.post(url, toJSON(list())) return (labkey.whoAmI()) diff --git a/Rlabkey/R/labkey.selectRows.R b/Rlabkey/R/labkey.selectRows.R index b7b37f0..667f851 100755 --- a/Rlabkey/R/labkey.selectRows.R +++ b/Rlabkey/R/labkey.selectRows.R @@ -19,7 +19,6 @@ labkey.selectRows <- function(baseUrl=NULL, folderPath, schemaName, queryName, v containerFilter=NULL, parameters=NULL, includeDisplayValues=FALSE, method='POST') { baseUrl=labkey.getBaseUrl(baseUrl) - apiVersion = "8.3" # Empty string/NULL checking if (!is.null(viewName)) {char <- nchar(viewName); if(char<1){viewName<-NULL}} @@ -54,7 +53,7 @@ labkey.selectRows <- function(baseUrl=NULL, folderPath, schemaName, queryName, v } # Construct the query parameter list of named elements (key / value pairs) - params <- list("schemaName"=schemaName, "query.queryName"=queryName, "apiVersion"=apiVersion) + params <- list("schemaName"=schemaName, "query.queryName"=queryName, "apiVersion"="8.3") if (!is.null(includeDisplayValues) && includeDisplayValues == TRUE) params <- c(params, list("includeDisplayValues"=includeDisplayValues)) if (!is.null(viewName)) @@ -71,28 +70,25 @@ labkey.selectRows <- function(baseUrl=NULL, folderPath, schemaName, queryName, v params <- c(params, list("query.sort"=colSort)) if (!is.null(colFilter)) { - if (is.list(colFilter)) + if (is.list(colFilter) && !is.null(names(colFilter))) + { + # preferred list with named elements format params <- c(params, colFilter) + } + else if (length(colFilter) > 0) + { + # Legacy format of URL encoded key / value pairs, convert to a list of named elements + # which can be processed by buildURL + params <- c(params, parseToList(colFilter, dataRegionName="", urlDecode=TRUE)) + } else - stop (paste("Argument colFilter must be a list generated from makeFilter")) + stop (paste("Argument colFilter must be a list or vector generated from makeFilter")) } if (!is.null(parameters)) { # Support the legacy format. TODO: require a list with named elements that can # be passed directly to the larger param list without needing to parse - for (k in 1:length(parameters)) - { - parts <- strsplit(parameters[k], "=")[[1]] - if (length(parts) == 2) - { - # add each parameter name / value pair to the select rows parameter list - paramList <- list(parts[2]) - names(paramList) <- paste("query.param.", parts[1], sep="") - params <- c(params, paramList) - } - else - stop (paste("Argument parameters is incorrectly formatted, it needs to be a list of string value pairs delimited by '='")) - } + params <- c(params, parseToList(parameters, dataRegionName="query.param.")) } if (!is.null(containerFilter)) params <- c(params, list("containerFilter"=containerFilter)) @@ -100,13 +96,13 @@ labkey.selectRows <- function(baseUrl=NULL, folderPath, schemaName, queryName, v if (!is.null(method) && method == "GET") { # Execute via our standard GET function - myurl <- buildURL(baseUrl, "query", "selectRows.api", folderPath, params) + myurl <- labkey.buildURL(baseUrl, "query", "selectRows.api", folderPath, params) mydata <- labkey.get(myurl); } else { # Execute via our standard POST function - myurl <- buildURL(baseUrl, "query", "selectRows.api", folderPath) + myurl <- labkey.buildURL(baseUrl, "query", "selectRows.api", folderPath) mydata <- labkey.post(myurl, toJSON(params, auto_unbox=TRUE)) } @@ -118,3 +114,28 @@ labkey.selectRows <- function(baseUrl=NULL, folderPath, schemaName, queryName, v return(newdata) } +# Utility to convert a vector of parameter values of the form : "foo=bar" into a list with +# named elements which is the format that buildURL requires for parameters. +# +parseToList <- function(parameters, dataRegionName="query.", urlDecode=FALSE) +{ + params <- list() + for (i in 1:length(parameters)) + { + parts <- strsplit(parameters[i], "=")[[1]] + if (length(parts) == 2) + { + key <- if (urlDecode) URLdecode(parts[1]) else parts[1] + value <- if (urlDecode) URLdecode(parts[2]) else parts[2] + + paramList <- list(value) + names(paramList) <- paste(dataRegionName, key, sep="") + params <- c(params, paramList) + } + else + stop (paste("Argument parameters is incorrectly formatted, it needs to be a list of string value pairs delimited by '='")) + } + return (params) +} + + diff --git a/Rlabkey/R/labkey.storage.R b/Rlabkey/R/labkey.storage.R index 12396a6..840cba0 100644 --- a/Rlabkey/R/labkey.storage.R +++ b/Rlabkey/R/labkey.storage.R @@ -25,11 +25,8 @@ labkey.storage.create <- function(baseUrl=NULL, folderPath, type, props) if (!is.list(props)) stop (paste("Storage API props must be a list data structure.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - params <- list(type = type, props = props) - url <- paste(baseUrl, "storage", folderPath, "create.api", sep="") + url <- labkey.buildURL(baseUrl, "storage", "create.api", folderPath) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) return (fromJSON(response)) @@ -46,11 +43,8 @@ labkey.storage.update <- function(baseUrl=NULL, folderPath, type, props) if (!is.list(props)) stop (paste("Storage API props must be a list data structure.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - params <- list(type = type, props = props) - url <- paste(baseUrl, "storage", folderPath, "update.api", sep="") + url <- labkey.buildURL(baseUrl, "storage", "update.api", folderPath) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) return (fromJSON(response)) @@ -64,11 +58,8 @@ labkey.storage.delete <- function(baseUrl=NULL, folderPath, type, rowId) if (missing(baseUrl) || is.null(baseUrl) || missing(folderPath) || missing(type) || missing(rowId)) stop (paste("A value must be specified for each of baseUrl, folderPath, type, and rowId.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - params <- list(type = type, props = list(rowId = rowId)) - url <- paste(baseUrl, "storage", folderPath, "delete.api", sep="") + url <- labkey.buildURL(baseUrl, "storage", "delete.api", folderPath) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) return (fromJSON(response)) diff --git a/Rlabkey/R/labkey.updateRows.R b/Rlabkey/R/labkey.updateRows.R index bc988db..88a4c15 100644 --- a/Rlabkey/R/labkey.updateRows.R +++ b/Rlabkey/R/labkey.updateRows.R @@ -30,9 +30,6 @@ labkey.updateRows <- function(baseUrl=NULL, folderPath, schemaName, queryName, t if (!missing(options) & !is.list(options)) stop (paste("The options parameter must be a list data structure.")) - ## normalize the folder path - folderPath <- encodeFolderPath(folderPath) - ## URL encode folder path, JSON encode post body (if not already encoded) toUpdate <- convertFactorsToStrings(toUpdate); @@ -43,8 +40,7 @@ labkey.updateRows <- function(baseUrl=NULL, folderPath, schemaName, queryName, t params <- c(params, options) pbody <- jsonEncodeRowsAndParams(toUpdate, params, NULL) - - myurl <- paste(baseUrl, "query", folderPath, "updateRows.api", sep="") + myurl <- labkey.buildURL(baseUrl, "query", "updateRows.api", folderPath) ## Execute via our standard POST function mydata <- labkey.post(myurl, pbody) diff --git a/Rlabkey/R/makeFilter.R b/Rlabkey/R/makeFilter.R index 87f8148..b815936 100755 --- a/Rlabkey/R/makeFilter.R +++ b/Rlabkey/R/makeFilter.R @@ -14,7 +14,7 @@ # limitations under the License. ## -makeFilter <- function(..., asList=TRUE) +makeFilter <- function(..., asList=FALSE) { fargs <- list(...) flen <- lapply(fargs, function(x) {len <- length(x); if(len<3){stop ("each filter must be of length 3")}}) @@ -140,15 +140,18 @@ makeFilter <- function(..., asList=TRUE) } else { - # convert to URL encoded parameter list (legacy behavior) - url <- parse_url("") - url$query <- filters - myurl <- build_url(url) - - idx <- regexpr("\\?.*", myurl) - if (idx != -1) - return (regmatches(myurl, idx)) - else - return (NULL) + # convert to URL encoded vector of parameters (legacy behavior) + filterVec <- c() + for (i in 1:length(filters)) + { + url <- parse_url("") + url$query <- filters[i] + myurl <- build_url(url) + + idx <- regexpr("\\?.*", myurl) + if (idx != -1) + filterVec <- c(filterVec, regmatches(myurl, idx+1)) + } + return (filterVec) } } diff --git a/Rlabkey/man/makeFilter.Rd b/Rlabkey/man/makeFilter.Rd index 9c6f820..28bc877 100755 --- a/Rlabkey/man/makeFilter.Rd +++ b/Rlabkey/man/makeFilter.Rd @@ -6,10 +6,11 @@ This function takes inputs of column name, filter value and filter operator and returns an array of filters to be used in \code{labkey.selectRows} and \code{getRows}. } \usage{ -makeFilter(...) +makeFilter(..., asList=FALSE) } \arguments{ -\item{...}{Arguments in c("colname","operator","value") form, used to create a filter.} + \item{...}{Arguments in c("colname","operator","value") form, used to create a filter.} + \item{asList}{Boolean flag when set to TRUE will format the return value as a list with named elements.} } \details{ These filters are applied to the data prior to import into R. The user can specify as many @@ -64,7 +65,11 @@ See example below. \value{ The function returns either a single string or an array of strings to be use in the -\code{colFilter} argument of the \code{labkey.selectRows} function. +\code{colFilter} argument of the \code{labkey.selectRows} function. By default, this function will return an array +of LabKey filter parameters/values that are URL encoded and can be directly applied to a request URL. If the asList argument +is set to TRUE, the function will return a list with named elements where the name is the parameter name and the element +value is the filter value. This format can be useful when needing to build URLs that need to be combined with other +parameters or can be converted directly to JSON posted parameters. } \references{http://www.omegahat.net/RCurl/, \cr https://www.labkey.org/home/project-begin.view} From 569d44e98ee61f4db8998e4269cbc4eec1de909f Mon Sep 17 00:00:00 2001 From: Lum Date: Thu, 22 Jan 2026 13:40:20 -0800 Subject: [PATCH 3/3] Remove debug code, fix typo --- Rlabkey/R/labkey.defaults.R | 1 - Rlabkey/R/labkey.security.R | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/Rlabkey/R/labkey.defaults.R b/Rlabkey/R/labkey.defaults.R index b4b7d9b..199c712 100644 --- a/Rlabkey/R/labkey.defaults.R +++ b/Rlabkey/R/labkey.defaults.R @@ -383,6 +383,5 @@ labkey.buildURL <- function(baseUrl=NULL, controller, action, folderPath = NULL, myUrl <- build_url(url) } - print(myUrl) return (myUrl) } \ No newline at end of file diff --git a/Rlabkey/R/labkey.security.R b/Rlabkey/R/labkey.security.R index 8959cec..87107e5 100644 --- a/Rlabkey/R/labkey.security.R +++ b/Rlabkey/R/labkey.security.R @@ -40,7 +40,7 @@ labkey.security.createContainer <- function(baseUrl=NULL, parentPath, name = NUL if(is.null(description)==FALSE) {params <- c(params, list(description=description))} if(is.null(folderType)==FALSE) {params <- c(params, list(folderType=folderType))} - myurl <- labkey.buildURL(baseUrl, "core", "createContainer.api", parentPath) + url <- labkey.buildURL(baseUrl, "core", "createContainer.api", parentPath) response <- labkey.post(url, toJSON(params, auto_unbox=TRUE)) return (fromJSON(response))