#' geojob class
#'
#' contains the information for processing the job, and the versions
#' of the resources used.
#'
#' @slot url URL of web processing endpoint
#' @slot xml XML character for post
#' @slot id job identifier
#' @slot package.version the version of the geoknife package
#' @slot algorithm.version the version of the algorithm used for processing
#' @importFrom utils packageVersion
#' @rdname geojob-class
setClass(
Class = "geojob",
representation = representation(
url = 'character',
xml = 'character',
package.version = 'character',
algorithm.version = 'character',
id = "character")
)
setMethod(f="initialize",signature="geojob",
definition=function(
.Object,
id = '<no active job>',
url = character(0),
algorithm.version = as.character(NULL),
xml = as.character(NA)
){
.Object@xml <- xml
.Object@id <- id
.Object@url <- url
.Object@package.version = as.character(package_version(packageVersion(getPackageName())))
.Object@algorithm.version = algorithm.version
return(.Object)
})
#' create geojob object
#' @description A class representing a geoknife job (\code{geojob}).
#'
#' @return the geojob object
#' @author Jordan S Read
#' @rdname geojob-methods
#' @export
setGeneric("geojob", function(xml, ...) {
standardGeneric("geojob")
})
#'@param ... additional arguments passed to initialize method
#'@rdname geojob-methods
#'@aliases geojob,geojob-method
setMethod("geojob", signature("missing"), function(xml, ...) {
## create new geojob object
geojob <- new("geojob",...)
return(geojob)
})
setOldClass("xml_document")
#' @rdname geojob-methods
#' @aliases geojob,geojob-method
setMethod("geojob", signature("xml_document"), function(xml, ...) {
#slots
xmlText <- toString(xml)
algorithm.version <- xml2::xml_attrs(xml2::xml_root(xml))[['version']]
job <- new("geojob", xml = xmlText,
algorithm.version = algorithm.version, ...)
return(job)
})
#'@param xml location of xml (URL or local path)
#'@rdname geojob-methods
#'@aliases geojob,geojob-method
setMethod("geojob", signature("character"), function(xml, ...) {
#parse based on xml class
if(length(xml == 1) && startsWith(x = xml, prefix= "http")){
response <- gGET(xml)
doc <- gcontent(response)
} else {
doc <- xml2::read_xml(xml)
}
job <- geojob(xml = doc, ...)
return(job)
})
#'@rdname geojob-methods
#'@aliases xml<-,geojob-method
#'@param .Object a \code{\link{geojob}} object
#'@param value a character string of xml
#'@examples
#'xml <- "<foo> <bar> text <baz/> </bar> </foo>"
#'gj <- geojob()
#'xml(gj) <- xml
#'xml(gj)
#'@export
setGeneric(name="xml<-",def=function(.Object, value){standardGeneric("xml<-")})
setMethod(f = "xml<-",signature = "geojob", definition = function(.Object, value){
.Object@xml <- value
return(.Object)
}
)
#'@rdname geojob-methods
#'@aliases xml,geojob-method
#'@examples
#'xml <- "<foo version=\"1.0.0\"> <bar> text <baz/> </bar> </foo>"
#'gj <- geojob(xml = xml)
#'xml(gj)
#'@export
setGeneric(name="xml",def=function(.Object){standardGeneric("xml")})
setMethod(f = "xml",signature = "geojob", definition = function(.Object){
value <- .Object@xml
return(value)
}
)
#'@title process id of geojob
#'@rdname geojob-methods
#'@aliases id,geojob-method
#'@usage
#'id(.Object)
#'id(.Object) <- value
#'@examples
#'id(gj)
#'@export
setGeneric(name="id<-",def=function(.Object, value){standardGeneric("id<-")})
#'@rdname geojob-methods
#'@aliases id,geojob-method
#'@export
setGeneric(name="id",def=function(.Object){standardGeneric("id")})
#'@rdname geojob-methods
#'@aliases id,geojob-method
setMethod(f = "id<-",signature = "geojob", definition = function(.Object, value){
.Object@id <- value
return(.Object)
})
#'@rdname geojob-methods
#'@aliases id,geojob-method
setMethod(f = "id",signature = "geojob", definition = function(.Object){
value <- .Object@id
return(value)
})
#'@rdname geojob-methods
#'@aliases id,geojob-method
setMethod(f = "id",signature = "character", definition = function(.Object){
if (is.geojobID(.Object)){
return(.Object)
} else {
stop(.Object, ' is not a valid geojob id')
}
})
is.geojobID <- function(id){
grepl('?id=', id)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.