sdk/R/R/ArvadosFile.R

   1 #' ArvadosFile Object
   2 #'
   3 #' Update description
   4 #'
   5 #' @export ArvadosFile
   6 ArvadosFile <- R6::R6Class(
   7
   8     "ArvadosFile",
   9
  10     public = list(
  11
  12         initialize = function(name)
  13         {
  14             private$name       <- name
  15             private$http       <- HttpRequest$new()
  16             private$httpParser <- HttpParser$new()
  17         },
  18
  19         getName = function() private$name,
  20
  21         getFileList = function(fullpath = TRUE)
  22         {
  23             self$getName()
  24         },
  25
  26         getSizeInBytes = function()
  27         {
  28             collectionURL <- URLencode(paste0(private$collection$api$getWebDavHostName(), "c=", private$collection$uuid))
  29             fileURL <- paste0(collectionURL, "/", self$getRelativePath());
  30
  31             headers = list("Authorization" = paste("OAuth2", private$collection$api$getToken()))
  32
  33             propfindResponse <- private$http$PROPFIND(fileURL, headers)
  34
  35             sizes <- private$httpParser$extractFileSizeFromWebDAVResponse(propfindResponse, collectionURL)
  36             as.numeric(sizes)
  37         },
  38
  39         removeFromCollection = function()
  40         {
  41             if(is.null(private$collection))
  42                 stop("Subcollection doesn't belong to any collection.")
  43
  44             private$collection$.__enclos_env__$private$deleteFromREST(self$getRelativePath())
  45
  46             #todo rename this add to a collection
  47             private$addToCollection(NULL)
  48             private$detachFromParent()
  49         },
  50
  51         getRelativePath = function()
  52         {
  53             relativePath <- c(private$name)
  54             parent <- private$parent
  55
  56             #Recurse back to root
  57             while(!is.null(parent))
  58             {
  59                 relativePath <- c(parent$getName(), relativePath)
  60                 parent <- parent$getParent()
  61             }
  62
  63             relativePath <- relativePath[relativePath != ""]
  64             paste0(relativePath, collapse = "/")
  65         },
  66
  67         getParent = function() private$parent,
  68
  69         read = function(offset = 0, length = 0)
  70         {
  71             #todo range is wrong fix it
  72             if(offset < 0 || length < 0)
  73             stop("Offset and length must be positive values.")
  74
  75             range = paste0("bytes=", offset, "-")
  76
  77             if(length > 0)
  78                 range = paste0(range, offset + length - 1)
  79
  80             fileURL = paste0(private$collection$api$getWebDavHostName(), "c=", private$collection$uuid, "/", self$getRelativePath());
  81             headers <- list(Authorization = paste("OAuth2", private$collection$api$getToken()),
  82                             Range = range)
  83
  84             serverResponse <- private$http$GET(fileURL, headers)
  85
  86             if(serverResponse$status_code != 206)
  87                 stop(paste("Server code:", serverResponse$status_code))
  88
  89             parsedServerResponse <- httr::content(serverResponse, "raw")
  90             parsedServerResponse
  91         },
  92
  93         write = function(content, contentType = "text/html")
  94         {
  95             fileURL = paste0(private$collection$api$getWebDavHostName(), "c=", private$collection$uuid, "/", self$getRelativePath());
  96             headers <- list(Authorization = paste("OAuth2", private$collection$api$getToken()),
  97                             "Content-Type" = contentType)
  98             body <- content
  99
 100             serverResponse <- private$http$PUT(fileURL, headers, body)
 101
 102             if(serverResponse$status_code != 201)
 103                 stop(paste("Server code:", serverResponse$status_code))
 104
 105             parsedServerResponse <- httr::content(serverResponse, "text")
 106             parsedServerResponse
 107         },
 108
 109         move = function(newLocation)
 110         {
 111             if(endsWith(newLocation, paste0(private$name, "/")))
 112             {
 113                 newLocation <- substr(newLocation, 0, nchar(newLocation) - nchar(paste0(private$name, "/")))
 114             }
 115             else if(endsWith(newLocation, private$name))
 116             {
 117                 newLocation <- substr(newLocation, 0, nchar(newLocation) - nchar(private$name))
 118             }
 119             else
 120             {
 121                 stop("Destination path is not valid.")
 122             }
 123
 124             newParent <- private$collection$get(newLocation)
 125
 126             if(is.null(newParent))
 127             {
 128                 stop("Unable to get destination subcollectin")
 129             }
 130
 131             status <- private$collection$.__enclos_env__$private$moveOnRest(self$getRelativePath(), paste0(newParent$getRelativePath(), "/", self$getName()))
 132
 133             private$attachToParent(newParent)
 134
 135             paste("Status code :", status$status_code)
 136         }
 137     ),
 138
 139     private = list(
 140
 141         name         = NULL,
 142         size         = NULL,
 143         parent       = NULL,
 144         collection   = NULL,
 145         http         = NULL,
 146         httpParser   = NULL,
 147
 148         getChild = function(name)
 149         {
 150             return(NULL)
 151         },
 152
 153         getFirstChild = function()
 154         {
 155             return(NULL)
 156         },
 157
 158         addToCollection = function(collection)
 159         {
 160             private$collection = collection
 161         },
 162
 163         detachFromParent = function()
 164         {
 165             if(!is.null(private$parent))
 166             {
 167                 private$parent$.__enclos_env__$private$removeChild(private$name)
 168                 private$parent <- NULL
 169             }
 170         },
 171
 172         attachToParent = function(parent)
 173         {
 174             parent$.__enclos_env__$private$children <- c(parent$.__enclos_env__$private$children, self)
 175             private$parent <- parent
 176         }
 177     ),
 178
 179     cloneable = FALSE
 180 )