R/01-geojob-obj.R

In USGS-R/geoknife: Web-Processing of Large Gridded Datasets

#' 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)
}