Package: ArvadosR
Type: Package
Title: Arvados R SDK
+Version: 0.0.1
Author: Fuad Muhic
Maintainer: Ward Vandewege <wvandewege@veritasgenetics.com>
Description: This is the Arvados R SDK
export(Arvados)
export(ArvadosFile)
-export(CTest)
export(Collection)
export(CollectionTree)
export(Subcollection)
parsedServerResponse <- httr::content(serverResponse, "text")
parsedServerResponse
+ },
+
+ move = function(newLocation)
+ {
+ 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.")
+ }
+
+ newParent <- private$collection$get(newLocation)
+
+ if(is.null(newParent))
+ {
+ stop("Unable to get destination subcollectin")
+ }
+
+ status <- private$collection$.__enclos_env__$private$moveOnRest(self$getRelativePath(), paste0(newParent$getRelativePath(), "/", self$getName()))
+
+ private$attachToParent(newParent)
+
+ paste("Status code :", status$status_code)
}
),
private$parent$.__enclos_env__$private$removeChild(private$name)
private$parent <- NULL
}
+ },
+
+ attachToParent = function(parent)
+ {
+ parent$.__enclos_env__$private$children <- c(parent$.__enclos_env__$private$children, self)
+ private$parent <- parent
}
),
+++ /dev/null
-source("./R/Subcollection.R")
-source("./R/ArvadosFile.R")
-source("./R/HttpRequest.R")
-source("./R/HttpParser.R")
-
-#' Arvados Collection Object
-#'
-#' Update description
-#'
-#' @examples arv = Collection$new(api, uuid)
-#' @export Collection
-Collection <- R6::R6Class(
-
- "Collection",
-
- public = list(
-
- api = NULL,
- uuid = NULL,
-
- initialize = function(api, uuid)
- {
- self$api <- api
- private$http <- HttpRequest$new()
- private$httpParser <- HttpParser$new()
-
- self$uuid <- uuid
- collection <- self$api$getCollection(uuid)
-
- private$fileContent <- private$getCollectionContent()
- private$tree <- CollectionTree$new(private$fileContent, self)
- },
-
- add = function(content, relativePath = "")
- {
- if(relativePath == "" ||
- relativePath == "." ||
- relativePath == "./")
- {
- subcollection <- private$tree$.__enclos_env__$private$tree
- }
- else
- {
- if(endsWith(relativePath, "/") && nchar(relativePath) > 0)
- relativePath <- substr(relativePath, 1, nchar(relativePath) - 1)
-
- subcollection <- self$get(relativePath)
- }
-
- if(is.null(subcollection))
- stop(paste("Subcollection", relativePath, "doesn't exist."))
-
- if(is.character(content))
- {
- sapply(content, function(fileName)
- {
- subcollection$add(ArvadosFile$new(fileName))
- })
- }
- else if("ArvadosFile" %in% class(content) ||
- "Subcollection" %in% class(content))
- {
- subcollection$add(content)
- }
- },
-
- remove = function(content)
- {
- if(is.character(content))
- {
- sapply(content, function(filePath)
- {
- if(endsWith(filePath, "/") && nchar(filePath) > 0)
- filePath <- substr(filePath, 1, nchar(filePath) - 1)
-
- file <- self$get(filePath)
-
- if(is.null(file))
- stop(paste("File", filePath, "doesn't exist."))
-
- file$removeFromCollection()
- })
- }
- else if("ArvadosFile" %in% class(content) ||
- "Subcollection" %in% class(content))
- {
- if(is.null(content$.__enclos_env__$private$collection) ||
- content$.__enclos_env__$private$collection$uuid != self$uuid)
- stop("Subcollection doesn't belong to this collection.")
-
- content$removeFromCollection()
- }
- },
-
- getTree = function() private$tree,
-
- getFileContent = function() private$getCollectionContent(),
-
- get = function(relativePath)
- {
- private$tree$getElement(relativePath)
- }
- ),
-
- private = list(
-
- http = NULL,
- httpParser = NULL,
- tree = NULL,
-
- fileContent = NULL,
-
- getCollectionContent = function()
- {
- collectionURL <- URLencode(paste0(self$api$getWebDavHostName(), "c=", self$uuid))
-
- headers = list("Authorization" = paste("OAuth2", self$api$getToken()))
-
- response <- private$http$PROPFIND(collectionURL, headers)
-
- parsedResponse <- private$httpParser$parseWebDAVResponse(response, collectionURL)
- parsedResponse[-1]
- },
-
- createFilesOnREST = function(files)
- {
- sapply(files, function(filePath)
- {
- private$createNewFile(filePath, NULL, "text/html")
- })
- },
-
- generateTree = function(content)
- {
- treeBranches <- sapply(collectionContent, function(filePath)
- {
- splitPath <- unlist(strsplit(filePath$name, "/", fixed = TRUE))
-
- branch = private$createBranch(splitPath, filePath$fileSize)
- })
- },
-
- createNewFile = function(relativePath, content, contentType)
- {
- fileURL <- paste0(self$api$getWebDavHostName(), "c=", self$uuid, "/", relativePath);
- headers <- list(Authorization = paste("OAuth2", self$api$getToken()),
- "Content-Type" = contentType)
- body <- content
-
- serverResponse <- private$http$PUT(fileURL, headers, body)
-
- if(serverResponse$status_code != 201)
- stop(paste("Server code:", serverResponse$status_code))
-
- print(paste("File created:", relativePath))
- },
-
- deleteFromREST = function(relativePath)
- {
- fileURL <- paste0(self$api$getWebDavHostName(), "c=", self$uuid, "/", relativePath);
- headers <- list(Authorization = paste("OAuth2", self$api$getToken()))
-
- serverResponse <- private$http$DELETE(fileURL, headers)
-
- if(serverResponse$status_code != 204)
- stop(paste("Server code:", serverResponse$status_code))
-
- print(paste("File deleted", relativePath))
- }
- ),
-
- cloneable = FALSE
-)
#' Update description
#'
#' @examples arv = Collection$new(api, uuid)
-#' @export CTest
-CTest <- R6::R6Class(
- "CTest",
+#' @export Collection
+Collection <- R6::R6Class(
+
+ "Collection",
+
public = list(
api = NULL,
}
},
- getTree = function() private$tree,
+ move = function(content, newLocation)
+ {
+ if(endsWith(content, "/"))
+ content <- substr(content, 0, nchar(content) - 1)
+
+ elementToMove <- self$get(content)
+
+ if(is.null(elementToMove))
+ stop("Element you want to move doesn't exist in the collection.")
+
+ elementToMove$move(newLocation)
+ },
getFileContent = function() private$getCollectionContent(),
stop(paste("Server code:", serverResponse$status_code))
print(paste("File deleted", relativePath))
+ },
+
+ moveOnRest = function(from, to)
+ {
+ collectionURL <- URLencode(paste0(self$api$getWebDavHostName(), "c=", self$uuid, "/"))
+ fromURL <- paste0(collectionURL, from)
+ toURL <- paste0(collectionURL, to)
+
+ headers = list("Authorization" = paste("OAuth2", self$api$getToken()),
+ "Destination" = toURL)
+
+ serverResponse <- private$http$MOVE(fromURL, headers)
+
+ if(serverResponse$status_code < 200 || serverResponse$status_code >= 300)
+ stop(paste("Server code:", serverResponse$status_code))
+
+ serverResponse
}
),
source("./R/Subcollection.R")
+
source("./R/ArvadosFile.R")
#' Arvados Collection Object
getElement = function(relativePath)
{
+ if(endsWith(relativePath, "/"))
+ relativePath <- substr(relativePath, 0, nchar(relativePath) - 1)
+
splitPath <- unlist(strsplit(relativePath, "/", fixed = TRUE))
returnElement = private$tree
for(elementIndex in lastElementIndex:1)
{
- if(elementIndex == lastElementIndex)
+ if(elementIndex == lastElementIndex)
{
branch = ArvadosFile$new(splitPath[[elementIndex]])
}
curl::handle_setopt(h, customrequest = "PROPFIND")
curl::handle_setheaders(h, .list = headers)
+ propfindResponse <- curl::curl_fetch_memory(url, h)
+ },
+
+ MOVE = function(url, headers = NULL)
+ {
+ h <- curl::new_handle()
+ curl::handle_setopt(h, customrequest = "MOVE")
+ curl::handle_setheaders(h, .list = headers)
+
propfindResponse <- curl::curl_fetch_memory(url, h)
}
),
#todo rename this add to a collection
private$addToCollection(NULL)
- private$detachFromParent()
+ private$dettachFromParent()
},
paste0(relativePath, collapse = "/")
},
+ move = function(newLocation)
+ {
+ 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.")
+ }
+
+ newParent <- private$collection$get(newLocation)
+
+ if(is.null(newParent))
+ {
+ stop("Unable to get destination subcollectin")
+ }
+
+ status <- private$collection$.__enclos_env__$private$moveOnRest(self$getRelativePath(), paste0(newParent$getRelativePath(), "/", self$getName()))
+
+ private$attachToParent(newParent)
+
+ paste("Status code :", status$status_code)
+ },
+
getParent = function() private$parent
),
private$collection = collection
},
- detachFromParent = function()
+ dettachFromParent = function()
{
if(!is.null(private$parent))
{
private$parent$.__enclos_env__$private$removeChild(private$name)
private$parent <- NULL
}
+ else
+ stop("Parent doesn't exists.")
+ },
+
+ attachToParent = function(parent)
+ {
+ parent$.__enclos_env__$private$children <- c(parent$.__enclos_env__$private$children, self)
+ private$parent <- parent
}
),
+++ /dev/null
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/Collection.R
-\docType{data}
-\name{CTest}
-\alias{CTest}
-\title{Arvados Collection Object}
-\format{An object of class \code{R6ClassGenerator} of length 24.}
-\usage{
-CTest
-}
-\description{
-Update description
-}
-\examples{
-arv = Collection$new(api, uuid)
-}
-\keyword{datasets}
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/CTest.R
+% Please edit documentation in R/Collection.R
\docType{data}
\name{Collection}
\alias{Collection}
projects / arvados.git / commitdiff