X-Git-Url: https://git.arvados.org/arvados.git/blobdiff_plain/7ff006ea5351259abe8edc89520996513652c147..3e1c43866e5b523c3f1d273c25942ad56dc66d3f:/sdk/R/R/Collection.R diff --git a/sdk/R/R/Collection.R b/sdk/R/R/Collection.R index c372bc20a2..fad452ac7a 100644 --- a/sdk/R/R/Collection.R +++ b/sdk/R/R/Collection.R @@ -1,336 +1,279 @@ source("./R/Subcollection.R") source("./R/ArvadosFile.R") - -#' Arvados Collection Object +source("./R/RESTService.R") +source("./R/util.R") + +#' Collection +#' +#' Collection class provides interface for working with Arvados collections. +#' +#' @section Usage: +#' \preformatted{collection = Collection$new(arv, uuid)} +#' +#' @section Arguments: +#' \describe{ +#' \item{arv}{Arvados object.} +#' \item{uuid}{UUID of a collection.} +#' } +#' +#' @section Methods: +#' \describe{ +#' \item{add(content)}{Adds ArvadosFile or Subcollection specified by content to the collection.} +#' \item{create(fileNames, relativePath = "")}{Creates one or more ArvadosFiles and adds them to the collection at specified path.} +#' \item{remove(fileNames)}{Remove one or more files from the collection.} +#' \item{move(content, newLocation)}{Moves ArvadosFile or Subcollection to another location in the collection.} +#' \item{getFileListing()}{Returns collections file content as character vector.} +#' \item{get(relativePath)}{If relativePath is valid, returns ArvadosFile or Subcollection specified by relativePath, else returns NULL.} +#' } +#' +#' @name Collection +#' @examples +#' \dontrun{ +#' arv <- Arvados$new("your Arvados token", "example.arvadosapi.com") +#' collection <- Collection$new(arv, "uuid") +#' +#' newFile <- ArvadosFile$new("myFile") +#' collection$add(newFile, "myFolder") +#' +#' createdFiles <- collection$create(c("main.cpp", lib.dll), "cpp/src/") +#' +#' collection$remove("location/to/my/file.cpp") #' -#' Update description +#' collection$move("folder/file.cpp", "file.cpp") #' -#' @examples arv = Collection$new(api, uuid) -#' @export Collection +#' arvadosFile <- collection$get("location/to/my/file.cpp") +#' arvadosSubcollection <- collection$get("location/to/my/directory/") +#' } +NULL + +#' @export Collection <- R6::R6Class( "Collection", public = list( - #Todo(Fudo): Encapsulate this? - uuid = NULL, - etag = NULL, - owner_uuid = NULL, - created_at = NULL, - modified_by_client_uuid = NULL, - modified_by_user_uuid = NULL, - modified_at = NULL, - portable_data_hash = NULL, - replication_desired = NULL, - replication_confirmed_at = NULL, - replication_confirmed = NULL, - updated_at = NULL, - manifest_text = NULL, - name = NULL, - description = NULL, - properties = NULL, - delete_at = NULL, - file_names = NULL, - trash_at = NULL, - is_trashed = NULL, - - initialize = function(api, uuid) - { - private$api <- api - result <- private$api$getCollection(uuid) - - self$uuid <- result$uuid - self$etag <- result$etag - self$owner_uuid <- result$owner_uuid - self$created_at <- result$created_at - self$modified_by_client_uuid <- result$modified_by_client_uuid - self$modified_by_user_uuid <- result$modified_by_user_uuid - self$modified_at <- result$modified_at - self$portable_data_hash <- result$portable_data_hash - self$replication_desired <- result$replication_desired - self$replication_confirmed_at <- result$replication_confirmed_at - self$replication_confirmed <- result$replication_confirmed - self$updated_at <- result$updated_at - self$manifest_text <- result$manifest_text - self$name <- result$name - self$description <- result$description - self$properties <- result$properties - self$delete_at <- result$delete_at - self$file_names <- result$file_names - self$trash_at <- result$trash_at - self$is_trashed <- result$is_trashed - - #Todo(Fudo): Replace this when you get access to webDAV server. - private$fileItems <- private$getCollectionContent() - - private$fileTree <- private$generateTree(private$fileItems) - }, + uuid = NULL, + # api = NULL, - printFileContent = function(pretty = TRUE) + initialize = function(api, uuid) { - if(pretty) - private$fileTree$printContent(0) - else - print(private$fileItems) + # self$api <- api + private$REST <- api$getRESTService() + + self$uuid <- uuid + private$fileContent <- private$REST$getCollectionContent(uuid) + private$tree <- CollectionTree$new(private$fileContent, self) }, - get = function(relativePath) + add = function(content, relativePath = "") { - treeNode <- private$traverseInOrder(private$fileTree, function(node) - { - if(node$relativePath == relativePath) - return(node) - else - return(NULL) - }) + if(is.null(private$tree)) + private$genereateCollectionTreeStructure() - if(!is.null(treeNode)) + if(relativePath == "" || + relativePath == "." || + relativePath == "./") { - return(private$createSubcollectionTree(treeNode)) + subcollection <- private$tree$getTree() } else { - return(NULL) + relativePath <- trimFromEnd(relativePath, "/") + subcollection <- self$get(relativePath) } - } - ), - - active = list( - items = function(value) - { - if(missing(value)) - return(private$fileItems) - else - print("Value is read-only.") - - return(NULL) - } - ), - - private = list( - api = NULL, - fileItems = NULL, - fileTree = NULL, + if(is.null(subcollection)) + stop(paste("Subcollection", relativePath, "doesn't exist.")) - createSubcollectionTree = function(treeNode) - { - if(treeNode$hasChildren()) + if("ArvadosFile" %in% class(content) || + "Subcollection" %in% class(content)) { - children = NULL + if(content$getName() == "") + stop("Content has invalid name.") - for(child in treeNode$children) - { - child <- private$createSubcollectionTree(child) - children <- c(children, child) - } - - return(Subcollection$new(treeNode$name, treeNode$relativePath, children)) + subcollection$add(content) + content } else { - if(treeNode$type == "file") - return(ArvadosFile$new(treeNode$name, treeNode$relativePath, private$api, self)) - else if(treeNode$type == "folder" || treeNode$type == "root") - return(Subcollection$new(treeNode$name, treeNode$relativePath, NULL)) + stop(paste0("Expected AravodsFile or Subcollection object, got ", + paste0("(", paste0(class(content), collapse = ", "), ")"), + ".")) } }, - createSubcollectionFromNode = function(treeNode, children) + create = function(fileNames, relativePath = "") { - subcollection = NULL - if(treeNode$type == "file") - subcollection = ArvadosFile$new(treeNode$name, treeNode$relativePath) - else if(treeNode$type == "folder" || treeNode$type == "root") - subcollection = Subcollection$new(treeNode$name, treeNode$relativePath, children) - - subcollection - }, + if(is.null(private$tree)) + private$genereateCollectionTreeStructure() - getCollectionContent = function() - { - #TODO(Fudo): Use proper URL here. - uri <- URLencode(paste0(private$api$getWebDavHostName(), "c=", self$uuid)) - - # fetch directory listing via curl and parse XML response - h <- curl::new_handle() - curl::handle_setopt(h, customrequest = "PROPFIND") - - #TODO(Fudo): Use proper token here. - curl::handle_setheaders(h, "Authorization" = paste("OAuth2", private$api$getToken())) - response <- curl::curl_fetch_memory(uri, h) - print(response) - - HttpParser$new()$parseWebDAVResponse(response, uri) - }, - - #Todo(Fudo): Move tree creation to another file. - generateTree = function(collectionContent) - { - treeBranches <- sapply(collectionContent, function(filePath) + if(relativePath == "" || + relativePath == "." || + relativePath == "./") { - splitPath <- unlist(strsplit(filePath, "/", fixed = TRUE)) - - pathEndsWithSlash <- substr(filePath, nchar(filePath), nchar(filePath)) == "/" - - branch = private$createBranch(splitPath, pathEndsWithSlash) - }) - - root <- TreeNode$new("./", "root") - root$relativePath = "" - - sapply(treeBranches, function(branch) + subcollection <- private$tree$getTree() + } + else { - private$addNode(root, branch) - }) + relativePath <- trimFromEnd(relativePath, "/") + subcollection <- self$get(relativePath) + } - root - }, + if(is.null(subcollection)) + stop(paste("Subcollection", relativePath, "doesn't exist.")) - createBranch = function(splitPath, pathEndsWithSlash) - { - branch <- NULL - lastElementIndex <- length(splitPath) - - lastElementInPathType = "file" - if(pathEndsWithSlash) - lastElementInPathType = "folder" - - for(elementIndex in lastElementIndex:1) + if(is.character(fileNames)) { - if(elementIndex == lastElementIndex) + arvadosFiles <- NULL + sapply(fileNames, function(fileName) { - branch = TreeNode$new(splitPath[[elementIndex]], lastElementInPathType) - } - else - { - newFolder = TreeNode$new(splitPath[[elementIndex]], "folder") - newFolder$addChild(branch) - branch = newFolder - } - - branch$relativePath <- paste(unlist(splitPath[1:elementIndex]), collapse = "/") - } + childWithSameName <- subcollection$get(fileName) + if(!is.null(childWithSameName)) + stop("Destination already contains file with same name.") - branch - }, + newFile <- ArvadosFile$new(fileName) + subcollection$add(newFile) - addNode = function(container, node) - { - child = container$getChild(node$name) + arvadosFiles <<- c(arvadosFiles, newFile) + }) - if(is.null(child)) - { - container$addChild(node) + if(length(arvadosFiles) == 1) + return(arvadosFiles[[1]]) + else + return(arvadosFiles) } - else + else { - private$addNode(child, node$getFirstChild()) + stop(paste0("Expected character vector, got ", + paste0("(", paste0(class(fileNames), collapse = ", "), ")"), + ".")) } }, - traverseInOrder = function(node, predicate) + remove = function(paths) { - if(node$hasChildren()) + if(is.null(private$tree)) + private$genereateCollectionTreeStructure() + + if(is.character(paths)) { - result <- predicate(node) + sapply(paths, function(filePath) + { + filePath <- trimFromEnd(filePath, "/") + file <- self$get(filePath) - if(!is.null(result)) - return(result) + if(is.null(file)) + stop(paste("File", filePath, "doesn't exist.")) - for(child in node$children) - { - result <- private$traverseInOrder(child, predicate) + parent <- file$getParent() + + if(is.null(parent)) + stop("You can't delete root folder.") - if(!is.null(result)) - return(result) - } + parent$remove(file$getName()) + }) - return(NULL) + "Content removed" } - else + else { - return(predicate(node)) + stop(paste0("Expected character vector, got ", + paste0("(", paste0(class(paths), collapse = ", "), ")"), + ".")) } - } + }, - ), + move = function(content, newLocation) + { + if(is.null(private$tree)) + private$genereateCollectionTreeStructure() - cloneable = FALSE -) + content <- trimFromEnd(content, "/") -TreeNode <- R6::R6Class( + elementToMove <- self$get(content) - "TreeNode", + if(is.null(elementToMove)) + stop("Content you want to move doesn't exist in the collection.") - public = list( - - name = NULL, - relativePath = NULL, - children = NULL, - parent = NULL, - type = NULL, + elementToMove$move(newLocation) + }, - initialize = function(name, type) + getFileListing = function() { - if(type == "folder") - name <- paste0(name, "/") + if(is.null(private$tree)) + private$genereateCollectionTreeStructure() - self$name <- name - self$type <- type - self$children <- list() + content <- private$REST$getCollectionContent(self$uuid) + content[order(tolower(content))] }, - addChild = function(node) + get = function(relativePath) { - self$children <- c(self$children, node) - node$setParent(self) - self - }, + if(is.null(private$tree)) + private$genereateCollectionTreeStructure() - setParent = function(parent) - { - self$parent = parent + private$tree$getElement(relativePath) }, - getChild = function(childName) + toJSON = function() { - for(child in self$children) - { - if(childName == child$name) - return(child) - } + fields <- sapply(private$classFields, function(field) + { + self[[field]] + }, USE.NAMES = TRUE) + + jsonlite::toJSON(list("collection" = + Filter(Negate(is.null), fields)), auto_unbox = TRUE) + }, + + isEmpty = function() { + fields <- sapply(private$classFields, + function(field) self[[field]]) + + if(any(sapply(fields, function(field) !is.null(field) && field != ""))) + FALSE + else + TRUE + }, + + getRESTService = function() private$REST, + setRESTService = function(newRESTService) private$REST <- newRESTService + ), - return(NULL) - }, + private = list( - hasChildren = function() - { - if(length(self$children) != 0) - return(TRUE) - else - return(FALSE) - }, + REST = NULL, + tree = NULL, + fileContent = NULL, + classFields = NULL, - getFirstChild = function() + genereateCollectionTreeStructure = function() { - if(!self$hasChildren()) - return(NULL) - else - return(self$children[[1]]) - }, + if(is.null(self$uuid)) + stop("Collection uuid is not defined.") - printContent = function(depth) - { - indentation <- paste(rep("....", depth), collapse = "") - print(paste0(indentation, self$name)) - - for(child in self$children) - child$printContent(depth + 1) + if(is.null(private$REST)) + stop("REST service is not defined.") + + private$fileContent <- private$REST$getCollectionContent(self$uuid) + private$tree <- CollectionTree$new(private$fileContent, self) } ), cloneable = FALSE ) + +#' print.Collection +#' +#' Custom print function for Collection class +#' +#' @param x Instance of Collection class +#' @param ... Optional arguments. +#' @export +print.Collection = function(x, ...) +{ + cat(paste0("Type: ", "\"", "Arvados Collection", "\""), sep = "\n") + cat(paste0("uuid: ", "\"", x$uuid, "\""), sep = "\n") +}