#156 upgrade client for new INSPIRE reference validator

DESCRIPTION

@@ -10,7 +10,7 @@ Description: Provides facilities to handle reading and writing of geographic met
  and encoded using the ISO 19139 (XML) standard. It includes also a facility to check
  the validity of ISO 19139 XML encoded metadata.
 Depends: R (>= 3.3.0)
-Imports: methods, R6, XML, httr
+Imports: methods, R6, XML, httr, jsonlite
 Suggests: sf, ncdf4, EML, emld, testthat, roxygen2
 License: MIT + file LICENSE
 URL: https://github.com/eblondel/geometa/wiki

NAMESPACE

@@ -345,6 +345,7 @@ export(setISOMetadataSchemas)
 export(setMappingFormats)
 import(XML)
 import(httr)
+import(jsonlite)
 importFrom(R6,R6Class)
 importFrom(methods,as)
 importFrom(methods,is)

R/INSPIREMetadataValidator.R

@@ -12,6 +12,10 @@
 #'  \item{\code{new()}}{
 #'    This method is used to instantiate an INSPIRE Metadata validator
 #'  }
+#'  \item{\code{uploadFile(path)}}{
+#'    Upload a XML metadata file to INSPIRE web-service. Method called internally through
+#'    \code{getValidationReport}.
+#'  }
 #'  \item{\code{getValidationReport(obj, file, raw)}}{
 #'    Get validation report for a metadata specified either as R object of class
 #'    \code{ISOMetadata} (from \pkg{geometa} package) or \code{XMLInternalNode} 
@@ -29,79 +33,137 @@
 #'  }
 #' 
 #' @references 
-#'   INSPIRE Geoportal Metadata Validator Web Service (http://inspire-geoportal.ec.europa.eu/validator2/html/usingaswebservice.html)
+#'   INSPIRE Reference Validator Web Service (http://inspire.ec.europa.eu/validator/swagger-ui.html)
 #' 
 #' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
 #'
 INSPIREMetadataValidator <- R6Class("INSPIREMetadataValidator",
   inherit = geometaLogger,
   private = list(
-    host = "http://inspire-geoportal.ec.europa.eu",
-    endpoint = "GeoportalProxyWebServices/resources/INSPIREResourceTester"
+    host = "http://inspire.ec.europa.eu",
+    endpoint = "validator/v2"
   ),
   public = list(
     url = NULL,
+    running = FALSE,
     initialize = function(){
       if(!require("httr")){
         stop("The INSPIRE metadata validator requires the installation of 'httr' package")
       }
       self$url <- paste(private$host, private$endpoint, sep = "/")
+      ping <- status_code(GET(paste(self$url, "status", sep = "/")))
+      self$running <- if(ping==200) TRUE else FALSE
+    },
+
+    #uploadFile
+    uploadFile = function(path){
+      req <- POST(
+        sprintf("%s/TestObjects?action=upload", self$url),
+        body = list(fileupload = httr::upload_file(path = path))
+      )
+      if(status_code(req)!=200){
+        errMsg <- sprintf("Error while upload file '%s' to INSPIRE reference validator web-service", path)
+        self$ERROR(errMsg)
+        stop(errMsg)
+      }
+      out <- content(req)
+      return(out)
     },
 
     #getValidationReport
     getValidationReport = function(obj = NULL, file = NULL, raw = FALSE){
 
       #check args & read data
+      xml_file <- NULL
       if(!is.null(obj)){
+        xml_file <- tempfile(fileext = ".xml")
         if(!is(obj, "ISOMetadata") && !is(obj, "XMLInternalNode")){
           stop("'obj' should be an object of class 'ISOMetadata' (from 'geometa') or 'XMLInternalNode' (from 'XML')")
         }
         if(is(obj,"ISOMetadata")){
-          xml <- obj$encode(validate = FALSE)
+          obj$save(xml_file, validate = FALSE)
         }else{
-          xml <- obj
+          XML::saveXML(xml, file = xml_file)
         }
       }else{
         if(!is.null(file)){
-          xml <- try(XML::xmlParse(file))
-          if(class(xml)=="try-error"){
-            stop("Error while parsing XML file")
-          }
+          xml_file <- file
         }else{
           stop("Either object (XML or geometa) or XML file should be provided")
         }
       }
 
+      #upload file
+      uploaded <- self$uploadFile(path = xml_file)
+
       #post metadata XML to INSPIRE web-service
       self$INFO("Sending metadata file to INSPIRE metadata validation web-service...")
       req <- httr::POST(
-        url = self$url,
+        url = sprintf("%s/TestRuns", self$url),
         httr::add_headers(
           "User-Agent" = paste("geometa/",as.character(packageVersion("geometa")),sep=""),
-          "Accept" = "application/json",
-          "Content-Type" = "text/plain"
+          "Content-Type" = "application/json"
         ),
-        body = as(xml, "character")
+        body = jsonlite::toJSON(list(
+          label = unbox("Test run for ISO/TC 19139:2007 based INSPIRE metadata records."),
+          executableTestSuiteIds = "EID59692c11-df86-49ad-be7f-94a1e1ddd8da",
+          arguments = list(
+            files_to_test = unbox(".*"),
+            tests_to_execute = unbox(".*")
+          ),
+          testObject = list(
+            id = unbox(unlist(strsplit(uploaded$testObject$id, "EID"))[2])
+          )
+        ), auto_unbox = FALSE)
       )
+
+      resp <- NULL
       if(httr::status_code(req)!=201){
-        errorMsg <- "Error during communication with INSPIRE validation web-service!"
+        errorMsg <- "Error while creating INSPIRE validation  Test run!"
         self$INFO(errorMsg)
         stop(errorMsg)
       }else{
-        self$INFO("INSPIRE metadata validation test done!")
+        self$INFO("INSPIRE metadata validation test...")
+        pb <- txtProgressBar(min = 0, max = 100, style = 3)
+        resp <- content(req)$EtfItemCollection
+        testRunId <- resp$testRuns$TestRun$id
+        progress <- 0
+        while(progress < 100){
+          prog_req <- httr::GET(sprintf("%s/TestRuns/%s/progress", self$url, testRunId))
+          if(status_code(prog_req)!=200){
+            errMsg <- sprintf("Error while getting progress for Test Run '%s'", testRunId)
+            #self$ERROR(errMsg)
+            stop(errMsg)
+          }
+          progress <- round(as.integer(content(prog_req)$val) / as.integer(content(prog_req)$max) * 100, 2)
+          setTxtProgressBar(pb, value = progress)
+          Sys.sleep(1)
+        }
+        close(pb)
+        cat("\n")
+        self$INFO("INSPIRE validation test run completed!")
       }
-      loc <- httr::headers(req)$location
-      resp <- content(req)$value
-      resp$CompletenessIndicator <- round(resp$CompletenessIndicator,2)
-      resp$InteroperabilityIndicator <- round(resp$InteroperabilityIndicator,2)
+      #report content
+      resp <- jsonlite::read_json(resp$ref)
+      resp <- resp$EtfItemCollection
+
+      sections <- resp$referencedItems$testTaskResults$TestTaskResult$testModuleResults$TestModuleResult$testCaseResults$TestCaseResult
+      result_status <- do.call("rbind", lapply(sections, function(section){
+        status <- sapply(section$testStepResults$TestStepResult$testAssertionResults$TestAssertionResult, function(x){x$status})
+        status <- as.data.frame(table(status), stringsAsFactors =  FALSE)
+        return(status)
+      }))
+      result_status <- aggregate(.~status, data = result_status, FUN = sum)
+      failed <- result_status[result_status$status=="FAILED", "Freq"]
+      passed <- result_status[result_status$status=="PASSED", "Freq"]
+      completeness <- passed / sum(result_status$Freq) * 100
       report <- list(
-        url = loc,
-        creationDate = as.POSIXct(resp$AuditRecord$CreationDate/1000, origin = "1970-01-01"),
-        lastUpdateDate = as.POSIXct(resp$AuditRecord$LastUpdateDate/1000, origin = "1970-01-01"),
-        validity = list(
-          completeness = list(percentage = resp$CompletenessIndicator, status = resp$CompletenessIndicator == 100),
-          interoperability = list(percentage = resp$InteroperabilityIndicator, status = resp$InteroperabilityIndicator == 100)
-        )
+        "Status" = resp$testRuns$TestRun$status,
+        "Completeness" = paste0(completeness,"% (", passed," PASSED, ", failed," FAILED)"),
+        "Test Run ID" = resp$testRuns$TestRun$id,
+        "Log" = resp$testRuns$TestRun$logPath,
+        "Ref URI" = resp$ref,
+        "HTML Report" = gsub(".json", ".html", resp$ref)
       )
       if(raw) report$raw <- resp
       return(report)

R/ISOAbstractObject.R

@@ -8,6 +8,7 @@
 #' @importFrom utils read.csv
 #' @import XML
 #' @import httr
+#' @import jsonlite
 #' @export
 #' @keywords ISO metadata element
 #' @return Object of \code{\link{R6Class}} for modelling an ISO Metadata Element
@@ -162,19 +163,16 @@ ISOAbstractObject <- R6Class("ISOAbstractObject",
     system_fields = c("wrap", "valueDescription",
                       "element", "namespace", "defaults", "attrs", "printAttrs",
                       "codelistId", "measureType", "isNull", "anyElement"),
-    xmlComments = function(isoCompliant = NA,
-                           inspireCompliant = NA, inspireCompleteness = NA, inspireReportURL = NA){
+    xmlComments = function(isoCompliant = NA, inspireReport = NULL){
       comments <- list()
       geometa <- packageDescription("geometa")
       title <- paste0("ISO 19139 XML generated by geometa R package - Version ", geometa$Version)
 
       isISOCompliant <- ifelse(is.na(isoCompliant),"NOT TESTED", ifelse(isoCompliant, "YES", "NO"))
       ISOCompliance <- paste0("ISO 19139 XML compliance: ", isISOCompliant)
 
-      isINSPIRECompliant <- ifelse(is.na(inspireCompliant), "NOT TESTED", ifelse(inspireCompliant, "YES", "NO"))
+      isINSPIRECompliant <- ifelse(is.null(inspireReport), "NOT TESTED", ifelse(inspireReport$Status=="PASSED", "YES", "NO"))
       INSPIRECompliance <- paste0("INSPIRE compliance: ", isINSPIRECompliant)
-      INSPIRECompleteness <- paste0("INSPIRE completeness: ", inspireCompleteness, "%")
-      INSPIREReport <- paste0("INSPIRE Report: ", inspireReportURL)
 
       createdOn <- paste0("Metadata Creation date/time: ", format(Sys.time(), "%Y-%m-%dT%H:%M:%S"))
       geometaAuthor <- gsub(">","",gsub("<","",unlist(strsplit(as.character(eval(parse(text=geometa$Authors)))," \\["))[1]))
@@ -185,10 +183,14 @@ ISOAbstractObject <- R6Class("ISOAbstractObject",
       comments[[idx]] <- createdOn; idx <- idx+1
       comments[[idx]] <- title; idx <- idx+1
       comments[[idx]] <- ISOCompliance; idx <- idx+1
-      if(!is.na(inspireCompliant)){
+      if(!is.null(inspireReport)){
         comments[[idx]] <- INSPIRECompliance; idx <- idx+1
-        comments[[idx]] <- INSPIRECompleteness;idx <- idx+1
-        comments[[idx]] <- INSPIREReport;idx <- idx+1
+        for(inspireAttr in names(inspireReport)){
+          if(!(inspireAttr %in% c("raw", "status"))){
+            comments[[idx]] <- sprintf("INSPIRE %s : %s", inspireAttr, inspireReport[[inspireAttr]])
+            idx <- idx+1
+          }
+        }
       }
       comments[[idx]] <- paste("geometa R package information:", author, infoPage, bugReport, sep="\n")
       return(comments)
@@ -932,11 +934,7 @@ ISOAbstractObject <- R6Class("ISOAbstractObject",
         if(!inspire){
           header_comments <- private$xmlComments(compliant)
         }else{
-          header_comments <- private$xmlComments(compliant$ISO,
-                              compliant$INSPIRE$validity$completeness$status, 
-                              compliant$INSPIRE$validity$completeness$percentage,
-                              compliant$INSPIRE$url
-                             )
+          header_comments <- private$xmlComments(compliant$ISO, compliant$INSPIRE)
         }
         #process XML comments
         for(comment in header_comments){
@@ -999,11 +997,17 @@ ISOAbstractObject <- R6Class("ISOAbstractObject",
 
       if(inspire){
         inspireValidator <- INSPIREMetadataValidator$new()
-        inspireReport <- inspireValidator$getValidationReport(obj = self)
-        isValid <- list(
-          ISO = isValid,
-          INSPIRE = inspireReport
-        )        
+        if(!inspireValidator$running){
+          self$WARN("INSPIRE Reference validator web-service is currently down. Skipping INSPIRE validation")
+          inspire <- FALSE
+        }
+        if(inspire){
+          inspireReport <- inspireValidator$getValidationReport(obj = self)
+          isValid <- list(
+            ISO = isValid,
+            INSPIRE = inspireReport
+          )
+        }
       }
 
       return(isValid)

inst/extdata/examples/metadata.xml

@@ -1,15 +1,4 @@
 <?xml version="1.0"?>
-<!-- 
-	Creation date/time: 2017-06-16T01:52:40
-	ISO 19139 XML generated by 'geometa' R package - Version 0.2-0
-	ISO 19139 XML compliance: YES
--->
-<!-- 
-	geometa R package information
-	Contact: Emmanuel Blondel <emmanuel.blondel1@gmail.com>
-	URL: https://github.com/eblondel/geometa/wiki
-	BugReports: https://github.com/eblondel/geometa/issues
--->
 <gmd:MD_Metadata xmlns:gco="http://www.isotc211.org/2005/gco" xmlns:gfc="http://www.isotc211.org/2005/gfc" xmlns:gmd="http://www.isotc211.org/2005/gmd" xmlns:gmi="http://www.isotc211.org/2005/gmi" xmlns:gts="http://www.isotc211.org/2005/gts" xmlns:srv="http://www.isotc211.org/2005/srv" xmlns:gml="http://www.opengis.net/gml/3.2">
   <gmd:fileIdentifier>
     <gco:CharacterString>my-metadata-identifier</gco:CharacterString>