sdk/R/R/Subcollection.R

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