sdk/R/R/Subcollection.R

   1 # Copyright (C) The Arvados Authors. All rights reserved.
   2 #
   3 # SPDX-License-Identifier: Apache-2.0
   4
   5 source("./R/util.R")
   6
   7 #' Subcollection
   8 #'
   9 #' Subcollection class represents a folder inside Arvados collection.
  10 #' It is essentially a composite of arvadosFiles and other subcollections.
  11 #'
  12 #' @section Usage:
  13 #' \preformatted{subcollection = Subcollection$new(name)}
  14 #'
  15 #' @section Arguments:
  16 #' \describe{
  17 #'   \item{name}{Name of the subcollection.}
  18 #' }
  19 #'
  20 #' @section Methods:
  21 #' \describe{
  22 #'   \item{getName()}{Returns name of the subcollection.}
  23 #'   \item{getRelativePath()}{Returns subcollection path relative to the root.}
  24 #'   \item{add(content)}{Adds ArvadosFile or Subcollection specified by content to the subcollection.}
  25 #'   \item{remove(name)}{Removes ArvadosFile or Subcollection specified by name from the subcollection.}
  26 #'   \item{get(relativePath)}{If relativePath is valid, returns ArvadosFile or Subcollection specified by relativePath, else returns NULL.}
  27 #'   \item{getFileListing()}{Returns subcollections file content as character vector.}
  28 #'   \item{getSizeInBytes()}{Returns subcollections content size in bytes.}
  29 #'   \item{move(destination)}{Moves subcollection to a new location inside collection.}
  30 #'   \item{copy(destination)}{Copies subcollection to a new location inside collection.}
  31 #' }
  32 #'
  33 #' @name Subcollection
  34 #' @examples
  35 #' \dontrun{
  36 #' myFolder <- Subcollection$new("myFolder")
  37 #' myFile   <- ArvadosFile$new("myFile")
  38 #'
  39 #' myFolder$add(myFile)
  40 #' myFolder$get("myFile")
  41 #' myFolder$remove("myFile")
  42 #'
  43 #' myFolder$move("newLocation/myFolder")
  44 #' myFolder$copy("newLocation/myFolder")
  45 #' }
  46 NULL
  47
  48 #' @export
  49 Subcollection <- R6::R6Class(
  50
  51     "Subcollection",
  52
  53     public = list(
  54
  55         initialize = function(name)
  56         {
  57             private$name <- name
  58         },
  59
  60         getName = function() private$name,
  61
  62         getRelativePath = function()
  63         {
  64             relativePath <- c(private$name)
  65             parent <- private$parent
  66
  67             while(!is.null(parent))
  68             {
  69                 relativePath <- c(parent$getName(), relativePath)
  70                 parent <- parent$getParent()
  71             }
  72
  73             relativePath <- relativePath[relativePath != ""]
  74             paste0(relativePath, collapse = "/")
  75         },
  76
  77         add = function(content)
  78         {
  79             if("ArvadosFile"   %in% class(content) ||
  80                "Subcollection" %in% class(content))
  81             {
  82                 if(!is.null(content$getCollection()))
  83                     stop("Content already belongs to a collection.")
  84
  85                 if(content$getName() == "")
  86                     stop("Content has invalid name.")
  87
  88                 childWithSameName <- self$get(content$getName())
  89
  90                 if(!is.null(childWithSameName))
  91                     stop(paste("Subcollection already contains ArvadosFile",
  92                                "or Subcollection with same name."))
  93
  94                 if(!is.null(private$collection))
  95                 {
  96                     if(self$getRelativePath() != "")
  97                         contentPath <- paste0(self$getRelativePath(),
  98                                               "/", content$getFileListing())
  99                     else
 100                         contentPath <- content$getFileListing()
 101
 102                     REST <- private$collection$getRESTService()
 103                     REST$create(contentPath, private$collection$uuid)
 104                     content$setCollection(private$collection)
 105                 }
 106
 107                 private$children <- c(private$children, content)
 108                 content$setParent(self)
 109
 110                 "Content added successfully."
 111             }
 112             else
 113             {
 114                 stop(paste0("Expected AravodsFile or Subcollection object, got ",
 115                             paste0("(", paste0(class(content), collapse = ", "), ")"),
 116                             "."))
 117             }
 118         },
 119
 120         remove = function(name)
 121         {
 122             if(is.character(name))
 123             {
 124                 child <- self$get(name)
 125
 126                 if(is.null(child))
 127                     stop(paste("Subcollection doesn't contains ArvadosFile",
 128                                "or Subcollection with specified name."))
 129
 130                 if(!is.null(private$collection))
 131                 {
 132                     REST <- private$collection$getRESTService()
 133                     REST$delete(child$getRelativePath(), private$collection$uuid)
 134
 135                     child$setCollection(NULL)
 136                 }
 137
 138                 private$removeChild(name)
 139                 child$setParent(NULL)
 140
 141                 "Content removed"
 142             }
 143             else
 144             {
 145                 stop(paste0("Expected character, got ",
 146                             paste0("(", paste0(class(name), collapse = ", "), ")"),
 147                             "."))
 148             }
 149         },
 150
 151         getFileListing = function(fullPath = TRUE)
 152         {
 153             content <- private$getContentAsCharVector(fullPath)
 154             content[order(tolower(content))]
 155         },
 156
 157         getSizeInBytes = function()
 158         {
 159             if(is.null(private$collection))
 160                 return(0)
 161
 162             REST <- private$collection$getRESTService()
 163
 164             fileSizes <- REST$getResourceSize(paste0(self$getRelativePath(), "/"),
 165                                               private$collection$uuid)
 166             return(sum(fileSizes))
 167         },
 168
 169         move = function(destination)
 170         {
 171             if(is.null(private$collection))
 172                 stop("Subcollection doesn't belong to any collection.")
 173
 174             destination <- trimFromEnd(destination, "/")
 175             nameAndPath <- splitToPathAndName(destination)
 176
 177             newParent <- private$collection$get(nameAndPath$path)
 178
 179             if(is.null(newParent))
 180                 stop("Unable to get destination subcollection.")
 181
 182             childWithSameName <- newParent$get(nameAndPath$name)
 183
 184             if(!is.null(childWithSameName))
 185                 stop("Destination already contains content with same name.")
 186
 187             REST <- private$collection$getRESTService()
 188             REST$move(self$getRelativePath(),
 189                       paste0(newParent$getRelativePath(), "/", nameAndPath$name),
 190                       private$collection$uuid)
 191
 192             private$dettachFromCurrentParent()
 193             private$attachToNewParent(self, newParent)
 194
 195             private$parent <- newParent
 196             private$name <- nameAndPath$name
 197
 198             self
 199         },
 200
 201         copy = function(destination)
 202         {
 203             if(is.null(private$collection))
 204                 stop("Subcollection doesn't belong to any collection.")
 205
 206             destination <- trimFromEnd(destination, "/")
 207             nameAndPath <- splitToPathAndName(destination)
 208
 209             newParent <- private$collection$get(nameAndPath$path)
 210
 211             if(is.null(newParent) || !("Subcollection" %in% class(newParent)))
 212                 stop("Unable to get destination subcollection.")
 213
 214             childWithSameName <- newParent$get(nameAndPath$name)
 215
 216             if(!is.null(childWithSameName))
 217                 stop("Destination already contains content with same name.")
 218
 219             REST <- private$collection$getRESTService()
 220             REST$copy(self$getRelativePath(),
 221                       paste0(newParent$getRelativePath(), "/", nameAndPath$name),
 222                       private$collection$uuid)
 223
 224             newContent <- self$duplicate(nameAndPath$name)
 225             newContent$setCollection(self$getCollection(), setRecursively = TRUE)
 226             newContent$setParent(newParent)
 227             private$attachToNewParent(newContent, newParent)
 228
 229             newContent
 230         },
 231
 232         duplicate = function(newName = NULL)
 233         {
 234             name <- if(!is.null(newName)) newName else private$name
 235             root <- Subcollection$new(name)
 236             for(child in private$children)
 237                 root$add(child$duplicate())
 238
 239             root
 240         },
 241
 242         get = function(name)
 243         {
 244             for(child in private$children)
 245             {
 246                 if(child$getName() == name)
 247                     return(child)
 248             }
 249
 250             return(NULL)
 251         },
 252
 253         getFirst = function()
 254         {
 255             if(length(private$children) == 0)
 256                return(NULL)
 257
 258             private$children[[1]]
 259         },
 260
 261         setCollection = function(collection, setRecursively = TRUE)
 262         {
 263             private$collection = collection
 264
 265             if(setRecursively)
 266             {
 267                 for(child in private$children)
 268                     child$setCollection(collection)
 269             }
 270         },
 271
 272         getCollection = function() private$collection,
 273
 274         getParent = function() private$parent,
 275
 276         setParent = function(newParent) private$parent <- newParent
 277     ),
 278
 279     private = list(
 280
 281         name       = NULL,
 282         children   = NULL,
 283         parent     = NULL,
 284         collection = NULL,
 285
 286         removeChild = function(name)
 287         {
 288             numberOfChildren = length(private$children)
 289             if(numberOfChildren > 0)
 290             {
 291                 for(childIndex in 1:numberOfChildren)
 292                 {
 293                     if(private$children[[childIndex]]$getName() == name)
 294                     {
 295                         private$children = private$children[-childIndex]
 296                         return()
 297                     }
 298                 }
 299             }
 300         },
 301
 302         attachToNewParent = function(content, newParent)
 303         {
 304             # We temporary set parents collection to NULL. This will ensure that
 305             # add method doesn't post this subcollection to REST.
 306             # We also need to set content's collection to NULL because
 307             # add method throws exception if we try to add content that already
 308             # belongs to a collection.
 309             parentsCollection <- newParent$getCollection()
 310             content$setCollection(NULL, setRecursively = FALSE)
 311             newParent$setCollection(NULL, setRecursively = FALSE)
 312             newParent$add(content)
 313             content$setCollection(parentsCollection, setRecursively = FALSE)
 314             newParent$setCollection(parentsCollection, setRecursively = FALSE)
 315         },
 316
 317         dettachFromCurrentParent = function()
 318         {
 319             # We temporary set parents collection to NULL. This will ensure that
 320             # remove method doesn't remove this subcollection from REST.
 321             parent <- private$parent
 322             parentsCollection <- parent$getCollection()
 323             parent$setCollection(NULL, setRecursively = FALSE)
 324             parent$remove(private$name)
 325             parent$setCollection(parentsCollection, setRecursively = FALSE)
 326         },
 327
 328         getContentAsCharVector = function(fullPath = TRUE)
 329         {
 330             content <- NULL
 331
 332             if(fullPath)
 333             {
 334                 for(child in private$children)
 335                     content <- c(content, child$getFileListing())
 336
 337                 if(private$name != "")
 338                     content <- unlist(paste0(private$name, "/", content))
 339             }
 340             else
 341             {
 342                 for(child in private$children)
 343                     content <- c(content, child$getName())
 344             }
 345
 346             content
 347         }
 348     ),
 349
 350     cloneable = FALSE
 351 )
 352
 353 #' print.Subcollection
 354 #'
 355 #' Custom print function for Subcollection class
 356 #'
 357 #' @param x Instance of Subcollection class
 358 #' @param ... Optional arguments.
 359 #' @export
 360 print.Subcollection = function(x, ...)
 361 {
 362     collection   <- NULL
 363     relativePath <- x$getRelativePath()
 364
 365     if(!is.null(x$getCollection()))
 366     {
 367         collection <- x$getCollection()$uuid
 368
 369         if(!x$getName() == "")
 370             relativePath <- paste0("/", relativePath)
 371     }
 372
 373     cat(paste0("Type:          ", "\"", "Arvados Subcollection", "\""), sep = "\n")
 374     cat(paste0("Name:          ", "\"", x$getName(),             "\""), sep = "\n")
 375     cat(paste0("Relative path: ", "\"", relativePath,            "\""), sep = "\n")
 376     cat(paste0("Collection:    ", "\"", collection,              "\""), sep = "\n")
 377 }