X-Git-Url: https://git.arvados.org/arvados.git/blobdiff_plain/6c2355d82da1326a125ce7adcb8945a1d8efd671..74cffe96768727e8b727cdb54358729c91bec130:/sdk/R/R/Collection.R diff --git a/sdk/R/R/Collection.R b/sdk/R/R/Collection.R index fed222fdda..f88eb0e7cd 100644 --- a/sdk/R/R/Collection.R +++ b/sdk/R/R/Collection.R @@ -1,335 +1,276 @@ +# Copyright (C) The Arvados Authors. All rights reserved. +# +# SPDX-License-Identifier: Apache-2.0 + source("./R/Subcollection.R") source("./R/ArvadosFile.R") +source("./R/RESTService.R") +source("./R/util.R") -#' Arvados Collection Object +#' 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") #' -#' Update description +#' newFile <- ArvadosFile$new("myFile") +#' collection$add(newFile, "myFolder") #' -#' @examples arv = Collection$new(api, uuid) -#' @export Collection +#' createdFiles <- collection$create(c("main.cpp", lib.dll), "cpp/src/") +#' +#' collection$remove("location/to/my/file.cpp") +#' +#' collection$move("folder/file.cpp", "file.cpp") +#' +#' 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, - printFileContent = function(pretty = TRUE) + initialize = function(api, uuid) { - if(pretty) - private$fileTree$printContent(0) - else - print(private$fileItems) - + private$REST <- api$getRESTService() + self$uuid <- uuid }, - 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$generateCollectionTreeStructure() - 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( + if(is.null(subcollection)) + stop(paste("Subcollection", relativePath, "doesn't exist.")) - api = NULL, - fileItems = NULL, - fileTree = NULL, - - 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 - }, - - 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") + if(is.null(private$tree)) + private$generateCollectionTreeStructure() - #TODO(Fudo): Use proper token here. - curl::handle_setheaders(h, "Authorization" = paste("OAuth2", private$api$getToken())) - response <- curl::curl_fetch_memory(uri, h) - - 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) - { - branch = TreeNode$new(splitPath[[elementIndex]], lastElementInPathType) - } - else + arvadosFiles <- NULL + sapply(fileNames, function(fileName) { - newFolder = TreeNode$new(splitPath[[elementIndex]], "folder") - newFolder$addChild(branch) - branch = newFolder - } + childWithSameName <- subcollection$get(fileName) + if(!is.null(childWithSameName)) + stop("Destination already contains file with same name.") - branch$relativePath <- paste(unlist(splitPath[1:elementIndex]), collapse = "/") - } + newFile <- ArvadosFile$new(fileName) + subcollection$add(newFile) - branch - }, + arvadosFiles <<- c(arvadosFiles, newFile) + }) - addNode = function(container, node) - { - child = container$getChild(node$name) - - if(is.null(child)) - { - container$addChild(node) + if(length(arvadosFiles) == 1) + return(arvadosFiles[[1]]) + else + return(arvadosFiles) } 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$generateCollectionTreeStructure() + + 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 { - return(predicate(node)) + stop(paste0("Expected character vector, got ", + paste0("(", paste0(class(paths), collapse = ", "), ")"), + ".")) } - } - - ), + }, - cloneable = FALSE -) + move = function(content, destination) + { + if(is.null(private$tree)) + private$generateCollectionTreeStructure() -TreeNode <- R6::R6Class( + content <- trimFromEnd(content, "/") - "TreeNode", + elementToMove <- self$get(content) - public = list( + if(is.null(elementToMove)) + stop("Content you want to move doesn't exist in the collection.") - name = NULL, - relativePath = NULL, - children = NULL, - parent = NULL, - type = NULL, + elementToMove$move(destination) + }, - initialize = function(name, type) + copy = function(content, destination) { - if(type == "folder") - name <- paste0(name, "/") + if(is.null(private$tree)) + private$generateCollectionTreeStructure() - self$name <- name - self$type <- type - self$children <- list() - }, + content <- trimFromEnd(content, "/") - addChild = function(node) - { - self$children <- c(self$children, node) - node$setParent(self) - self + elementToCopy <- self$get(content) + + if(is.null(elementToCopy)) + stop("Content you want to copy doesn't exist in the collection.") + + elementToCopy$copy(destination) }, - setParent = function(parent) + refresh = function() { - self$parent = parent + private$tree$getTree()$setCollection(NULL, setRecursively = TRUE) + private$tree <- NULL }, - getChild = function(childName) + getFileListing = function() { - for(child in self$children) - { - if(childName == child$name) - return(child) - } + if(is.null(private$tree)) + private$generateCollectionTreeStructure() - return(NULL) + content <- private$REST$getCollectionContent(self$uuid) + content[order(tolower(content))] }, - hasChildren = function() + get = function(relativePath) { - if(length(self$children) != 0) - return(TRUE) - else - return(FALSE) - }, + if(is.null(private$tree)) + private$generateCollectionTreeStructure() - getFirstChild = function() - { - if(!self$hasChildren()) - return(NULL) - else - return(self$children[[1]]) + private$tree$getElement(relativePath) }, - printContent = function(depth) + getRESTService = function() private$REST, + setRESTService = function(newRESTService) private$REST <- newRESTService + ), + + private = list( + + REST = NULL, + tree = NULL, + fileContent = NULL, + + generateCollectionTreeStructure = function() { - indentation <- paste(rep("....", depth), collapse = "") - print(paste0(indentation, self$name)) - - for(child in self$children) - child$printContent(depth + 1) + if(is.null(self$uuid)) + stop("Collection uuid is not defined.") + + 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") +}