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         getFileListing = function(fullpath = TRUE)
  22         {
  23             self$getName()
  24         },
  25
  26         getSizeInBytes = function()
  27         {
  28             collectionURL <- URLencode(paste0(private$collection$api$getWebDavHostName(),
  29                                               "c=", private$collection$uuid))
  30             fileURL <- paste0(collectionURL, "/", self$getRelativePath());
  31
  32             headers = list("Authorization" = paste("OAuth2", private$collection$api$getToken()))
  33
  34             propfindResponse <- private$http$PROPFIND(fileURL, headers)
  35
  36             sizes <- private$httpParser$extractFileSizeFromWebDAVResponse(propfindResponse, collectionURL)
  37             as.numeric(sizes)
  38         },
  39
  40         get = function(fileLikeObjectName)
  41         {
  42             return(NULL)
  43         },
  44
  45         getFirst = function()
  46         {
  47             return(NULL)
  48         },
  49
  50         getCollection = function() private$collection,
  51
  52         setCollection = function(collection)
  53         {
  54             private$collection <- collection
  55         },
  56
  57         getRelativePath = function()
  58         {
  59             relativePath <- c(private$name)
  60             parent <- private$parent
  61
  62             while(!is.null(parent))
  63             {
  64                 relativePath <- c(parent$getName(), relativePath)
  65                 parent <- parent$getParent()
  66             }
  67
  68             relativePath <- relativePath[relativePath != ""]
  69             paste0(relativePath, collapse = "/")
  70         },
  71
  72         getParent = function() private$parent,
  73
  74         setParent = function(newParent) private$parent <- newParent,
  75
  76         read = function(contentType = "raw", offset = 0, length = 0)
  77         {
  78             if(is.null(private$collection))
  79                 stop("ArvadosFile doesn't belong to any collection.")
  80
  81             if(offset < 0 || length < 0)
  82                 stop("Offset and length must be positive values.")
  83
  84             if(!(contentType %in% private$http$validContentTypes))
  85                 stop("Invalid contentType. Please use text or raw.")
  86
  87             range = paste0("bytes=", offset, "-")
  88
  89             if(length > 0)
  90                 range = paste0(range, offset + length - 1)
  91
  92             fileURL = paste0(private$collection$api$getWebDavHostName(),
  93                              "c=", private$collection$uuid, "/", self$getRelativePath());
  94
  95             if(offset == 0 && length == 0)
  96             {
  97                 headers <- list(Authorization = paste("OAuth2",
  98                                                       private$collection$api$getToken()))
  99             }
 100             else
 101             {
 102                 headers <- list(Authorization = paste("OAuth2", private$collection$api$getToken()),
 103                                 Range = range)
 104             }
 105
 106             serverResponse <- private$http$GET(fileURL, headers)
 107
 108             if(serverResponse$status_code < 200 || serverResponse$status_code >= 300)
 109                 stop(paste("Server code:", serverResponse$status_code))
 110
 111             parsedServerResponse <- httr::content(serverResponse, contentType)
 112             parsedServerResponse
 113         },
 114
 115         connection = function(rw)
 116         {
 117           if (rw == "r") {
 118             return(textConnection(self$read("text")))
 119           } else if (rw == "w") {
 120             private$buffer <- textConnection(NULL, "w")
 121             return(private$buffer)
 122           }
 123         },
 124
 125         flush = function() {
 126           v <- textConnectionValue(private$buffer)
 127           close(private$buffer)
 128           self$write(paste(v, collapse='\n'))
 129         },
 130
 131         write = function(content, contentType = "text/html")
 132         {
 133             if(is.null(private$collection))
 134                 stop("ArvadosFile doesn't belong to any collection.")
 135
 136             fileURL = paste0(private$collection$api$getWebDavHostName(),
 137                              "c=", private$collection$uuid, "/", self$getRelativePath());
 138             headers <- list(Authorization = paste("OAuth2", private$collection$api$getToken()),
 139                             "Content-Type" = contentType)
 140             body <- content
 141
 142             serverResponse <- private$http$PUT(fileURL, headers, body)
 143
 144             if(serverResponse$status_code < 200 || serverResponse$status_code >= 300)
 145                 stop(paste("Server code:", serverResponse$status_code))
 146
 147             parsedServerResponse <- httr::content(serverResponse, "text")
 148             parsedServerResponse
 149         },
 150
 151         move = function(newLocation)
 152         {
 153             #todo test if file can be moved
 154
 155             if(is.null(private$collection))
 156                 stop("ArvadosFile doesn't belong to any collection.")
 157
 158             if(endsWith(newLocation, paste0(private$name, "/")))
 159             {
 160                 newLocation <- substr(newLocation, 0,
 161                                       nchar(newLocation)
 162                                       - nchar(paste0(private$name, "/")))
 163             }
 164             else if(endsWith(newLocation, private$name))
 165             {
 166                 newLocation <- substr(newLocation, 0,
 167                                       nchar(newLocation) - nchar(private$name))
 168             }
 169             else
 170             {
 171                 stop("Destination path is not valid.")
 172             }
 173
 174             newParent <- private$collection$get(newLocation)
 175
 176             if(is.null(newParent))
 177             {
 178                 stop("Unable to get destination subcollection.")
 179             }
 180
 181             childWithSameName <- newParent$get(private$name)
 182
 183             if(!is.null(childWithSameName))
 184                 stop("Destination already contains file with same name.")
 185
 186             REST <- private$collection$getRESTService()
 187             status <- REST$move(self$getRelativePath(),
 188                                 paste0(newParent$getRelativePath(),
 189                                 "/", self$getName()),
 190                                 private$collection$uuid)
 191
 192             #Note: We temporary set parents collection to NULL. This will ensure that
 193             #      add method doesn't post file on REST server.
 194             parentsCollection <- newParent$getCollection()
 195             newParent$setCollection(NULL, setRecursively = FALSE)
 196
 197             newParent$add(self)
 198
 199             newParent$setCollection(parentsCollection, setRecursively = FALSE)
 200
 201             private$parent <- newParent
 202
 203             "Content moved successfully."
 204         }
 205     ),
 206
 207     private = list(
 208
 209         name       = NULL,
 210         size       = NULL,
 211         parent     = NULL,
 212         collection = NULL,
 213         http       = NULL,
 214         httpParser = NULL,
 215         buffer     = NULL
 216     ),
 217
 218     cloneable = FALSE
 219 )