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 c4af794..199c712 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,32 @@ encodeURIComponent <- function(value) value <- gsub("%28", "(", value) value <- gsub("%29", ")", value) return (value) +} + +# Construct a LabKey URL (path first format) +labkey.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) + } + return (myUrl) } \ No newline at end of file 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..87107e5 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="") + url <- 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 7795f94..667f851 100755 --- a/Rlabkey/R/labkey.selectRows.R +++ b/Rlabkey/R/labkey.selectRows.R @@ -20,36 +20,31 @@ labkey.selectRows <- function(baseUrl=NULL, folderPath, schemaName, queryName, v { baseUrl=labkey.getBaseUrl(baseUrl) - ## 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,65 +52,90 @@ 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"="8.3") + 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) && !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 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 + params <- c(params, parseToList(parameters, dataRegionName="query.param.")) + } + 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 <- labkey.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 <- labkey.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)