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