X-Git-Url: https://git.arvados.org/arvados.git/blobdiff_plain/f67c59f3fea793ed3ccea7f5a8106014ec2dc108..3e1c43866e5b523c3f1d273c25942ad56dc66d3f:/sdk/R/R/Collection.R diff --git a/sdk/R/R/Collection.R b/sdk/R/R/Collection.R index c29f8f0055..fad452ac7a 100644 --- a/sdk/R/R/Collection.R +++ b/sdk/R/R/Collection.R @@ -1,179 +1,279 @@ source("./R/Subcollection.R") source("./R/ArvadosFile.R") -source("./R/FileTree.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)} #' -#' Update description +#' @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.} +#' } #' -#' @examples arv = Collection$new(api, uuid) -#' @export Collection +#' @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") +#' +#' 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 - - private$fileItems <- private$getCollectionContent() - - private$fileTree <- FileTree$new(private$fileItems) - }, + uuid = NULL, + # api = NULL, - printFileContent = function() + initialize = function(api, uuid) { - private$fileTree$printContent(private$fileTree$getRoot(), 0) - }, + # self$api <- api + private$REST <- api$getRESTService() - getFileContent = function() - { - sapply(private$fileItems, function(file) - { - file$name - }) + 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$fileTree$traverseInOrder(private$fileTree$getRoot(), function(node) + if(is.null(private$tree)) + private$genereateCollectionTreeStructure() + + if(relativePath == "" || + relativePath == "." || + relativePath == "./") { - if(node$relativePath == relativePath) - return(node) - else - return(NULL) - }) + subcollection <- private$tree$getTree() + } + else + { + relativePath <- trimFromEnd(relativePath, "/") + subcollection <- self$get(relativePath) + } - if(!is.null(treeNode)) + if(is.null(subcollection)) + stop(paste("Subcollection", relativePath, "doesn't exist.")) + + if("ArvadosFile" %in% class(content) || + "Subcollection" %in% class(content)) { - return(private$createSubcollectionTree(treeNode)) + if(content$getName() == "") + stop("Content has invalid name.") + + subcollection$add(content) + content } else { - return(NULL) + stop(paste0("Expected AravodsFile or Subcollection object, got ", + paste0("(", paste0(class(content), collapse = ", "), ")"), + ".")) } }, - update = function(subcollection, event) + create = function(fileNames, relativePath = "") { - #Todo(Fudo): Add some king of check here later on. - if(event == "File size changed") + if(is.null(private$tree)) + private$genereateCollectionTreeStructure() + + if(relativePath == "" || + relativePath == "." || + relativePath == "./") { - private$handleFileSizeChange(subcollection$getRelativePath(), - subcollection$getSizeInBytes()) + subcollection <- private$tree$getTree() } - } - ), - - active = list( - items = function(value) - { - if(missing(value)) - return(private$fileItems) else - print("Value is read-only.") + { + relativePath <- trimFromEnd(relativePath, "/") + subcollection <- self$get(relativePath) + } - return(NULL) - } - ), - - private = list( + if(is.null(subcollection)) + stop(paste("Subcollection", relativePath, "doesn't exist.")) - fileItems = NULL, - api = NULL, - fileTree = NULL, + if(is.character(fileNames)) + { + arvadosFiles <- NULL + sapply(fileNames, function(fileName) + { + childWithSameName <- subcollection$get(fileName) + if(!is.null(childWithSameName)) + stop("Destination already contains file with same name.") - handleFileSizeChange = function(filePath, newSize) - { - node <- private$fileTree$getNode(filePath) - node$size <- newSize + newFile <- ArvadosFile$new(fileName) + subcollection$add(newFile) + + arvadosFiles <<- c(arvadosFiles, newFile) + }) + + if(length(arvadosFiles) == 1) + return(arvadosFiles[[1]]) + else + return(arvadosFiles) + } + else + { + stop(paste0("Expected character vector, got ", + paste0("(", paste0(class(fileNames), collapse = ", "), ")"), + ".")) + } }, - createSubcollectionTree = function(treeNode) + remove = function(paths) { - if(treeNode$hasChildren()) - { - children = NULL + if(is.null(private$tree)) + private$genereateCollectionTreeStructure() - for(child in treeNode$children) + if(is.character(paths)) + { + sapply(paths, function(filePath) { - child <- private$createSubcollectionTree(child) - children <- c(children, child) - } + filePath <- trimFromEnd(filePath, "/") + file <- self$get(filePath) + + if(is.null(file)) + stop(paste("File", filePath, "doesn't exist.")) - return(Subcollection$new(treeNode$name, treeNode$relativePath, children)) + parent <- file$getParent() + + if(is.null(parent)) + stop("You can't delete root folder.") + + parent$remove(file$getName()) + }) + + "Content removed" } - else + else { - if(treeNode$type == "file") - return(ArvadosFile$new(treeNode$name, treeNode$relativePath, treeNode$size, private$api, self)) - else - return(Subcollection$new(treeNode$name, treeNode$relativePath, NULL)) + stop(paste0("Expected character vector, got ", + paste0("(", paste0(class(paths), collapse = ", "), ")"), + ".")) } }, - getCollectionContent = function() + move = function(content, newLocation) { - uri <- URLencode(paste0(private$api$getWebDavHostName(), "c=", self$uuid)) + if(is.null(private$tree)) + private$genereateCollectionTreeStructure() - # fetch directory listing via curl and parse XML response - h <- curl::new_handle() - curl::handle_setopt(h, customrequest = "PROPFIND") + content <- trimFromEnd(content, "/") - curl::handle_setheaders(h, "Authorization" = paste("OAuth2", private$api$getToken())) - response <- curl::curl_fetch_memory(uri, h) + elementToMove <- self$get(content) - parsedResponse <- HttpParser$new()$parseWebDAVResponse(response, uri) - parsedResponse[-1] - } + if(is.null(elementToMove)) + stop("Content you want to move doesn't exist in the collection.") + + elementToMove$move(newLocation) + }, + + getFileListing = function() + { + if(is.null(private$tree)) + private$genereateCollectionTreeStructure() + + content <- private$REST$getCollectionContent(self$uuid) + content[order(tolower(content))] + }, + + get = function(relativePath) + { + if(is.null(private$tree)) + private$genereateCollectionTreeStructure() + private$tree$getElement(relativePath) + }, + + toJSON = function() + { + 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 + ), + + private = list( + + REST = NULL, + tree = NULL, + fileContent = NULL, + classFields = NULL, + + genereateCollectionTreeStructure = function() + { + 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") +}