Skip to content
This repository has been archived by the owner on Oct 12, 2023. It is now read-only.

Commit

Permalink
add deleteJob to delete both job defintion and job result
Browse files Browse the repository at this point in the history
  • Loading branch information
zfengms committed Oct 24, 2017
1 parent 2106f23 commit 6c2fd92
Show file tree
Hide file tree
Showing 6 changed files with 114 additions and 3 deletions.
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
# Generated by roxygen2: do not edit by hand

export(createOutputFile)
export(deleteJob)
export(deleteStorageContainer)
export(deleteStorageFile)
export(generateClusterConfig)
Expand Down
2 changes: 2 additions & 0 deletions R/doAzureParallel.R
Original file line number Diff line number Diff line change
Expand Up @@ -399,6 +399,8 @@ setHttpTraffic <- function(value = FALSE) {
stop("The specified job already exists.")
}

saveMetadataBlob(id, metadata)

break

},
Expand Down
5 changes: 4 additions & 1 deletion R/storage_management.R
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,10 @@ deleteStorageContainer <- function(container) {
rAzureBatch::deleteContainer(container, content = "response")

if (response$status_code == 202) {
cat(sprintf("Your container '%s' has been deleted.", container),
cat(sprintf("Your storage container '%s' has been deleted.", container),
fill = TRUE)
} else if (response$status_code == 404) {
cat(sprintf("storage container '%s' does not exist.", container),
fill = TRUE)
}

Expand Down
79 changes: 78 additions & 1 deletion R/utility.R
Original file line number Diff line number Diff line change
Expand Up @@ -56,6 +56,34 @@ linuxWrapCommands <- function(commands = c()) {
commandLine
}

#' Delete a job
#'
#' @param jobId A job id
#' @param deleteResult TRUE to delete job result in storage blob
#' container, FALSE to keep the result in storage blob container.
#'
#' @examples
#' \dontrun{
#' deleteJob("job-001")
#' deleteJob("job-001", deleteResult = FALSE)
#' }
#' @export
deleteJob <- function(jobId, deleteResult = TRUE) {
if (deleteResult == TRUE) {
deleteStorageContainer(jobId)
}

response <- rAzureBatch::deleteJob(jobId, content = "response")

if (response$status_code == 202) {
cat(sprintf("Your job '%s' has been deleted.", jobId),
fill = TRUE)
} else if (response$status_code == 404) {
cat(sprintf("Job '%s' does not exist.", jobId),
fill = TRUE)
}
}

#' Get a list of job statuses from the given filter
#'
#' @param filter A filter containing job state
Expand Down Expand Up @@ -351,7 +379,14 @@ getJobResult <- function(jobId) {
stop("jobId must contain at least 3 characters.")
}

tempFile <- tempFile <- tempfile("getJobResult", fileext = ".rds")
metadata <- readMetadataBlob(jobId)

if (metadata$enableCloudCombine == "FALSE" ) {
cat("enalbeCloudCombine is set to FALSE, no job merge result is available", fill = TRUE)
return()
}

tempFile <- tempfile("getJobResult", fileext = ".rds")

results <- rAzureBatch::downloadBlob(
jobId,
Expand Down Expand Up @@ -573,6 +608,48 @@ getXmlValues <- function(xmlResponse, xmlPath) {
xml2::xml_text(xml2::xml_find_all(xmlResponse, xmlPath))
}

saveMetadataBlob <- function(jobId, metadata) {
xmlNode <- "<metadata>"
if (length(metadata) > 0) {
for (i in 1:length(metadata)) {
xmlNode <-
paste0(xmlNode,
sprintf("<%s>%s</%s>", metadata[[i]]$name, metadata[[i]]$value, metadata[[i]]$name))
}
}
xmlNode <- paste0(xmlNode, "</metadata>")
saveXmlBlob(jobId, xmlNode, "metadata")
}

saveXmlBlob <- function(jobId, xmlBlock, name) {
xmlFile <- paste0(jobId, "-", name, ".rds")
saveRDS(xmlBlock, file = xmlFile)
rAzureBatch::uploadBlob(jobId, paste0(getwd(), "/", xmlFile))
file.remove(xmlFile)
}

readMetadataBlob <- function(jobId) {
# xmlResponse <-
# rAzureBatch::listBlobs(jobId , paste0(jobId, "-metadata.rds"), content = "parsed")
tempFile <- tempfile(paste0(jobId, "-metadata"), fileext = ".rds")
result <- rAzureBatch::downloadBlob(
jobId,
paste0(jobId, "-metadata.rds"),
downloadPath = tempFile,
overwrite = TRUE
)
result <- readRDS(tempFile)
result <- xml2::as_xml_document(result)
chunkSize <- getXmlValues(result, ".//chunkSize")
packages <- getXmlValues(result, ".//packages")
errorHandling <- getXmlValues(result, ".//errorHandling")
enableCloudCombine <- getXmlValues(result, ".//enableCloudCombine")

metadata <- list(chunkSize = chunkSize, packages = packages, errorHandling = errorHandling, enableCloudCombine = enableCloudCombine)

metadata
}

areShallowEqual <- function(a, b) {
!is.null(a) && !is.null(b) && a == b
}
7 changes: 6 additions & 1 deletion docs/31-long-running-job.md
Original file line number Diff line number Diff line change
Expand Up @@ -83,7 +83,12 @@ Once job is completed successfully, you can call getJobResult to retrieve the jo

Once you get the job result, you can delete the job.
```R
rAzureBatch::deleteJob(jobId)
deleteJob(jobId)
```

Please note deleteJob will delete the job at batch service, by default, it also deletes the storage container holding the job result. If you want to keep the job result around, you can set deleteResult parameter to FALSE
```R
deleteJob(jobId, deleteResult = FALSE)
```

A [working sample](../samples/long_running_job/long_running_job.R) can be found in the samples directory.
23 changes: 23 additions & 0 deletions man/deleteJob.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 comment on commit 6c2fd92

@lintr-bot
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

R/doAzureParallel.R:372:35: style: Put spaces around all infix operators.

metadata[[metadataCount]] <-packagesKeyValuePair
                                  ^~~

R/utility.R:384:45: style: Do not place spaces around code in parentheses or square brackets.

if (metadata$enableCloudCombine == "FALSE" ) {
                                            ^

R/utility.R:633:7: style: Commented code should be removed.

#   rAzureBatch::listBlobs(jobId , paste0(jobId, "-metadata.rds"), content = "parsed")
      ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/utility.R:648:1: style: Lines should not be more than 120 characters.

metadata <- list(chunkSize = chunkSize, packages = packages, errorHandling = errorHandling, enableCloudCombine = enableCloudCombine)
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

tests/testthat/test-long-running-job.R:17:4: style: Commented code should be removed.

#options <- list(wait = FALSE, job = 'myjob')
   ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Please sign in to comment.