+source("./R/util.R")
+
#' ArvadosFile Object
#'
#' Update description
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(private$collection$uuid,
+ self$getRelativePath())
- sizes <- private$httpParser$extractFileSizeFromWebDAVResponse(propfindResponse, collectionURL)
- as.numeric(sizes)
+ fileSize
},
get = function(fileLikeObjectName)
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, "-")
-
- if(length > 0)
- range = paste0(range, offset + length - 1)
+ REST <- private$collection$getRESTService()
- fileURL = paste0(private$collection$api$getWebDavHostName(),
- "c=", private$collection$uuid, "/", self$getRelativePath());
+ REST$read(private$collection$uuid,
+ self$getRelativePath(),
+ contentType, offset, length)
+ },
- if(offset == 0 && length == 0)
+ connection = function(rw)
+ {
+ if (rw == "r")
{
- headers <- list(Authorization = paste("OAuth2",
- private$collection$api$getToken()))
+ return(textConnection(self$read("text")))
}
- else
+ else if (rw == "w")
{
- headers <- list(Authorization = paste("OAuth2", private$collection$api$getToken()),
- Range = range)
- }
-
- serverResponse <- private$http$GET(fileURL, headers)
-
- if(serverResponse$status_code < 200 || serverResponse$status_code >= 300)
- stop(paste("Server code:", serverResponse$status_code))
+ private$buffer <- textConnection(NULL, "w")
- parsedServerResponse <- httr::content(serverResponse, contentType)
- parsedServerResponse
+ return(private$buffer)
+ }
},
- connection = function(rw)
- {
- if (rw == "r") {
- return(textConnection(self$read("text")))
- } else if (rw == "w") {
- private$buffer <- textConnection(NULL, "w")
- return(private$buffer)
- }
- },
-
- flush = function() {
- v <- textConnectionValue(private$buffer)
- close(private$buffer)
- self$write(paste(v, collapse='\n'))
- },
+ 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)
-
- if(serverResponse$status_code < 200 || serverResponse$status_code >= 300)
- stop(paste("Server code:", serverResponse$status_code))
+ REST <- private$collection$getRESTService()
- parsedServerResponse <- httr::content(serverResponse, "text")
- parsedServerResponse
+ result <- REST$write(private$collection$uuid,
+ self$getRelativePath(),
+ content, contentType)
},
- move = function(newLocation)
+ move = function(newLocationInCollection)
{
- #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.")
- }
+ newLocationInCollection <- trimFromEnd(newLocationInCollection, "/")
+ newParentLocation <- trimFromEnd(newLocationInCollection, private$name)
- newParent <- private$collection$get(newLocation)
+ newParent <- private$collection$get(newParentLocation)
if(is.null(newParent))
{
- stop("Unable to get destination subcollection.")
+ stop("Unable to get destination subcollection")
}
childWithSameName <- newParent$get(private$name)
if(!is.null(childWithSameName))
- stop("Destination already contains file with same name.")
+ stop("Destination already contains content with same name.")
REST <- private$collection$getRESTService()
- status <- REST$move(self$getRelativePath(),
- paste0(newParent$getRelativePath(),
- "/", self$getName()),
- private$collection$uuid)
+ REST$move(self$getRelativePath(),
+ paste0(newParent$getRelativePath(), "/", self$getName()),
+ 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)
-
- newParent$add(self)
-
- newParent$setCollection(parentsCollection, setRecursively = FALSE)
-
- private$parent <- newParent
+ private$dettachFromCurrentParent()
+ private$attachToNewParent(newParent)
"Content moved successfully."
}
collection = NULL,
http = NULL,
httpParser = NULL,
- buffer = 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
subcollection <- self$get(relativePath)
}
- if(is.null(subcollection) || !("Subcollection" %in% class(Subcollection)))
+ if(is.null(subcollection))
stop(paste("Subcollection", relativePath, "doesn't exist."))
if("ArvadosFile" %in% class(content) ||
}
else
{
- contentClass <- paste(class(content), collapse = ", ")
- stop(paste("Expected AravodsFile or Subcollection object, got",
- paste0("(", contentClass, ")"), "."))
+ stop(paste0("Expected AravodsFile or Subcollection object, got ",
+ paste0("(", paste0(class(content), collapse = ", "), ")"),
+ "."))
}
},
- #todo collapse 2 parameters in one
create = function(fileNames, relativePath = "")
{
- if(relativePath == "" ||
+ if(relativePath == "" ||
relativePath == "." ||
relativePath == "./")
{
}
else
{
- if(endsWith(relativePath, "/") && nchar(relativePath) > 0)
- relativePath <- substr(relativePath, 1, nchar(relativePath) - 1)
-
+ relativePath <- trimFromEnd(relativePath, "/")
subcollection <- self$get(relativePath)
}
}
else
{
- contentClass <- paste(class(fileNames), collapse = ", ")
- stop(paste("Expected character vector, got",
- paste0("(", contentClass, ")"), "."))
+ stop(paste0("Expected character vector, got ",
+ paste0("(", paste0(class(fileNames), collapse = ", "), ")"),
+ "."))
}
},
- remove = function(content)
+ remove = function(paths)
{
- if(is.character(content))
+ if(is.character(paths))
{
- sapply(content, function(filePath)
+ sapply(paths, function(filePath)
{
- if(endsWith(filePath, "/") && nchar(filePath) > 0)
- filePath <- substr(filePath, 1, nchar(filePath) - 1)
-
+ filePath <- trimFromEnd(filePath, "/")
file <- self$get(filePath)
if(is.null(file))
stop(paste("File", filePath, "doesn't exist."))
parent <- file$getParent()
- parent$remove(filePath)
+ parent$remove(file$getName())
})
}
- else if("ArvadosFile" %in% class(content) ||
- "Subcollection" %in% class(content))
+ else
{
- if(is.null(content$getCollection()) ||
- content$getCollection()$uuid != self$uuid)
- stop("Subcollection doesn't belong to this collection.")
-
- content$removeFromCollection()
+ stop(paste0("Expected character vector, got ",
+ paste0("(", paste0(class(paths), collapse = ", "), ")"),
+ "."))
}
},
{
collectionURL <- URLencode(paste0(private$api$getWebDavHostName(), "c=", uuid))
- headers = list("Authorization" = paste("OAuth2", private$api$getToken()))
+ headers <- list("Authorization" = paste("OAuth2", private$api$getToken()))
response <- private$http$PROPFIND(collectionURL, headers)
parsedResponse[-1]
},
- getResourceSize = function(uuid, relativePathToResource)
+ getResourceSize = function(uuid, relativePath)
{
collectionURL <- URLencode(paste0(private$api$getWebDavHostName(),
"c=", uuid))
- subcollectionURL <- paste0(collectionURL, "/",
- relativePathToResource, "/");
- headers = list("Authorization" = paste("OAuth2",
+ subcollectionURL <- paste0(collectionURL, "/", relativePath);
+
+ headers <- list("Authorization" = paste("OAuth2",
private$api$getToken()))
propfindResponse <- private$http$PROPFIND(subcollectionURL, headers)
sizes <- private$httpParser$extractFileSizeFromWebDAVResponse(propfindResponse,
collectionURL)
- sizes <- as.numeric(sizes[-1])
+ as.numeric(sizes)
+ },
+
+ read = function(uuid, relativePath, contentType = "raw", offset = 0, length = 0)
+ {
+ fileURL <- paste0(private$api$getWebDavHostName(),
+ "c=", uuid, "/", relativePath);
+
+ range <- paste0("bytes=", offset, "-")
+
+ if(length > 0)
+ range = paste0(range, offset + length - 1)
+
+ if(offset == 0 && length == 0)
+ {
+ headers <- list(Authorization = paste("OAuth2", private$api$getToken()))
+ }
+ else
+ {
+ headers <- list(Authorization = paste("OAuth2", private$api$getToken()),
+ Range = range)
+ }
+
+ if(!(contentType %in% private$http$validContentTypes))
+ stop("Invalid contentType. Please use text or raw.")
+
+ serverResponse <- private$http$GET(fileURL, headers)
+
+ if(serverResponse$status_code < 200 || serverResponse$status_code >= 300)
+ stop(paste("Server code:", serverResponse$status_code))
+
+ #todo remove all references to httr from here
+ parsedServerResponse <- httr::content(serverResponse, contentType)
+ parsedServerResponse
+ },
+
+ write = function(uuid, relativePath, content, contentType)
+ {
+ fileURL <- paste0(private$api$getWebDavHostName(),
+ "c=", uuid, "/", relativePath);
+ headers <- list(Authorization = paste("OAuth2", private$api$getToken()),
+ "Content-Type" = contentType)
+ body <- content
+
+ serverResponse <- private$http$PUT(fileURL, headers, body)
+
+ if(serverResponse$status_code < 200 || serverResponse$status_code >= 300)
+ stop(paste("Server code:", serverResponse$status_code))
- return(sum(sizes))
+ parsedServerResponse <- httr::content(serverResponse, "text")
+ parsedServerResponse
}
),
+source("./R/util.R")
+
#' Arvados SubCollection Object
#'
#' Update description
getSizeInBytes = function()
{
- if(!is.null(private$collection))
- {
- REST <- private$collection$getRESTService()
- subcollectionSize <- REST$getResourceSize(private$collection$uuid,
- self$getRelativePath())
- return(subcollectionSize)
- }
- else
- {
+ if(is.null(private$collection))
return(0)
- }
+
+ REST <- private$collection$getRESTService()
+
+ fileSizes <- REST$getResourceSize(private$collection$uuid,
+ paste0(self$getRelativePath(), "/"))
+ return(sum(fileSizes))
},
move = function(newLocationInCollection)
stop("Unable to get destination subcollection")
}
+ childWithSameName <- newParent$get(private$name)
+
+ if(!is.null(childWithSameName))
+ stop("Destination already contains content with same name.")
+
REST <- private$collection$getRESTService()
REST$move(self$getRelativePath(),
paste0(newParent$getRelativePath(), "/", self$getName()),
#Read a table
-arvadosFile <- collection$get("myinput.txt")
+arvadosFile <- collection$get("myinput.txt")
arvConnection <- arvadosFile$connection("r")
-mytable <- read.table(arvConnection)
+mytable <- read.table(arvConnection)
#Write a table
-arvadosFile <- collection$create("myoutput.txt")
+arvadosFile <- collection$create("myoutput.txt")
arvConnection <- arvadosFile$connection("w")
write.table(mytable, arvConnection)
arvadosFile$flush()
#Add existing ArvadosFile or Subcollection to a collection
folder <- Subcollection$new("src")
-file <- ArvadosFile$new("main.cpp")
+file <- ArvadosFile$new("main.cpp")
folder$add(file)
collection$add(folder, "cpp")
public = list(
- createCallCount = NULL,
- deleteCallCount = NULL,
- moveCallCount = NULL,
- getResourceSizeCallCount = NULL,
+ createCallCount = NULL,
+ deleteCallCount = NULL,
+ moveCallCount = NULL,
+ getCollectionContentCallCount = NULL,
+ getResourceSizeCallCount = NULL,
+ readCallCount = NULL,
+ writeCallCount = NULL,
+ writeBuffer = NULL,
collectionContent = NULL,
returnContent = NULL,
initialize = function(collectionContent = NULL, returnContent = NULL)
{
- self$createCallCount <- 0
- self$deleteCallCount <- 0
- self$moveCallCount <- 0
- self$getResourceSizeCallCount <- 0
+ self$createCallCount <- 0
+ self$deleteCallCount <- 0
+ self$moveCallCount <- 0
+ self$getCollectionContentCallCount <- 0
+ self$getResourceSizeCallCount <- 0
+ self$readCallCount <- 0
+ self$writeCallCount <- 0
self$collectionContent <- collectionContent
self$returnContent <- returnContent
getCollectionContent = function(uuid)
{
+ self$getCollectionContentCallCount <- self$getCollectionContentCallCount + 1
self$collectionContent
},
{
self$getResourceSizeCallCount <- self$getResourceSizeCallCount + 1
self$returnContent
+ },
+
+ read = function(uuid, relativePath, contentType = "text", offset = 0, length = 0)
+ {
+ self$readCallCount <- self$readCallCount + 1
+ self$returnContent
+ },
+
+ write = function(uuid, relativePath, content, contentType)
+ {
+ self$writeBuffer <- content
+ self$writeCallCount <- self$writeCallCount + 1
+ self$returnContent
}
),
--- /dev/null
+source("fakes/FakeRESTService.R")
+
+context("ArvadosFile")
+
+test_that("getFileListing always returns file name", {
+
+ dog <- ArvadosFile$new("dog")
+
+ expect_that(dog$getFileListing(), equals("dog"))
+})
+
+test_that("get always returns NULL", {
+
+ dog <- ArvadosFile$new("dog")
+
+ responseIsNull <- is.null(dog$get("something"))
+ expect_that(responseIsNull, is_true())
+})
+
+test_that("getFirst always returns NULL", {
+
+ dog <- ArvadosFile$new("dog")
+
+ responseIsNull <- is.null(dog$getFirst())
+ expect_that(responseIsNull, is_true())
+})
+
+test_that(paste("getSizeInBytes returns zero if arvadosFile",
+ "is not part of a collection"), {
+
+ dog <- ArvadosFile$new("dog")
+
+ expect_that(dog$getSizeInBytes(), equals(0))
+})
+
+test_that(paste("getSizeInBytes delegates size calculation",
+ "to REST service class"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal", "animal/fish")
+ returnSize <- 100
+
+ fakeREST <- FakeRESTService$new(collectionContent, returnSize)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ fish <- collection$get("animal/fish")
+
+ resourceSize <- fish$getSizeInBytes()
+
+ expect_that(resourceSize, equals(100))
+})
+
+test_that("getRelativePath returns path relative to the tree root", {
+
+ animal <- Subcollection$new("animal")
+ fish <- Subcollection$new("fish")
+ shark <- ArvadosFile$new("shark")
+
+ animal$add(fish)
+ fish$add(shark)
+
+ expect_that(shark$getRelativePath(), equals("animal/fish/shark"))
+})
+
+test_that("read raises exception if file doesn't belong to a collection", {
+
+ dog <- ArvadosFile$new("dog")
+
+ expect_that(dog$read(),
+ throws_error("ArvadosFile doesn't belong to any collection."))
+})
+
+test_that("read raises exception offset or length is negative number", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal", "animal/fish")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ fish <- collection$get("animal/fish")
+
+ expect_that(fish$read(contentType = "text", offset = -1),
+ throws_error("Offset and length must be positive values."))
+ expect_that(fish$read(contentType = "text", length = -1),
+ throws_error("Offset and length must be positive values."))
+ expect_that(fish$read(contentType = "text", offset = -1, length = -1),
+ throws_error("Offset and length must be positive values."))
+})
+
+test_that("read delegates reading operation to REST service class", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal", "animal/fish")
+ readContent <- "my file"
+
+ fakeREST <- FakeRESTService$new(collectionContent, readContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ fish <- collection$get("animal/fish")
+
+ fileContent <- fish$read("text")
+
+ expect_that(fileContent, equals("my file"))
+ expect_that(fakeREST$readCallCount, equals(1))
+})
+
+test_that(paste("connect returns textConnection opened",
+ "in read mode when 'r' is passed as argument"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal", "animal/fish")
+ readContent <- "file content"
+
+ fakeREST <- FakeRESTService$new(collectionContent, readContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ fish <- collection$get("animal/fish")
+
+ connection <- fish$connection("r")
+
+ expect_that(readLines(connection), equals("file content"))
+})
+
+test_that(paste("connect returns textConnection opened",
+ "in write mode when 'w' is passed as argument"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal", "animal/fish")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ fish <- collection$get("animal/fish")
+
+ connection <- fish$connection("w")
+
+ writeLines("file", connection)
+ writeLines("content", connection)
+
+ writeResult <- textConnectionValue(connection)
+
+ expect_that(writeResult[1], equals("file"))
+ expect_that(writeResult[2], equals("content"))
+})
+
+test_that("flush sends data stored in a connection to a REST server", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal", "animal/fish")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ fish <- collection$get("animal/fish")
+
+ connection <- fish$connection("w")
+
+ writeLines("file content", connection)
+
+ fish$flush()
+
+ expect_that(fakeREST$writeBuffer, equals("file content"))
+})
+
+test_that("write raises exception if file doesn't belong to a collection", {
+
+ dog <- ArvadosFile$new("dog")
+
+ expect_that(dog$write(),
+ throws_error("ArvadosFile doesn't belong to any collection."))
+})
+
+test_that("write delegates writing operation to REST service class", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal", "animal/fish")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ fish <- collection$get("animal/fish")
+
+ fileContent <- fish$write("new file content")
+
+ expect_that(fakeREST$writeBuffer, equals("new file content"))
+})
+
+test_that(paste("move raises exception if arvados file",
+ "doesn't belong to any collection"), {
+
+ animal <- ArvadosFile$new("animal")
+
+ expect_that(animal$move("new/location"),
+ throws_error("ArvadosFile doesn't belong to any collection"))
+})
+
+test_that(paste("move raises exception if newLocationInCollection",
+ "parameter is invalid"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "animal/dog",
+ "animal/fish/shark",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+
+ collection <- Collection$new(api, "myUUID")
+ dog <- collection$get("animal/dog")
+
+ expect_that(dog$move("objects/dog"),
+ throws_error("Unable to get destination subcollection"))
+})
+
+test_that("move raises exception if new location contains content with the same name", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "animal/dog",
+ "animal/fish/shark",
+ "dog")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ dog <- collection$get("animal/dog")
+
+ expect_that(dog$move("dog"),
+ throws_error("Destination already contains content with same name."))
+
+})
+
+test_that("move moves arvados file inside collection tree", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "animal/dog",
+ "animal/fish/shark",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ dog <- collection$get("animal/dog")
+
+ dog$move("dog")
+ dogIsNullOnOldLocation <- is.null(collection$get("animal/dog"))
+ dogExistsOnNewLocation <- !is.null(collection$get("dog"))
+
+ expect_that(dogIsNullOnOldLocation, is_true())
+ expect_that(dogExistsOnNewLocation, is_true())
+})
--- /dev/null
+source("fakes/FakeRESTService.R")
+
+context("Collection")
+
+test_that(paste("constructor creates file tree from text content",
+ "retreived form REST service"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ root <- collection$get("")
+
+ expect_that(fakeREST$getCollectionContentCallCount, equals(1))
+ expect_that(root$getName(), equals(""))
+})
+
+test_that(paste("add raises exception if passed argumet is not",
+ "ArvadosFile or Subcollection"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ newNumber <- 10
+
+ expect_that(collection$add(newNumber),
+ throws_error(paste("Expected AravodsFile or Subcollection",
+ "object, got (numeric)."), fixed = TRUE))
+})
+
+test_that("add raises exception if relative path is not valid", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ newPen <- ArvadosFile$new("pen")
+
+ expect_that(collection$add(newPen, "objects"),
+ throws_error("Subcollection objects doesn't exist.",
+ fixed = TRUE))
+})
+
+test_that(paste("add adds ArvadosFile or Subcollection",
+ "to local tree structure and remote REST service"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ newDog <- ArvadosFile$new("dog")
+ collection$add(newDog, "animal")
+
+ dog <- collection$get("animal/dog")
+ dogExistsInCollection <- !is.null(dog) && dog$getName() == "dog"
+
+ expect_that(dogExistsInCollection, is_true())
+ expect_that(fakeREST$createCallCount, equals(1))
+})
+
+test_that("create raises exception if passed argumet is not character vector", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ expect_that(collection$create(10),
+ throws_error("Expected character vector, got (numeric).",
+ fixed = TRUE))
+})
+
+test_that("create raises exception if relative path is not valid", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ newPen <- ArvadosFile$new("pen")
+
+ expect_that(collection$create(newPen, "objects"),
+ throws_error("Subcollection objects doesn't exist.",
+ fixed = TRUE))
+})
+
+test_that(paste("create adds files specified by fileNames",
+ "to local tree structure and remote REST service"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ files <- c("dog", "cat")
+ collection$create(files, "animal")
+
+ dog <- collection$get("animal/dog")
+ cat <- collection$get("animal/cat")
+ dogExistsInCollection <- !is.null(dog) && dog$getName() == "dog"
+ catExistsInCollection <- !is.null(cat) && cat$getName() == "cat"
+
+ expect_that(dogExistsInCollection, is_true())
+ expect_that(catExistsInCollection, is_true())
+ expect_that(fakeREST$createCallCount, equals(2))
+})
+
+test_that("remove raises exception if passed argumet is not character vector", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ expect_that(collection$remove(10),
+ throws_error("Expected character vector, got (numeric).",
+ fixed = TRUE))
+})
+
+test_that(paste("remove removes files specified by paths",
+ "from local tree structure and from remote REST service"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "animal/dog",
+ "animal/cat",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ collection$remove(c("animal/dog", "animal/cat"))
+
+ dog <- collection$get("animal/dog")
+ cat <- collection$get("animal/dog")
+ dogExistsInCollection <- !is.null(dog) && dog$getName() == "dog"
+ catExistsInCollection <- !is.null(cat) && cat$getName() == "cat"
+
+ expect_that(dogExistsInCollection, is_false())
+ expect_that(catExistsInCollection, is_false())
+ expect_that(fakeREST$deleteCallCount, equals(2))
+})
+
+test_that(paste("move moves content to a new location inside file tree",
+ "and on REST service"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/dog",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ collection$move("animal/dog", "dog")
+
+ dogIsNullOnOldLocation <- is.null(collection$get("animal/dog"))
+ dogExistsOnNewLocation <- !is.null(collection$get("dog"))
+
+ expect_that(dogIsNullOnOldLocation, is_true())
+ expect_that(dogExistsOnNewLocation, is_true())
+ expect_that(fakeREST$moveCallCount, equals(1))
+})
+
+test_that("move raises exception if new location is not valid", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ expect_that(collection$move("fish", "object"),
+ throws_error("Element you want to move doesn't exist in the collection.",
+ fixed = TRUE))
+})
+
+test_that("getFileListing returns collection content received from REST service", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ contentMatchExpected <- all(collection$getFileListing() ==
+ c("animal", "animal/fish", "ball"))
+
+ expect_that(contentMatchExpected, is_true())
+ #2 calls because Collection$new calls getFileListing once
+ expect_that(fakeREST$getCollectionContentCallCount, equals(2))
+
+})
+
+test_that("get returns arvados file or subcollection from internal tree structure", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ fish <- collection$get("animal/fish")
+ fishIsNotNull <- !is.null(fish)
+
+ expect_that(fishIsNotNull, is_true())
+ expect_that(fish$getName(), equals("fish"))
+})
context("CollectionTree")
-test_that("Creates file tree from character array properly", {
+test_that("constructor creates file tree from character array properly", {
collection <- "myCollection"
characterArray <- c("animal",
context("Subcollection")
-test_that("getRelativePath returns relative path properly", {
+test_that("getRelativePath returns path relative to the tree root", {
animal <- Subcollection$new("animal")
throws_error("Subcollection doesn't belong to any collection"))
})
+test_that("move raises exception if new location contains content with the same name", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "animal/dog",
+ "animal/fish/shark",
+ "fish")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ fish <- collection$get("animal/fish")
+
+ expect_that(fish$move("fish"),
+ throws_error("Destination already contains content with same name."))
+
+})
+
test_that(paste("move raises exception if newLocationInCollection",
"parameter is invalid"), {
api$setRESTService(fakeREST)
collection <- Collection$new(api, "myUUID")
- dog <- collection$get("animal/dog")
+ fish <- collection$get("animal/fish")
- expect_that(dog$move("objects/dog"),
+ expect_that(fish$move("objects/dog"),
throws_error("Unable to get destination subcollection"))
})
projects / arvados.git / commitdiff