as.numeric(sizes)
},
- removeFromCollection = function()
+ get = function(fileLikeObjectName)
{
- if(is.null(private$collection))
- stop("ArvadosFile doesn't belong to any collection.")
-
- private$collection$.__enclos_env__$private$deleteFromREST(self$getRelativePath())
+ return(NULL)
+ },
- private$addToCollection(NULL)
- private$detachFromParent()
+ getFirst = function()
+ {
+ return(NULL)
+ },
- "Content removed successfully."
+ getCollection = function() private$collection,
+
+ setCollection = function(collection)
+ {
+ private$collection <- collection
},
getRelativePath = function()
getParent = function() private$parent,
+ setParent = function(newParent) private$parent <- newParent,
+
read = function(contentType = "raw", offset = 0, length = 0)
{
if(is.null(private$collection))
move = function(newLocation)
{
+ #todo test if file can be moved
+
if(is.null(private$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, "/")))
+ nchar(newLocation)
+ - nchar(paste0(private$name, "/")))
}
else if(endsWith(newLocation, private$name))
{
- newLocation <- substr(newLocation, 0, nchar(newLocation) - nchar(private$name))
+ newLocation <- substr(newLocation, 0,
+ nchar(newLocation) - nchar(private$name))
}
else
{
stop("Unable to get destination subcollection.")
}
- status <- private$collection$.__enclos_env__$private$moveOnREST(self$getRelativePath(),
- paste0(newParent$getRelativePath(), "/", self$getName()))
+ childWithSameName <- newParent$get(private$name)
+
+ if(!is.null(childWithSameName))
+ stop("Destination already contains file with same name.")
- private$attachToParent(newParent)
+ status <- private$collection$moveOnREST(self$getRelativePath(),
+ paste0(newParent$getRelativePath(),
+ "/", self$getName()))
+
+ #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
"Content moved successfully."
}
parent = NULL,
collection = NULL,
http = NULL,
- httpParser = NULL,
-
- getChild = function(name)
- {
- return(NULL)
- },
-
- getFirstChild = function()
- {
- return(NULL)
- },
-
- addToCollection = function(collection)
- {
- private$collection <- collection
- },
-
- detachFromParent = function()
- {
- if(!is.null(private$parent))
- {
- 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
- }
+ httpParser = NULL
),
cloneable = FALSE
relativePath == "." ||
relativePath == "./")
{
- subcollection <- private$tree$.__enclos_env__$private$tree
+ subcollection <- private$tree$getTree()
}
else
{
relativePath == "." ||
relativePath == "./")
{
- subcollection <- private$tree$.__enclos_env__$private$tree
+ subcollection <- private$tree$getTree()
}
else
{
arvadosFiles <- NULL
sapply(fileNames, function(fileName)
{
+ childWithSameName <- subcollection$get(fileName)
+ if(!is.null(childWithSameName))
+ stop("Destination already contains file with same name.")
+
newFile <- ArvadosFile$new(fileName)
subcollection$add(newFile)
if(is.null(file))
stop(paste("File", filePath, "doesn't exist."))
- file$removeFromCollection()
+ parent <- file$getParent()
+ parent$remove(filePath)
})
}
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)
+ if(is.null(content$getCollection()) ||
+ content$getCollection()$uuid != self$uuid)
stop("Subcollection doesn't belong to this collection.")
content$removeFromCollection()
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]
},
-
+
+ #Todo: Move these methods to another class.
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)
+ self$createNewFile(filePath, NULL, "text/html")
})
},
print(paste("File created:", relativePath))
},
-
+
deleteFromREST = function(relativePath)
{
fileURL <- paste0(self$api$getWebDavHostName(), "c=", self$uuid, "/", 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]
+ },
+
+ generateTree = function(content)
+ {
+ treeBranches <- sapply(collectionContent, function(filePath)
+ {
+ splitPath <- unlist(strsplit(filePath$name, "/", fixed = TRUE))
+
+ branch = private$createBranch(splitPath, filePath$fileSize)
+ })
+ }
+ ),
+
cloneable = FALSE
)
treeBranches <- sapply(fileContent, function(filePath)
{
splitPath <- unlist(strsplit(filePath, "/", fixed = TRUE))
- branch = private$createBranch(splitPath)
+ branch <- private$createBranch(splitPath)
})
root <- Subcollection$new("")
private$addBranch(root, branch)
})
- root$.__enclos_env__$private$addToCollection(collection)
+ root$setCollection(collection)
private$tree <- root
},
relativePath <- substr(relativePath, 0, nchar(relativePath) - 1)
splitPath <- unlist(strsplit(relativePath, "/", fixed = TRUE))
- returnElement = private$tree
+ returnElement <- private$tree
for(pathFragment in splitPath)
{
- returnElement = returnElement$.__enclos_env__$private$getChild(pathFragment)
+ returnElement <- returnElement$get(pathFragment)
if(is.null(returnElement))
return(NULL)
}
returnElement
- }
+ },
+
+ getTree = function() private$tree
),
private = list(
{
if(elementIndex == lastElementIndex)
{
- branch = ArvadosFile$new(splitPath[[elementIndex]])
+ branch <- ArvadosFile$new(splitPath[[elementIndex]])
}
else
{
- newFolder = Subcollection$new(splitPath[[elementIndex]])
+ newFolder <- Subcollection$new(splitPath[[elementIndex]])
newFolder$add(branch)
- branch = newFolder
+ branch <- newFolder
}
}
addBranch = function(container, node)
{
- child = container$.__enclos_env__$private$getChild(node$getName())
+ child <- container$get(node$getName())
if(is.null(child))
{
child = private$replaceFileWithSubcollection(child)
}
- private$addBranch(child, node$.__enclos_env__$private$getFirstChild())
+ private$addBranch(child, node$getFirst())
}
},
replaceFileWithSubcollection = function(arvadosFile)
{
subcollection <- Subcollection$new(arvadosFile$getName())
- fileParent <- arvadosFile$.__enclos_env__$private$parent
- fileParent$.__enclos_env__$private$removeChild(arvadosFile$getName())
+ fileParent <- arvadosFile$getParent()
+ fileParent$remove(arvadosFile$getName())
fileParent$add(subcollection)
- arvadosFile$.__enclos_env__$private$parent <- NULL
+ arvadosFile$setParent(NULL)
subcollection
}
},
PUT = function(url, headers = NULL, body = NULL,
- queryFilters = NULL, limit = 100, offset = 0)
+ queryFilters = NULL, limit = NULL, offset = NULL)
{
headers <- httr::add_headers(unlist(headers))
query <- private$createQuery(queryFilters, limit, offset)
url <- paste0(url, query)
+ print(url)
serverResponse <- httr::PUT(url = url, config = headers, body = body)
},
POST = function(url, headers = NULL, body = NULL,
- queryFilters = NULL, limit = 100, offset = 0)
+ queryFilters = NULL, limit = NULL, offset = NULL)
{
headers <- httr::add_headers(unlist(headers))
query <- private$createQuery(queryFilters, limit, offset)
finalQuery <- paste0(finalQuery, collapse = "&")
}
- finalQuery <- paste0("/?", finalQuery)
+ if(!is.null(finalQuery))
+ finalQuery <- paste0("/?", finalQuery)
finalQuery
}
private$http <- HttpRequest$new()
private$httpParser <- HttpParser$new()
},
+
+ getName = function() private$name,
+ getRelativePath = function()
+ {
+ relativePath <- c(private$name)
+ parent <- private$parent
+
+ while(!is.null(parent))
+ {
+ relativePath <- c(parent$getName(), relativePath)
+ parent <- parent$getParent()
+ }
+
+ relativePath <- relativePath[relativePath != ""]
+ paste0(relativePath, collapse = "/")
+ },
+
add = function(content)
{
if("ArvadosFile" %in% class(content) ||
"Subcollection" %in% class(content))
{
- if(!is.null(content$.__enclos_env__$private$collection))
- stop("ArvadosFile/Subcollection already belongs to a collection.")
-
- childWithSameName <- private$getChild(content$getName())
+ childWithSameName <- self$get(content$getName())
if(!is.null(childWithSameName))
stop("Subcollection already contains ArvadosFile
or Subcollection with same name.")
if(!is.null(private$collection))
{
- contentPath <- paste0(self$getRelativePath(),
- "/", content$getFileListing())
-
- private$collection$.__enclos_env__$private$createFilesOnREST(contentPath)
- content$.__enclos_env__$private$addToCollection(private$collection)
+ if(self$getRelativePath() != "")
+ contentPath <- paste0(self$getRelativePath(),
+ "/", content$getFileListing())
+ else
+ contentPath <- content$getFileListing()
+
+ private$collection$createFilesOnREST(contentPath)
+ content$setCollection(private$collection)
}
private$children <- c(private$children, content)
- content$.__enclos_env__$private$parent = self
+ content$setParent(self)
"Content added successfully."
}
}
},
- removeFromCollection = function()
+ remove = function(name)
{
- if(is.null(private$collection))
- stop("Subcollection doesn't belong to any collection.")
+ if(is.character(name))
+ {
+ child <- self$get(name)
- if(private$name == "")
- stop("Unable to delete root folder.")
+ if(is.null(child))
+ stop("Subcollection doesn't contains ArvadosFile
+ or Subcollection with same name.")
- collectionList <- paste0(self$getRelativePath(),
- "/", self$getFileListing(fullpath = FALSE))
- sapply(collectionList, function(file)
- {
- private$collection$.__enclos_env__$private$deleteFromREST(file)
- })
+ if(!is.null(private$collection))
+ {
+ private$collection$deleteFromREST(child$getRelativePath())
+ child$setCollection(NULL)
+ }
- private$addToCollection(NULL)
- private$dettachFromParent()
+ private$removeChild(name)
+ child$setParent(NULL)
- "Content removed successfully."
+ "Content removed"
+ }
+ else
+ {
+ stop(paste("Expected character, got", class(content), "."))
+ }
},
getFileListing = function(fullpath = TRUE)
sum(sizes)
},
- getName = function() private$name,
-
- getRelativePath = function()
- {
- relativePath <- c(private$name)
- parent <- private$parent
-
- while(!is.null(parent))
- {
- relativePath <- c(parent$getName(), relativePath)
- parent <- parent$getParent()
- }
-
- relativePath <- relativePath[relativePath != ""]
- paste0(relativePath, collapse = "/")
- },
-
move = function(newLocation)
{
if(is.null(private$collection))
stop("Unable to get destination subcollection.")
}
- status <- private$collection$.__enclos_env__$private$moveOnREST(self$getRelativePath(),
- paste0(newParent$getRelativePath(), "/", self$getName()))
+ status <- private$collection$moveOnREST(self$getRelativePath(),
+ paste0(newParent$getRelativePath(),
+ "/", self$getName()))
- private$attachToParent(newParent)
+ #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)
- "Content moved successfully."
- },
+ newParent$add(self)
- getParent = function() private$parent
- ),
+ newParent$setCollection(parentsCollection, setRecursively = FALSE)
- private = list(
+ private$parent <- newParent
- name = NULL,
- children = NULL,
- parent = NULL,
- collection = NULL,
- http = NULL,
- httpParser = NULL,
+ "Content moved successfully."
+ },
- getChild = function(name)
+ get = function(name)
{
for(child in private$children)
{
return(NULL)
},
- getFirstChild = function()
+ getFirst = function()
{
if(length(private$children) == 0)
return(NULL)
private$children[[1]]
},
+ setCollection = function(collection, setRecursively = TRUE)
+ {
+ private$collection = collection
+
+ if(setRecursively)
+ {
+ for(child in private$children)
+ child$setCollection(collection)
+ }
+ },
+
+ getCollection = function() private$collection,
+
+ getParent = function() private$parent,
+
+ setParent = function(newParent) private$parent <- newParent
+ ),
+
+ private = list(
+
+ name = NULL,
+ children = NULL,
+ parent = NULL,
+ collection = NULL,
+ http = NULL,
+ httpParser = NULL,
+
removeChild = function(name)
{
numberOfChildren = length(private$children)
}
}
}
- },
-
- addToCollection = function(collection)
- {
- for(child in private$children)
- child$.__enclos_env__$private$addToCollection(collection)
-
- private$collection = collection
- },
-
- 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)
- {
- if(private$name != "")
- {
- parent$.__enclos_env__$private$children <- c(parent$.__enclos_env__$private$children, self)
- private$parent <- parent
- }
}
),
projects / arvados.git / commitdiff