X-Git-Url: https://git.arvados.org/arvados.git/blobdiff_plain/074f020c32c55c017433ac5a294a5e0b73b360ad..c856e47c2a25dc6979ea07f2c3942687687c833a:/sdk/R/R/Subcollection.R diff --git a/sdk/R/R/Subcollection.R b/sdk/R/R/Subcollection.R index a1fba1a4ad..60714a4ad8 100644 --- a/sdk/R/R/Subcollection.R +++ b/sdk/R/R/Subcollection.R @@ -1,8 +1,49 @@ -#' Arvados SubCollection Object +# Copyright (C) The Arvados Authors. All rights reserved. +# +# SPDX-License-Identifier: Apache-2.0 + +source("./R/util.R") + +#' Subcollection +#' +#' Subcollection class represents a folder inside Arvados collection. +#' It is essentially a composite of arvadosFiles and other subcollections. +#' +#' @section Usage: +#' \preformatted{subcollection = Subcollection$new(name)} #' -#' Update description +#' @section Arguments: +#' \describe{ +#' \item{name}{Name of the subcollection.} +#' } +#' +#' @section Methods: +#' \describe{ +#' \item{getName()}{Returns name of the subcollection.} +#' \item{getRelativePath()}{Returns subcollection path relative to the root.} +#' \item{add(content)}{Adds ArvadosFile or Subcollection specified by content to the subcollection.} +#' \item{remove(name)}{Removes ArvadosFile or Subcollection specified by name from the subcollection.} +#' \item{get(relativePath)}{If relativePath is valid, returns ArvadosFile or Subcollection specified by relativePath, else returns NULL.} +#' \item{getFileListing()}{Returns subcollections file content as character vector.} +#' \item{getSizeInBytes()}{Returns subcollections content size in bytes.} +#' \item{move(newLocation)}{Moves subcollection to a new location inside collection.} +#' } #' -#' @export Subcollection +#' @name Subcollection +#' @examples +#' \dontrun{ +#' myFolder <- Subcollection$new("myFolder") +#' myFile <- ArvadosFile$new("myFile") +#' +#' myFolder$add(myFile) +#' myFolder$get("myFile") +#' myFolder$remove("myFile") +#' +#' myFolder$move("newLocation/myFolder") +#' } +NULL + +#' @export Subcollection <- R6::R6Class( "Subcollection", @@ -11,149 +52,149 @@ Subcollection <- R6::R6Class( initialize = function(name) { - private$name <- name - private$http <- HttpRequest$new() - private$httpParser <- HttpParser$new() + private$name <- name }, + + getName = function() private$name, + getRelativePath = function() + { + relativePath <- c(private$name) + parent <- private$parent + + while(!is.null(parent)) + { + relativePath <- c(parent$getName(), relativePath) + parent <- parent$getParent() + } + + relativePath <- relativePath[relativePath != ""] + paste0(relativePath, collapse = "/") + }, + add = function(content) { if("ArvadosFile" %in% class(content) || "Subcollection" %in% class(content)) { - if(!is.null(content$.__enclos_env__$private$collection)) - stop("ArvadosFile/Subcollection already belongs to a collection.") + if(content$getName() == "") + stop("Content has invalid name.") + + childWithSameName <- self$get(content$getName()) + + if(!is.null(childWithSameName)) + stop(paste("Subcollection already contains ArvadosFile", + "or Subcollection with same name.")) if(!is.null(private$collection)) { - contentPath <- paste0(self$getRelativePath(), "/", content$getFileList()) - private$collection$.__enclos_env__$private$createFilesOnREST(contentPath) - content$.__enclos_env__$private$addToCollection(private$collection) + if(self$getRelativePath() != "") + contentPath <- paste0(self$getRelativePath(), + "/", content$getFileListing()) + else + contentPath <- content$getFileListing() + + REST <- private$collection$getRESTService() + REST$create(contentPath, private$collection$uuid) + content$setCollection(private$collection) } private$children <- c(private$children, content) - content$.__enclos_env__$private$parent = self + content$setParent(self) + + "Content added successfully." } else { - stop("Expected AravodsFile or Subcollection object, got ...") + stop(paste0("Expected AravodsFile or Subcollection object, got ", + paste0("(", paste0(class(content), collapse = ", "), ")"), + ".")) } }, - removeFromCollection = function() + remove = function(name) { - if(is.null(private$collection)) - stop("Subcollection doesn't belong to any collection.") - - if(self$name == "") - stop("Unable to delete root folder.") - - collectionList <- paste0(self$getRelativePath(), "/", self$getFileList(fullpath = FALSE)) - sapply(collectionList, function(file) + if(is.character(name)) { - private$collection$.__enclos_env__$private$deleteFromREST(file) - }) + child <- self$get(name) - private$addToCollection(NULL) - private$dettachFromParent() - }, + if(is.null(child)) + stop(paste("Subcollection doesn't contains ArvadosFile", + "or Subcollection with specified name.")) - getFileList = function(fullpath = TRUE) - { - content <- NULL + if(!is.null(private$collection)) + { + REST <- private$collection$getRESTService() + REST$delete(child$getRelativePath(), private$collection$uuid) - if(fullpath) - { - for(child in private$children) - content <- c(content, child$getFileList()) + child$setCollection(NULL) + } - if(private$name != "") - content <- unlist(paste0(private$name, "/", content)) + private$removeChild(name) + child$setParent(NULL) + + "Content removed" } else { - for(child in private$children) - content <- c(content, child$getName()) + stop(paste0("Expected character, got ", + paste0("(", paste0(class(name), collapse = ", "), ")"), + ".")) } - - content }, - getSizeInBytes = function() + getFileListing = function(fullPath = TRUE) { - collectionURL <- URLencode(paste0(private$collection$api$getWebDavHostName(), "c=", private$collection$uuid)) - subcollectionURL <- paste0(collectionURL, "/", self$getRelativePath(), "/"); - - headers = list("Authorization" = paste("OAuth2", private$collection$api$getToken())) - - propfindResponse <- private$http$PROPFIND(subcollectionURL, headers) - - sizes <- private$httpParser$extractFileSizeFromWebDAVResponse(propfindResponse, collectionURL) - sizes <- as.numeric(sizes[-1]) - - sum(sizes) + content <- private$getContentAsCharVector(fullPath) + content[order(tolower(content))] }, - getName = function() private$name, - - getRelativePath = function() + getSizeInBytes = function() { - relativePath <- c(private$name) - parent <- private$parent + if(is.null(private$collection)) + return(0) - #Recurse back to root - while(!is.null(parent)) - { - relativePath <- c(parent$getName(), relativePath) - parent <- parent$getParent() - } + REST <- private$collection$getRESTService() - relativePath <- relativePath[relativePath != ""] - paste0(relativePath, collapse = "/") + fileSizes <- REST$getResourceSize(paste0(self$getRelativePath(), "/"), + private$collection$uuid) + return(sum(fileSizes)) }, move = function(newLocation) { - if(endsWith(newLocation, paste0(private$name, "/"))) - { - newLocation <- substr(newLocation, 0, nchar(newLocation) - nchar(paste0(private$name, "/"))) - } - else if(endsWith(newLocation, private$name)) - { - newLocation <- substr(newLocation, 0, nchar(newLocation) - nchar(private$name)) - } - else - { - stop("Destination path is not valid.") - } + if(is.null(private$collection)) + stop("Subcollection doesn't belong to any collection") + + newLocation <- trimFromEnd(newLocation, "/") + nameAndPath <- splitToPathAndName(newLocation) - newParent <- private$collection$get(newLocation) + newParent <- private$collection$get(nameAndPath$path) if(is.null(newParent)) { - stop("Unable to get destination subcollectin") + stop("Unable to get destination subcollection") } - status <- private$collection$.__enclos_env__$private$moveOnRest(self$getRelativePath(), paste0(newParent$getRelativePath(), "/", self$getName())) + childWithSameName <- newParent$get(nameAndPath$name) - private$attachToParent(newParent) + if(!is.null(childWithSameName)) + stop("Destination already contains content with same name.") - paste("Status code :", status$status_code) - }, + REST <- private$collection$getRESTService() + REST$move(self$getRelativePath(), + paste0(newParent$getRelativePath(), "/", nameAndPath$name), + private$collection$uuid) - getParent = function() private$parent - ), + private$dettachFromCurrentParent() + private$attachToNewParent(newParent) - private = list( + private$name <- nameAndPath$name - name = NULL, - children = NULL, - parent = NULL, - collection = NULL, - http = NULL, - httpParser = NULL, + "Content moved successfully." + }, - getChild = function(name) + get = function(name) { for(child in private$children) { @@ -164,7 +205,7 @@ Subcollection <- R6::R6Class( return(NULL) }, - getFirstChild = function() + getFirst = function() { if(length(private$children) == 0) return(NULL) @@ -172,6 +213,31 @@ Subcollection <- R6::R6Class( private$children[[1]] }, + setCollection = function(collection, setRecursively = TRUE) + { + private$collection = collection + + if(setRecursively) + { + for(child in private$children) + child$setCollection(collection) + } + }, + + getCollection = function() private$collection, + + getParent = function() private$parent, + + setParent = function(newParent) private$parent <- newParent + ), + + private = list( + + name = NULL, + children = NULL, + parent = NULL, + collection = NULL, + removeChild = function(name) { numberOfChildren = length(private$children) @@ -188,31 +254,80 @@ Subcollection <- R6::R6Class( } }, - addToCollection = function(collection) + attachToNewParent = function(newParent) { - for(child in private$children) - child$.__enclos_env__$private$addToCollection(collection) + #Note: We temporary set parents collection to NULL. This will ensure that + # add method doesn't post file on REST. + parentsCollection <- newParent$getCollection() + newParent$setCollection(NULL, setRecursively = FALSE) - private$collection = collection + newParent$add(self) + + newParent$setCollection(parentsCollection, setRecursively = FALSE) + + private$parent <- newParent }, - dettachFromParent = function() + dettachFromCurrentParent = function() { - if(!is.null(private$parent)) + #Note: We temporary set parents collection to NULL. This will ensure that + # remove method doesn't remove this subcollection from REST. + parent <- private$parent + parentsCollection <- parent$getCollection() + parent$setCollection(NULL, setRecursively = FALSE) + + parent$remove(private$name) + + parent$setCollection(parentsCollection, setRecursively = FALSE) + }, + + getContentAsCharVector = function(fullPath = TRUE) + { + content <- NULL + + if(fullPath) { - private$parent$.__enclos_env__$private$removeChild(private$name) - private$parent <- NULL + for(child in private$children) + content <- c(content, child$getFileListing()) + + if(private$name != "") + content <- unlist(paste0(private$name, "/", content)) } else - stop("Parent doesn't exists.") - }, + { + for(child in private$children) + content <- c(content, child$getName()) + } - attachToParent = function(parent) - { - parent$.__enclos_env__$private$children <- c(parent$.__enclos_env__$private$children, self) - private$parent <- parent + content } ), cloneable = FALSE ) + +#' print.Subcollection +#' +#' Custom print function for Subcollection class +#' +#' @param x Instance of Subcollection class +#' @param ... Optional arguments. +#' @export +print.Subcollection = function(x, ...) +{ + collection <- NULL + relativePath <- x$getRelativePath() + + if(!is.null(x$getCollection())) + { + collection <- x$getCollection()$uuid + + if(!x$getName() == "") + relativePath <- paste0("/", relativePath) + } + + cat(paste0("Type: ", "\"", "Arvados Subcollection", "\""), sep = "\n") + cat(paste0("Name: ", "\"", x$getName(), "\""), sep = "\n") + cat(paste0("Relative path: ", "\"", relativePath, "\""), sep = "\n") + cat(paste0("Collection: ", "\"", collection, "\""), sep = "\n") +}