X-Git-Url: https://git.arvados.org/arvados.git/blobdiff_plain/df8b4a86d08b4da0f5959766257664c9af89343b..9bb169138470dbb176af7e891d6da2089950354b:/sdk/R/R/ArvadosFile.R diff --git a/sdk/R/R/ArvadosFile.R b/sdk/R/R/ArvadosFile.R index c8950c651c..e28ba9606c 100644 --- a/sdk/R/R/ArvadosFile.R +++ b/sdk/R/R/ArvadosFile.R @@ -1,8 +1,54 @@ -#' ArvadosFile Object +source("./R/util.R") + +#' ArvadosFile +#' +#' ArvadosFile class represents a file inside Arvados collection. +#' +#' @section Usage: +#' \preformatted{file = ArvadosFile$new(name)} +#' +#' @section Arguments: +#' \describe{ +#' \item{name}{Name of the file.} +#' } +#' +#' @section Methods: +#' \describe{ +#' \item{getName()}{Returns name of the file.} +#' \item{getRelativePath()}{Returns file path relative to the root.} +#' \item{read(contentType = "raw", offset = 0, length = 0)}{Read file content.} +#' \item{write(content, contentType = "text/html")}{Write to file (override current content of the file).} +#' \item{connection(rw)}{Get connection opened in "read" or "write" mode.} +#' \item{flush()}{Write connections content to a file (override current content of the file).} +#' \item{remove(name)}{Removes ArvadosFile or Subcollection specified by name from the subcollection.} +#' \item{getSizeInBytes()}{Returns file size in bytes.} +#' \item{move(newLocation)}{Moves file to a new location inside collection.} +#' } +#' +#' @name ArvadosFile +#' @examples +#' \dontrun{ +#' myFile <- ArvadosFile$new("myFile") +#' +#' myFile$write("This is new file content") +#' fileContent <- myFile$read() +#' fileContent <- myFile$read("text") +#' fileContent <- myFile$read("raw", offset = 8, length = 4) #' -#' Update description +#' #Write a table: +#' arvConnection <- myFile$connection("w") +#' write.table(mytable, arvConnection) +#' arvadosFile$flush() #' -#' @export ArvadosFile +#' #Read a table: +#' arvConnection <- myFile$connection("r") +#' mytable <- read.table(arvConnection) +#' +#' myFile$move("newFolder/myFile") +#' } +NULL + +#' @export ArvadosFile <- R6::R6Class( "ArvadosFile", @@ -11,41 +57,47 @@ ArvadosFile <- R6::R6Class( initialize = function(name) { - private$name <- name - private$http <- HttpRequest$new() - private$httpParser <- HttpParser$new() + if(name == "") + stop("Invalid name.") + + private$name <- name }, getName = function() private$name, - getFileList = function(fullpath = TRUE) + getFileListing = function(fullpath = TRUE) { self$getName() }, getSizeInBytes = function() { - collectionURL <- URLencode(paste0(private$collection$api$getWebDavHostName(), "c=", private$collection$uuid)) - fileURL <- paste0(collectionURL, "/", self$getRelativePath()); + if(is.null(private$collection)) + return(0) - headers = list("Authorization" = paste("OAuth2", private$collection$api$getToken())) + REST <- private$collection$getRESTService() - propfindResponse <- private$http$PROPFIND(fileURL, headers) + fileSize <- REST$getResourceSize(self$getRelativePath(), + private$collection$uuid) - sizes <- private$httpParser$extractFileSizeFromWebDAVResponse(propfindResponse, collectionURL) - as.numeric(sizes) + fileSize }, - removeFromCollection = function() + get = function(fileLikeObjectName) { - if(is.null(private$collection)) - stop("Subcollection doesn't belong to any collection.") - - private$collection$.__enclos_env__$private$deleteFromREST(self$getRelativePath()) + return(NULL) + }, - #todo rename this add to a collection - private$addToCollection(NULL) - private$detachFromParent() + getFirst = function() + { + return(NULL) + }, + + getCollection = function() private$collection, + + setCollection = function(collection) + { + private$collection <- collection }, getRelativePath = function() @@ -53,7 +105,6 @@ ArvadosFile <- R6::R6Class( relativePath <- c(private$name) parent <- private$parent - #Recurse back to root while(!is.null(parent)) { relativePath <- c(parent$getName(), relativePath) @@ -66,80 +117,154 @@ ArvadosFile <- R6::R6Class( getParent = function() private$parent, - read = function(offset = 0, length = 0) + setParent = function(newParent) private$parent <- newParent, + + read = function(contentType = "raw", offset = 0, length = 0) { - #todo range is wrong fix it + if(is.null(private$collection)) + stop("ArvadosFile doesn't belong to any collection.") + if(offset < 0 || length < 0) - stop("Offset and length must be positive values.") + stop("Offset and length must be positive values.") - range = paste0("bytes=", offset, "-") + REST <- private$collection$getRESTService() - if(length > 0) - range = paste0(range, offset + length - 1) - - fileURL = paste0(private$collection$api$getWebDavHostName(), "c=", private$collection$uuid, "/", self$getRelativePath()); - headers <- list(Authorization = paste("OAuth2", private$collection$api$getToken()), - Range = range) + fileContent <- REST$read(self$getRelativePath(), + private$collection$uuid, + contentType, offset, length) + fileContent + }, - serverResponse <- private$http$GET(fileURL, headers) + connection = function(rw) + { + if (rw == "r" || rw == "rb") + { + REST <- private$collection$getRESTService() + return(REST$getConnection(private$collection$uuid, + self$getRelativePath(), + rw)) + } + else if (rw == "w") + { + private$buffer <- textConnection(NULL, "w") - if(serverResponse$status_code != 206) - stop(paste("Server code:", serverResponse$status_code)) + return(private$buffer) + } + }, - parsedServerResponse <- httr::content(serverResponse, "raw") - parsedServerResponse + flush = function() + { + v <- textConnectionValue(private$buffer) + close(private$buffer) + self$write(paste(v, collapse='\n')) }, - + write = function(content, contentType = "text/html") { - fileURL = paste0(private$collection$api$getWebDavHostName(), "c=", private$collection$uuid, "/", self$getRelativePath()); - headers <- list(Authorization = paste("OAuth2", private$collection$api$getToken()), - "Content-Type" = contentType) - body <- content + if(is.null(private$collection)) + stop("ArvadosFile doesn't belong to any collection.") + + REST <- private$collection$getRESTService() + + writeResult <- REST$write(self$getRelativePath(), + private$collection$uuid, + content, contentType) + writeResult + }, + + move = function(newLocation) + { + if(is.null(private$collection)) + stop("ArvadosFile doesn't belong to any collection") + + newLocation <- trimFromEnd(newLocation, "/") + nameAndPath <- splitToPathAndName(newLocation) + + newParent <- private$collection$get(nameAndPath$path) + + if(is.null(newParent)) + { + stop("Unable to get destination subcollection") + } + + childWithSameName <- newParent$get(nameAndPath$name) + + if(!is.null(childWithSameName)) + stop("Destination already contains content with same name.") - serverResponse <- private$http$PUT(fileURL, headers, body) + REST <- private$collection$getRESTService() + REST$move(self$getRelativePath(), + paste0(newParent$getRelativePath(), "/", nameAndPath$name), + private$collection$uuid) - if(serverResponse$status_code != 201) - stop(paste("Server code:", serverResponse$status_code)) + private$dettachFromCurrentParent() + private$attachToNewParent(newParent) - parsedServerResponse <- httr::content(serverResponse, "text") - parsedServerResponse + private$name <- nameAndPath$name + + "Content moved successfully." } ), private = list( - name = NULL, - size = NULL, - parent = NULL, - collection = NULL, - http = NULL, - httpParser = NULL, + name = NULL, + size = NULL, + parent = NULL, + collection = NULL, + buffer = NULL, - getChild = function(name) + attachToNewParent = function(newParent) { - return(NULL) - }, + #Note: We temporary set parents collection to NULL. This will ensure that + # add method doesn't post file on REST. + parentsCollection <- newParent$getCollection() + newParent$setCollection(NULL, setRecursively = FALSE) - getFirstChild = function() - { - return(NULL) - }, + newParent$add(self) - addToCollection = function(collection) - { - private$collection = collection + newParent$setCollection(parentsCollection, setRecursively = FALSE) + + private$parent <- newParent }, - detachFromParent = function() + dettachFromCurrentParent = function() { - if(!is.null(private$parent)) - { - private$parent$.__enclos_env__$private$removeChild(private$name) - private$parent <- NULL - } + #Note: We temporary set parents collection to NULL. This will ensure that + # remove method doesn't remove this subcollection from REST. + parent <- private$parent + parentsCollection <- parent$getCollection() + parent$setCollection(NULL, setRecursively = FALSE) + + parent$remove(private$name) + + parent$setCollection(parentsCollection, setRecursively = FALSE) } ), - + cloneable = FALSE ) + +#' print.ArvadosFile +#' +#' Custom print function for ArvadosFile class +#' +#' @param x Instance of ArvadosFile class +#' @param ... Optional arguments. +#' @export +print.ArvadosFile = function(x, ...) +{ + collection <- NULL + relativePath <- x$getRelativePath() + + if(!is.null(x$getCollection())) + { + collection <- x$getCollection()$uuid + relativePath <- paste0("/", relativePath) + } + + cat(paste0("Type: ", "\"", "ArvadosFile", "\""), sep = "\n") + cat(paste0("Name: ", "\"", x$getName(), "\""), sep = "\n") + cat(paste0("Relative path: ", "\"", relativePath, "\""), sep = "\n") + cat(paste0("Collection: ", "\"", collection, "\""), sep = "\n") +}