X-Git-Url: https://git.arvados.org/arvados.git/blobdiff_plain/d246f53c1d991f1572d6701569aa8c7eac4d722d..9bb169138470dbb176af7e891d6da2089950354b:/sdk/R/R/ArvadosFile.R diff --git a/sdk/R/R/ArvadosFile.R b/sdk/R/R/ArvadosFile.R index 8c2e9e2547..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)} #' -#' Update description +#' @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.} +#' } #' -#' @export ArvadosFile +#' @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) +#' +#' #Write a table: +#' arvConnection <- myFile$connection("w") +#' write.table(mytable, arvConnection) +#' arvadosFile$flush() +#' +#' #Read a table: +#' arvConnection <- myFile$connection("r") +#' mytable <- read.table(arvConnection) +#' +#' myFile$move("newFolder/myFile") +#' } +NULL + +#' @export ArvadosFile <- R6::R6Class( "ArvadosFile", @@ -11,9 +57,10 @@ 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, @@ -25,16 +72,15 @@ ArvadosFile <- R6::R6Class( 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 }, get = function(fileLikeObjectName) @@ -81,106 +127,80 @@ ArvadosFile <- R6::R6Class( if(offset < 0 || length < 0) stop("Offset and length must be positive values.") - if(!(contentType %in% private$http$validContentTypes)) - stop("Invalid contentType. Please use text or raw.") - - 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()); + fileContent <- REST$read(self$getRelativePath(), + private$collection$uuid, + contentType, offset, length) + fileContent + }, - if(offset == 0 && length == 0) + connection = function(rw) + { + if (rw == "r" || rw == "rb") { - headers <- list(Authorization = paste("OAuth2", - private$collection$api$getToken())) + REST <- private$collection$getRESTService() + return(REST$getConnection(private$collection$uuid, + self$getRelativePath(), + rw)) } - else + else if (rw == "w") { - headers <- list(Authorization = paste("OAuth2", private$collection$api$getToken()), - Range = range) - } - - serverResponse <- private$http$GET(fileURL, headers) + private$buffer <- textConnection(NULL, "w") - if(serverResponse$status_code < 200 || serverResponse$status_code >= 300) - stop(paste("Server code:", serverResponse$status_code)) + return(private$buffer) + } + }, - parsedServerResponse <- httr::content(serverResponse, contentType) - parsedServerResponse + flush = function() + { + v <- textConnectionValue(private$buffer) + close(private$buffer) + self$write(paste(v, collapse='\n')) }, - + write = function(content, contentType = "text/html") { if(is.null(private$collection)) stop("ArvadosFile doesn't belong to any collection.") - 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 - - serverResponse <- private$http$PUT(fileURL, headers, body) + REST <- private$collection$getRESTService() - if(serverResponse$status_code < 200 || serverResponse$status_code >= 300) - stop(paste("Server code:", serverResponse$status_code)) - - parsedServerResponse <- httr::content(serverResponse, "text") - parsedServerResponse + writeResult <- REST$write(self$getRelativePath(), + private$collection$uuid, + content, contentType) + writeResult }, move = function(newLocation) { - #todo test if file can be moved - if(is.null(private$collection)) - stop("ArvadosFile doesn't belong to any collection.") + stop("ArvadosFile doesn't belong to any collection") - if(endsWith(newLocation, paste0(private$name, "/"))) - { - newLocation <- substr(newLocation, 0, - nchar(newLocation) - - nchar(paste0(private$name, "/"))) - } - else if(endsWith(newLocation, private$name)) - { - newLocation <- substr(newLocation, 0, - nchar(newLocation) - nchar(private$name)) - } - else - { - stop("Destination path is not valid.") - } + newLocation <- trimFromEnd(newLocation, "/") + nameAndPath <- splitToPathAndName(newLocation) - newParent <- private$collection$get(newLocation) + newParent <- private$collection$get(nameAndPath$path) if(is.null(newParent)) { - stop("Unable to get destination subcollection.") + stop("Unable to get destination subcollection") } - childWithSameName <- newParent$get(private$name) + childWithSameName <- newParent$get(nameAndPath$name) if(!is.null(childWithSameName)) - stop("Destination already contains file with same name.") + stop("Destination already contains content with same name.") - status <- private$collection$moveOnREST(self$getRelativePath(), - paste0(newParent$getRelativePath(), - "/", self$getName())) + REST <- private$collection$getRESTService() + REST$move(self$getRelativePath(), + paste0(newParent$getRelativePath(), "/", nameAndPath$name), + private$collection$uuid) - #Note: We temporary set parents collection to NULL. This will ensure that - # add method doesn't post file on REST server. - parentsCollection <- newParent$getCollection() - newParent$setCollection(NULL, setRecursively = FALSE) + private$dettachFromCurrentParent() + private$attachToNewParent(newParent) - newParent$add(self) - - newParent$setCollection(parentsCollection, setRecursively = FALSE) - - private$parent <- newParent + private$name <- nameAndPath$name "Content moved successfully." } @@ -192,9 +212,59 @@ ArvadosFile <- R6::R6Class( size = NULL, parent = NULL, collection = NULL, - http = NULL, - httpParser = NULL + buffer = NULL, + + attachToNewParent = function(newParent) + { + #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) + + newParent$add(self) + + newParent$setCollection(parentsCollection, setRecursively = FALSE) + + private$parent <- newParent + }, + + dettachFromCurrentParent = function() + { + #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") +}