X-Git-Url: https://git.arvados.org/arvados.git/blobdiff_plain/be76fcdd9aa19fbf8982df2543685816a4afb1e0..74cffe96768727e8b727cdb54358729c91bec130:/sdk/R/R/Collection.R diff --git a/sdk/R/R/Collection.R b/sdk/R/R/Collection.R index cf2a612d87..f88eb0e7cd 100644 --- a/sdk/R/R/Collection.R +++ b/sdk/R/R/Collection.R @@ -1,113 +1,276 @@ -source("./R/Arvados.R") -source("./R/HttpParser.R") +# 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") -#' Collection Object -#' -#' @details -#' Todo: Update description #' Collection -#' -#' @param uuid Object ID -#' @param etag Object version -#' @param owner_uuid No description -#' @param created_at No description -#' @param modified_by_client_uuid No description -#' @param modified_by_user_uuid No description -#' @param modified_at No description -#' @param portable_data_hash No description -#' @param replication_desired No description -#' @param replication_confirmed_at No description -#' @param replication_confirmed No description -#' @param updated_at No description -#' @param manifest_text No description -#' @param name No description -#' @param description No description -#' @param properties No description -#' @param delete_at No description -#' @param file_names No description -#' @param trash_at No description -#' @param is_trashed No description -#' +#' +#' 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") +#' +#' 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 <- setRefClass( +Collection <- R6::R6Class( "Collection", - fields = list(uuid = "ANY", - items = "ANY", - etag = "ANY", - owner_uuid = "ANY", - created_at = "ANY", - modified_by_client_uuid = "ANY", - modified_by_user_uuid = "ANY", - modified_at = "ANY", - portable_data_hash = "ANY", - replication_desired = "ANY", - replication_confirmed_at = "ANY", - replication_confirmed = "ANY", - updated_at = "ANY", - manifest_text = "ANY", - name = "ANY", - description = "ANY", - properties = "ANY", - delete_at = "ANY", - file_names = "ANY", - trash_at = "ANY", - is_trashed = "ANY", - - getCollectionContent = "function" - ), + public = list( + + uuid = NULL, + + initialize = function(api, uuid) + { + private$REST <- api$getRESTService() + self$uuid <- uuid + }, + + add = function(content, relativePath = "") + { + if(is.null(private$tree)) + private$generateCollectionTreeStructure() + + if(relativePath == "" || + relativePath == "." || + relativePath == "./") + { + subcollection <- private$tree$getTree() + } + else + { + relativePath <- trimFromEnd(relativePath, "/") + subcollection <- self$get(relativePath) + } + + if(is.null(subcollection)) + stop(paste("Subcollection", relativePath, "doesn't exist.")) - methods = list( + if("ArvadosFile" %in% class(content) || + "Subcollection" %in% class(content)) + { + if(content$getName() == "") + stop("Content has invalid name.") + + subcollection$add(content) + content + } + else + { + stop(paste0("Expected AravodsFile or Subcollection object, got ", + paste0("(", paste0(class(content), collapse = ", "), ")"), + ".")) + } + }, + + create = function(fileNames, relativePath = "") + { + if(is.null(private$tree)) + private$generateCollectionTreeStructure() + + if(relativePath == "" || + relativePath == "." || + relativePath == "./") + { + subcollection <- private$tree$getTree() + } + else + { + relativePath <- trimFromEnd(relativePath, "/") + subcollection <- self$get(relativePath) + } + + if(is.null(subcollection)) + stop(paste("Subcollection", relativePath, "doesn't exist.")) + + 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.") + + 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 = ", "), ")"), + ".")) + } + }, - initialize = function(api, uuid) + remove = function(paths) { + if(is.null(private$tree)) + private$generateCollectionTreeStructure() - result <- api$collection_get(uuid) - - # Private members - uuid <<- result$uuid - etag <<- result$etag - owner_uuid <<- result$owner_uuid - created_at <<- result$created_at - modified_by_client_uuid <<- result$modified_by_client_uuid - modified_by_user_uuid <<- result$modified_by_user_uuid - modified_at <<- result$modified_at - portable_data_hash <<- result$portable_data_hash - replication_desired <<- result$replication_desired - replication_confirmed_at <<- result$replication_confirmed_at - replication_confirmed <<- result$replication_confirmed - updated_at <<- result$updated_at - manifest_text <<- result$manifest_text - name <<- result$name - description <<- result$description - properties <<- result$properties - delete_at <<- result$delete_at - file_names <<- result$file_names - trash_at <<- result$trash_at - is_trashed <<- result$is_trashed - - - #Public methods - - # Private methods - getCollectionContent <<- function() + if(is.character(paths)) { - #TODO(Fudo): Use proper URL here. - uri <- URLencode(api$getWebDavHostName()) + sapply(paths, function(filePath) + { + filePath <- trimFromEnd(filePath, "/") + file <- self$get(filePath) - # fetch directory listing via curl and parse XML response - h <- curl::new_handle() - curl::handle_setopt(h, customrequest = "PROPFIND") + if(is.null(file)) + stop(paste("File", filePath, "doesn't exist.")) - #TODO(Fudo): Use proper token here. - curl::handle_setheaders(h, "Authorization" = paste("OAuth2", api$getWebDavToken())) - response <- curl::curl_fetch_memory(uri, h) + parent <- file$getParent() - HttpParser()$parseWebDAVResponse(response, uri) + if(is.null(parent)) + stop("You can't delete root folder.") + + parent$remove(file$getName()) + }) + + "Content removed" } + else + { + stop(paste0("Expected character vector, got ", + paste0("(", paste0(class(paths), collapse = ", "), ")"), + ".")) + } + }, + + move = function(content, destination) + { + if(is.null(private$tree)) + private$generateCollectionTreeStructure() + + content <- trimFromEnd(content, "/") + + elementToMove <- self$get(content) + + if(is.null(elementToMove)) + stop("Content you want to move doesn't exist in the collection.") + + elementToMove$move(destination) + }, + + copy = function(content, destination) + { + if(is.null(private$tree)) + private$generateCollectionTreeStructure() + + content <- trimFromEnd(content, "/") + + elementToCopy <- self$get(content) + + if(is.null(elementToCopy)) + stop("Content you want to copy doesn't exist in the collection.") + + elementToCopy$copy(destination) + }, + + refresh = function() + { + private$tree$getTree()$setCollection(NULL, setRecursively = TRUE) + private$tree <- NULL + }, - items <<- getCollectionContent() + getFileListing = function() + { + if(is.null(private$tree)) + private$generateCollectionTreeStructure() + + content <- private$REST$getCollectionContent(self$uuid) + content[order(tolower(content))] + }, + + get = function(relativePath) + { + if(is.null(private$tree)) + private$generateCollectionTreeStructure() + + private$tree$getElement(relativePath) + }, + + getRESTService = function() private$REST, + setRESTService = function(newRESTService) private$REST <- newRESTService + ), + + private = list( + + REST = NULL, + tree = NULL, + fileContent = NULL, + + generateCollectionTreeStructure = 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") +}