sdk/R/R/Collection.R

   1 source("./R/Subcollection.R")
   2 source("./R/ArvadosFile.R")
   3
   4 #' Arvados Collection Object
   5 #'
   6 #' Update description
   7 #'
   8 #' @examples arv = Collection$new(api, uuid)
   9 #' @export Collection
  10 Collection <- R6::R6Class(
  11
  12     "Collection",
  13
  14     public = list(
  15
  16         #Todo(Fudo): Encapsulate this?
  17         uuid                     = NULL,
  18         etag                     = NULL,
  19         owner_uuid               = NULL,
  20         created_at               = NULL,
  21         modified_by_client_uuid  = NULL,
  22         modified_by_user_uuid    = NULL,
  23         modified_at              = NULL,
  24         portable_data_hash       = NULL,
  25         replication_desired      = NULL,
  26         replication_confirmed_at = NULL,
  27         replication_confirmed    = NULL,
  28         updated_at               = NULL,
  29         manifest_text            = NULL,
  30         name                     = NULL,
  31         description              = NULL,
  32         properties               = NULL,
  33         delete_at                = NULL,
  34         file_names               = NULL,
  35         trash_at                 = NULL,
  36         is_trashed               = NULL,
  37
  38         initialize = function(api, uuid)
  39         {
  40             private$api <- api
  41             result <- private$api$getCollection(uuid)
  42
  43             self$uuid                     <- result$uuid
  44             self$etag                     <- result$etag
  45             self$owner_uuid               <- result$owner_uuid
  46             self$created_at               <- result$created_at
  47             self$modified_by_client_uuid  <- result$modified_by_client_uuid
  48             self$modified_by_user_uuid    <- result$modified_by_user_uuid
  49             self$modified_at              <- result$modified_at
  50             self$portable_data_hash       <- result$portable_data_hash
  51             self$replication_desired      <- result$replication_desired
  52             self$replication_confirmed_at <- result$replication_confirmed_at
  53             self$replication_confirmed    <- result$replication_confirmed
  54             self$updated_at               <- result$updated_at
  55             self$manifest_text            <- result$manifest_text
  56             self$name                     <- result$name
  57             self$description              <- result$description
  58             self$properties               <- result$properties
  59             self$delete_at                <- result$delete_at
  60             self$file_names               <- result$file_names
  61             self$trash_at                 <- result$trash_at
  62             self$is_trashed               <- result$is_trashed
  63
  64             #Todo(Fudo): Replace this when you get access to webDAV server.
  65             private$fileItems <- private$getCollectionContent()
  66
  67             private$fileTree <- private$generateTree(private$fileItems)
  68         },
  69
  70         printFileContent = function(pretty = TRUE)
  71         {
  72             if(pretty)
  73                 private$fileTree$printContent(0)
  74             else
  75                 print(private$fileItems)
  76
  77         },
  78
  79         get = function(relativePath)
  80         {
  81             treeNode <- private$traverseInOrder(private$fileTree, function(node)
  82             {
  83                 if(node$relativePath == relativePath)
  84                     return(node)
  85                 else
  86                     return(NULL)
  87             })
  88
  89             if(!is.null(treeNode))
  90             {
  91                 return(private$createSubcollectionTree(treeNode))
  92             }
  93             else
  94             {
  95                 return(NULL)
  96             }
  97         }
  98     ),
  99
 100     active = list(
 101         items = function(value)
 102         {
 103             if(missing(value))
 104                 return(private$fileItems)
 105             else
 106                 print("Value is read-only.")
 107
 108             return(NULL)
 109         }
 110     ),
 111
 112     private = list(
 113
 114         api       = NULL,
 115         fileItems = NULL,
 116         fileTree  = NULL,
 117
 118         createSubcollectionTree = function(treeNode)
 119         {
 120             if(treeNode$hasChildren())
 121             {
 122                 children = NULL
 123
 124                 for(child in treeNode$children)
 125                 {
 126                     child <- private$createSubcollectionTree(child)
 127                     children <- c(children, child)
 128                 }
 129
 130                 return(Subcollection$new(treeNode$name, treeNode$relativePath, children))
 131             }
 132             else
 133             {
 134                 if(treeNode$type == "file")
 135                     return(ArvadosFile$new(treeNode$name, treeNode$relativePath, private$api, self))
 136                 else if(treeNode$type == "folder" || treeNode$type == "root")
 137                     return(Subcollection$new(treeNode$name, treeNode$relativePath, NULL))
 138             }
 139         },
 140
 141         createSubcollectionFromNode = function(treeNode, children)
 142         {
 143             subcollection = NULL
 144             if(treeNode$type == "file")
 145                 subcollection = ArvadosFile$new(treeNode$name, treeNode$relativePath)
 146             else if(treeNode$type == "folder" || treeNode$type == "root")
 147                 subcollection = Subcollection$new(treeNode$name, treeNode$relativePath, children)
 148
 149             subcollection
 150         },
 151
 152         getCollectionContent = function()
 153         {
 154             #TODO(Fudo): Use proper URL here.
 155             uri <- URLencode(paste0(private$api$getWebDavHostName(), "c=", self$uuid))
 156
 157             # fetch directory listing via curl and parse XML response
 158             h <- curl::new_handle()
 159             curl::handle_setopt(h, customrequest = "PROPFIND")
 160
 161             #TODO(Fudo): Use proper token here.
 162             curl::handle_setheaders(h, "Authorization" = paste("OAuth2", private$api$getToken()))
 163             response <- curl::curl_fetch_memory(uri, h)
 164             print(response)
 165
 166             HttpParser$new()$parseWebDAVResponse(response, uri)
 167         },
 168
 169         #Todo(Fudo): Move tree creation to another file.
 170         generateTree = function(collectionContent)
 171         {
 172             treeBranches <- sapply(collectionContent, function(filePath)
 173             {
 174                 splitPath <- unlist(strsplit(filePath, "/", fixed = TRUE))
 175
 176                 pathEndsWithSlash <- substr(filePath, nchar(filePath), nchar(filePath)) == "/"
 177
 178                 branch = private$createBranch(splitPath, pathEndsWithSlash)
 179             })
 180
 181             root <- TreeNode$new("./", "root")
 182             root$relativePath = ""
 183
 184             sapply(treeBranches, function(branch)
 185             {
 186                 private$addNode(root, branch)
 187             })
 188
 189             root
 190         },
 191
 192         createBranch = function(splitPath, pathEndsWithSlash)
 193         {
 194             branch <- NULL
 195             lastElementIndex <- length(splitPath)
 196
 197             lastElementInPathType = "file"
 198             if(pathEndsWithSlash)
 199                 lastElementInPathType = "folder"
 200
 201             for(elementIndex in lastElementIndex:1)
 202             {
 203                 if(elementIndex == lastElementIndex)
 204                 {
 205                     branch = TreeNode$new(splitPath[[elementIndex]], lastElementInPathType)
 206                 }
 207                 else
 208                 {
 209                     newFolder = TreeNode$new(splitPath[[elementIndex]], "folder")
 210                     newFolder$addChild(branch)
 211                     branch = newFolder
 212                 }
 213
 214                 branch$relativePath <- paste(unlist(splitPath[1:elementIndex]), collapse = "/")
 215             }
 216
 217             branch
 218         },
 219
 220         addNode = function(container, node)
 221         {
 222             child = container$getChild(node$name)
 223
 224             if(is.null(child))
 225             {
 226                 container$addChild(node)
 227             }
 228             else
 229             {
 230                 private$addNode(child, node$getFirstChild())
 231             }
 232         },
 233
 234         traverseInOrder = function(node, predicate)
 235         {
 236             if(node$hasChildren())
 237             {
 238                 result <- predicate(node)
 239
 240                 if(!is.null(result))
 241                     return(result)
 242
 243                 for(child in node$children)
 244                 {
 245                     result <- private$traverseInOrder(child, predicate)
 246
 247                     if(!is.null(result))
 248                         return(result)
 249                 }
 250
 251                 return(NULL)
 252             }
 253             else
 254             {
 255                 return(predicate(node))
 256             }
 257         }
 258
 259     ),
 260
 261     cloneable = FALSE
 262 )
 263
 264 TreeNode <- R6::R6Class(
 265
 266     "TreeNode",
 267
 268     public = list(
 269
 270         name = NULL,
 271         relativePath = NULL,
 272         children = NULL,
 273         parent = NULL,
 274         type = NULL,
 275
 276         initialize = function(name, type)
 277         {
 278             if(type == "folder")
 279                 name <- paste0(name, "/")
 280
 281             self$name <- name
 282             self$type <- type
 283             self$children <- list()
 284         },
 285
 286         addChild = function(node)
 287         {
 288             self$children <- c(self$children, node)
 289             node$setParent(self)
 290             self
 291         },
 292
 293         setParent = function(parent)
 294         {
 295             self$parent = parent
 296         },
 297
 298         getChild = function(childName)
 299         {
 300             for(child in self$children)
 301             {
 302                 if(childName == child$name)
 303                     return(child)
 304             }
 305
 306             return(NULL)
 307         },
 308
 309         hasChildren = function()
 310         {
 311             if(length(self$children) != 0)
 312                 return(TRUE)
 313             else
 314                 return(FALSE)
 315         },
 316
 317         getFirstChild = function()
 318         {
 319             if(!self$hasChildren())
 320                 return(NULL)
 321             else
 322                 return(self$children[[1]])
 323         },
 324
 325         printContent = function(depth)
 326         {
 327             indentation <- paste(rep("....", depth), collapse = "")
 328             print(paste0(indentation, self$name))
 329
 330             for(child in self$children)
 331                 child$printContent(depth + 1)
 332         }
 333     ),
 334
 335     cloneable = FALSE
 336 )