R/robustXMLparse.R

In heibl/megaptera: MEGAPhylogeny Techniques in R

## This code is part of the megaptera package
## © C. Heibl 2014 (last update 2017-01-25)

#' @export
#' @import RCurl
#' @import XML

robustXMLparse <- function(url, trial = 3, logfile){
  
  ## 1. try to parse XML trial times
  ## -------------------------------
  for (i in 1:trial){
    err <- try(silent = TRUE,
               xml <- xmlTreeParse(getURL(url), getDTD = FALSE, 
                                   useInternalNodes = TRUE))
    if ( "try-error" %in% class(err) ){
      slog("\n.. trial", i, "FAILED:", err, file = logfile)
    } else break
  } 
  if ("try-error" %in% class(err)){
    warning(err)
    return(NULL)
  }
  # saveXML(xml, "robustXMLparse-DEBUG.xml"); system("open -t robustXMLparse-DEBUG.xml")
  
  ## 2. return NULL if 'resources temporarily unavailable'
  ## -----------------------------------------------------
  for (i in 1:trial){
    err <- xpathSApply(xml, "/GBSet/Error", xmlValue)
    if (length(err)) {
      slog("\n.. trial", i, "FAILED:", err, file = logfile)
    } else break 
  }
  if (length(err)) {
    warning(err)
    return(NULL)
  }
  
  ## 3. return NULL when results are empty
  ## -------------------------------------
  ERROR <- xpathSApply(xml, fun = xmlValue, path = "//ERROR")
  if (length(ERROR)){
    slog("\n.. FAILED:", ERROR, "..", file = logfile)
    return(NULL)
  } 
  xml
}