sdk/R/R/Subcollection.R

   1 #' Arvados SubCollection Object
   2 #'
   3 #' Update description
   4 #'
   5 #' @export Subcollection
   6 Subcollection <- R6::R6Class(
   7
   8     "Subcollection",
   9
  10     public = list(
  11
  12         initialize = function(name)
  13         {
  14             private$name       <- name
  15         },
  16
  17         getName = function() private$name,
  18
  19         getRelativePath = function()
  20         {
  21             relativePath <- c(private$name)
  22             parent <- private$parent
  23
  24             while(!is.null(parent))
  25             {
  26                 relativePath <- c(parent$getName(), relativePath)
  27                 parent <- parent$getParent()
  28             }
  29
  30             relativePath <- relativePath[relativePath != ""]
  31             paste0(relativePath, collapse = "/")
  32         },
  33
  34         add = function(content)
  35         {
  36             if("ArvadosFile"   %in% class(content) ||
  37                "Subcollection" %in% class(content))
  38             {
  39                 childWithSameName <- self$get(content$getName())
  40                 if(!is.null(childWithSameName))
  41                     stop(paste("Subcollection already contains ArvadosFile",
  42                                "or Subcollection with same name."))
  43
  44                 if(!is.null(private$collection))
  45                 {
  46                     if(self$getRelativePath() != "")
  47                         contentPath <- paste0(self$getRelativePath(),
  48                                               "/", content$getFileListing())
  49                     else
  50                         contentPath <- content$getFileListing()
  51
  52                     REST <- private$collection$getRESTService()
  53                     REST$create(contentPath, private$collection$uuid)
  54                     content$setCollection(private$collection)
  55                 }
  56
  57                 private$children <- c(private$children, content)
  58                 content$setParent(self)
  59
  60                 "Content added successfully."
  61             }
  62             else
  63             {
  64                 stop(paste0("Expected AravodsFile or Subcollection object, got ",
  65                             paste0("(", paste0(class(content), collapse = ", "), ")"),
  66                             "."))
  67             }
  68         },
  69
  70         remove = function(name)
  71         {
  72             if(is.character(name))
  73             {
  74                 child <- self$get(name)
  75
  76                 if(is.null(child))
  77                     stop(paste("Subcollection doesn't contains ArvadosFile",
  78                                "or Subcollection with specified name."))
  79
  80                 if(!is.null(private$collection))
  81                 {
  82                     REST <- private$collection$getRESTService()
  83                     REST$delete(child$getRelativePath(), private$collection$uuid)
  84                     child$setCollection(NULL)
  85                 }
  86
  87                 private$removeChild(name)
  88                 child$setParent(NULL)
  89
  90                 "Content removed"
  91             }
  92             else
  93             {
  94                 stop(paste0("Expected character, got ",
  95                             paste0("(", paste0(class(name), collapse = ", "), ")"),
  96                             "."))
  97             }
  98         },
  99
 100         getFileListing = function(fullPath = TRUE)
 101         {
 102             content <- NULL
 103
 104             if(fullPath)
 105             {
 106                 for(child in private$children)
 107                     content <- c(content, child$getFileListing())
 108
 109                 if(private$name != "")
 110                     content <- unlist(paste0(private$name, "/", content))
 111             }
 112             else
 113             {
 114                 for(child in private$children)
 115                     content <- c(content, child$getName())
 116             }
 117
 118             content
 119         },
 120
 121         getSizeInBytes = function()
 122         {
 123             if(!is.null(private$collection))
 124             {
 125                 REST <- private$collection$getRESTService()
 126                 subcollectionSize <- REST$getResourceSize(private$collection$uuid,
 127                                                           self$getRelativePath())
 128                 return(subcollectionSize)
 129             }
 130             else
 131             {
 132                 return(0)
 133             }
 134         },
 135
 136         move = function(newLocationInCollection)
 137         {
 138             if(is.null(private$collection))
 139                 stop("Subcollection doesn't belong to any collection")
 140
 141             newLocationInCollection <- trimFromEnd(newLocationInCollection, "/")
 142             newParentLocation <- trimFromEnd(newLocationInCollection, private$name)
 143
 144             newParent <- private$collection$get(newParentLocation)
 145
 146             if(is.null(newParent))
 147             {
 148                 stop("Unable to get destination subcollection")
 149             }
 150
 151             REST <- private$collection$getRESTService()
 152             REST$move(self$getRelativePath(),
 153                       paste0(newParent$getRelativePath(), "/", self$getName()),
 154                       private$collection$uuid)
 155
 156             private$dettachFromCurrentParent()
 157             private$attachToNewParent(newParent)
 158
 159             "Content moved successfully"
 160         },
 161
 162         get = function(name)
 163         {
 164             for(child in private$children)
 165             {
 166                 if(child$getName() == name)
 167                     return(child)
 168             }
 169
 170             return(NULL)
 171         },
 172
 173         getFirst = function()
 174         {
 175             if(length(private$children) == 0)
 176                return(NULL)
 177
 178             private$children[[1]]
 179         },
 180
 181         setCollection = function(collection, setRecursively = TRUE)
 182         {
 183             private$collection = collection
 184
 185             if(setRecursively)
 186             {
 187                 for(child in private$children)
 188                     child$setCollection(collection)
 189             }
 190         },
 191
 192         getCollection = function() private$collection,
 193
 194         getParent = function() private$parent,
 195
 196         setParent = function(newParent) private$parent <- newParent
 197     ),
 198
 199     private = list(
 200
 201         name       = NULL,
 202         children   = NULL,
 203         parent     = NULL,
 204         collection = NULL,
 205
 206         removeChild = function(name)
 207         {
 208             numberOfChildren = length(private$children)
 209             if(numberOfChildren > 0)
 210             {
 211                 for(childIndex in 1:numberOfChildren)
 212                 {
 213                     if(private$children[[childIndex]]$getName() == name)
 214                     {
 215                         private$children = private$children[-childIndex]
 216                         return()
 217                     }
 218                 }
 219             }
 220         },
 221
 222         attachToNewParent = function(newParent)
 223         {
 224             #Note: We temporary set parents collection to NULL. This will ensure that
 225             #      add method doesn't post file on REST.
 226             parentsCollection <- newParent$getCollection()
 227             newParent$setCollection(NULL, setRecursively = FALSE)
 228
 229             newParent$add(self)
 230
 231             newParent$setCollection(parentsCollection, setRecursively = FALSE)
 232
 233             private$parent <- newParent
 234         },
 235
 236         dettachFromCurrentParent = function()
 237         {
 238             #Note: We temporary set parents collection to NULL. This will ensure that
 239             #      remove method doesn't remove this subcollection from REST.
 240             parent <- private$parent
 241             parentsCollection <- parent$getCollection()
 242             parent$setCollection(NULL, setRecursively = FALSE)
 243
 244             parent$remove(private$name)
 245
 246             parent$setCollection(parentsCollection, setRecursively = FALSE)
 247         }
 248     ),
 249
 250     cloneable = FALSE
 251 )