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(content$getName() == "")
  83                     stop("Content has invalid name.")
  84
  85                 childWithSameName <- self$get(content$getName())
  86
  87                 if(!is.null(childWithSameName))
  88                     stop(paste("Subcollection already contains ArvadosFile",
  89                                "or Subcollection with same name."))
  90
  91                 if(!is.null(private$collection))
  92                 {
  93                     if(self$getRelativePath() != "")
  94                         contentPath <- paste0(self$getRelativePath(),
  95                                               "/", content$getFileListing())
  96                     else
  97                         contentPath <- content$getFileListing()
  98
  99                     REST <- private$collection$getRESTService()
 100                     REST$create(contentPath, private$collection$uuid)
 101                     content$setCollection(private$collection)
 102                 }
 103
 104                 private$children <- c(private$children, content)
 105                 content$setParent(self)
 106
 107                 "Content added successfully."
 108             }
 109             else
 110             {
 111                 stop(paste0("Expected AravodsFile or Subcollection object, got ",
 112                             paste0("(", paste0(class(content), collapse = ", "), ")"),
 113                             "."))
 114             }
 115         },
 116
 117         remove = function(name)
 118         {
 119             if(is.character(name))
 120             {
 121                 child <- self$get(name)
 122
 123                 if(is.null(child))
 124                     stop(paste("Subcollection doesn't contains ArvadosFile",
 125                                "or Subcollection with specified name."))
 126
 127                 if(!is.null(private$collection))
 128                 {
 129                     REST <- private$collection$getRESTService()
 130                     REST$delete(child$getRelativePath(), private$collection$uuid)
 131
 132                     child$setCollection(NULL)
 133                 }
 134
 135                 private$removeChild(name)
 136                 child$setParent(NULL)
 137
 138                 "Content removed"
 139             }
 140             else
 141             {
 142                 stop(paste0("Expected character, got ",
 143                             paste0("(", paste0(class(name), collapse = ", "), ")"),
 144                             "."))
 145             }
 146         },
 147
 148         getFileListing = function(fullPath = TRUE)
 149         {
 150             content <- private$getContentAsCharVector(fullPath)
 151             content[order(tolower(content))]
 152         },
 153
 154         getSizeInBytes = function()
 155         {
 156             if(is.null(private$collection))
 157                 return(0)
 158
 159             REST <- private$collection$getRESTService()
 160
 161             fileSizes <- REST$getResourceSize(paste0(self$getRelativePath(), "/"),
 162                                               private$collection$uuid)
 163             return(sum(fileSizes))
 164         },
 165
 166         move = function(destination)
 167         {
 168             if(is.null(private$collection))
 169                 stop("Subcollection doesn't belong to any collection.")
 170
 171             destination <- trimFromEnd(destination, "/")
 172             nameAndPath <- splitToPathAndName(destination)
 173
 174             newParent <- private$collection$get(nameAndPath$path)
 175
 176             if(is.null(newParent))
 177                 stop("Unable to get destination subcollection.")
 178
 179             childWithSameName <- newParent$get(nameAndPath$name)
 180
 181             if(!is.null(childWithSameName))
 182                 stop("Destination already contains content with same name.")
 183
 184             REST <- private$collection$getRESTService()
 185             REST$move(self$getRelativePath(),
 186                       paste0(newParent$getRelativePath(), "/", nameAndPath$name),
 187                       private$collection$uuid)
 188
 189             private$dettachFromCurrentParent()
 190             private$attachToNewParent(self, newParent)
 191
 192             private$parent <- newParent
 193             private$name <- nameAndPath$name
 194
 195             self
 196         },
 197
 198         copy = function(destination)
 199         {
 200             if(is.null(private$collection))
 201                 stop("Subcollection doesn't belong to any collection.")
 202
 203             destination <- trimFromEnd(destination, "/")
 204             nameAndPath <- splitToPathAndName(destination)
 205
 206             newParent <- private$collection$get(nameAndPath$path)
 207
 208             if(is.null(newParent) || !("Subcollection" %in% class(newParent)))
 209                 stop("Unable to get destination subcollection.")
 210
 211             childWithSameName <- newParent$get(nameAndPath$name)
 212
 213             if(!is.null(childWithSameName))
 214                 stop("Destination already contains content with same name.")
 215
 216             REST <- private$collection$getRESTService()
 217             REST$copy(self$getRelativePath(),
 218                       paste0(newParent$getRelativePath(), "/", nameAndPath$name),
 219                       private$collection$uuid)
 220
 221             newContent <- self$duplicate(nameAndPath$name)
 222             newContent$setCollection(self$getCollection(), setRecursively = TRUE)
 223             newContent$setParent(newParent)
 224             private$attachToNewParent(newContent, newParent)
 225
 226             newContent
 227         },
 228
 229         duplicate = function(newName = NULL)
 230         {
 231             name <- if(!is.null(newName)) newName else private$name
 232             root <- Subcollection$new(name)
 233             for(child in private$children)
 234                 root$add(child$duplicate())
 235
 236             root
 237         },
 238
 239         get = function(name)
 240         {
 241             for(child in private$children)
 242             {
 243                 if(child$getName() == name)
 244                     return(child)
 245             }
 246
 247             return(NULL)
 248         },
 249
 250         getFirst = function()
 251         {
 252             if(length(private$children) == 0)
 253                return(NULL)
 254
 255             private$children[[1]]
 256         },
 257
 258         setCollection = function(collection, setRecursively = TRUE)
 259         {
 260             private$collection = collection
 261
 262             if(setRecursively)
 263             {
 264                 for(child in private$children)
 265                     child$setCollection(collection)
 266             }
 267         },
 268
 269         getCollection = function() private$collection,
 270
 271         getParent = function() private$parent,
 272
 273         setParent = function(newParent) private$parent <- newParent
 274     ),
 275
 276     private = list(
 277
 278         name       = NULL,
 279         children   = NULL,
 280         parent     = NULL,
 281         collection = NULL,
 282
 283         removeChild = function(name)
 284         {
 285             numberOfChildren = length(private$children)
 286             if(numberOfChildren > 0)
 287             {
 288                 for(childIndex in 1:numberOfChildren)
 289                 {
 290                     if(private$children[[childIndex]]$getName() == name)
 291                     {
 292                         private$children = private$children[-childIndex]
 293                         return()
 294                     }
 295                 }
 296             }
 297         },
 298
 299         attachToNewParent = function(content, newParent)
 300         {
 301             #Note: We temporary set parents collection to NULL. This will ensure that
 302             #      add method doesn't post this file on REST.
 303             parentsCollection <- newParent$getCollection()
 304             newParent$setCollection(NULL, setRecursively = FALSE)
 305             newParent$add(content)
 306             newParent$setCollection(parentsCollection, setRecursively = FALSE)
 307         },
 308
 309         dettachFromCurrentParent = function()
 310         {
 311             #Note: We temporary set parents collection to NULL. This will ensure that
 312             #      remove method doesn't remove this subcollection from REST.
 313             parent <- private$parent
 314             parentsCollection <- parent$getCollection()
 315             parent$setCollection(NULL, setRecursively = FALSE)
 316             parent$remove(private$name)
 317             parent$setCollection(parentsCollection, setRecursively = FALSE)
 318         },
 319
 320         getContentAsCharVector = function(fullPath = TRUE)
 321         {
 322             content <- NULL
 323
 324             if(fullPath)
 325             {
 326                 for(child in private$children)
 327                     content <- c(content, child$getFileListing())
 328
 329                 if(private$name != "")
 330                     content <- unlist(paste0(private$name, "/", content))
 331             }
 332             else
 333             {
 334                 for(child in private$children)
 335                     content <- c(content, child$getName())
 336             }
 337
 338             content
 339         }
 340     ),
 341
 342     cloneable = FALSE
 343 )
 344
 345 #' print.Subcollection
 346 #'
 347 #' Custom print function for Subcollection class
 348 #'
 349 #' @param x Instance of Subcollection class
 350 #' @param ... Optional arguments.
 351 #' @export
 352 print.Subcollection = function(x, ...)
 353 {
 354     collection   <- NULL
 355     relativePath <- x$getRelativePath()
 356
 357     if(!is.null(x$getCollection()))
 358     {
 359         collection <- x$getCollection()$uuid
 360
 361         if(!x$getName() == "")
 362             relativePath <- paste0("/", relativePath)
 363     }
 364
 365     cat(paste0("Type:          ", "\"", "Arvados Subcollection", "\""), sep = "\n")
 366     cat(paste0("Name:          ", "\"", x$getName(),             "\""), sep = "\n")
 367     cat(paste0("Relative path: ", "\"", relativePath,            "\""), sep = "\n")
 368     cat(paste0("Collection:    ", "\"", collection,              "\""), sep = "\n")
 369 }