DEV/ORIG_AQUO_NL/GetDomainTableChanges.R

In RedTent/aquodom: Access to Aquo domaintables from R (Dutch)

GetDomainTableChanges <- function(pDomeintabel,pCheckDate=toString(Sys.Date())) {
  message(paste("pCheckDate",pCheckDate))
  library(jsonlite)
  library(httr)
  library(RCurl)
  
  maakTekstURL <- function(tekstURL,categorie,beperking,kenmerken,opmaak){
    returnstring <- paste(tekstURL,categorie,beperking,kenmerken,opmaak,sep="")
    return (returnstring)
  }
  
  bewerkDatum  <- function(pDatum){
    lDatum <- substring(toString(pDatum),3,nchar(pDatum))
    if (nchar(lDatum) > 10) {
      lDatum <- substring(toString(lDatum),1,nchar(lDatum)-2)
      lDatum <- toString(lubridate::parse_date_time(lDatum,orders="ymdHMS"))
    }
    else {
      lDatum <- str_replace(lDatum,"/0/0/0/0","")
      lDatum <- toString(lubridate::parse_date_time(lDatum,orders="ymd"))
    }
    return(lDatum)
  }
  
  domeinTabel <- NULL
  tekstUrl <- "https://www.aquo.nl/index.php"
  lStartPage <- 0
  lLimit <- 1
  curl <- getCurlHandle()
  opmaakJson <- paste("/format=json/link=none/headers=show/searchlabel=JSON/class=sortable+wikitable+smwtable"
                      ,"/theme=bootstrap/offset=0/limit=1"
                      ,"/mainlabel=/prettyprint=true/unescape=true"
                      ,sep="")
  
  categorie <- "?title=Speciaal:Vragen&x=-5B-5BElementtype%3A%3ADomeintabel%20%7C%7C%20Domeintabeltechnisch%20%7C%7C%20Domeintabelverzamellijst-5D-5D-20"
  kenmerken <- "%2F-3FElementtype%2F-3FVoorkeurslabel%2F-3FMetadata"
  beperking <- paste("-5B-5BVoorkeurslabel%3A%3A",pDomeintabel,sep = "")
  json_file <- maakTekstURL(tekstUrl,categorie,beperking,kenmerken,opmaakJson)
  #message(json_file)
  req <- httr::GET(json_file, curl=curl)
  
  if (req$status_code == 200 && length(req$content) > 0) {
    domeinTabel <- jsonlite::fromJSON(httr::content(req, "text", encoding="UTF-8"))$results
    
    domeinwaardeCategorie <- NULL
    domeinwaardeCategorie["Domeintabel"]              <- "Domeinwaarden"
    domeinwaardeCategorie["Domeintabeltechnisch"]     <- "DomeinwaardenTechnisch"
    domeinwaardeCategorie["Domeintabelverzamellijst"] <- "Domeinwaarden"
    
    lAantalDomTabellen <- length(domeinTabel)
    if (lAantalDomTabellen == 1) {
      domeinGuid <- domeinTabel[[1]]$fulltext
      domeinElementtype <- domeinTabel[[1]]$printouts$Elementtype$fulltext
      
      # Bepalen Metadata van de domeintabel
      lMetadata <- NULL
      for (i in 1:length(domeinTabel[[1]]$printouts$Metadata) ) {
        lMetadata[i] <- domeinTabel[[1]]$printouts$Metadata[i]
        #message(paste("Metadata:",lMetadata[i]))
      }
      if (!("Status" %in% lMetadata)) lMetadata[length(lMetadata)+1] <- "Status"
      if (!("Wijzigingsnummer" %in% lMetadata)) lMetadata[length(lMetadata)+1] <- "Wijzigingsnummer"
      lMetadata[length(lMetadata)+1] <- "Wijzigingsdatum"
      
      lTypeTabel <- paste("-5B-5BElementtype%3A%3A",domeinElementtype,"-5D-5D-20",sep = "")
      beperking <- paste("-5B-5BBreder%3A%3A",gsub("-","-2D",domeinGuid),"-5D-5D"
                         ,"-5B-5BWijzigingsdatum::>=",gsub("-","-2D",pCheckDate),"-5D-5D"
                         ,sep = "")
      categorie <- paste("?title=Speciaal:Vragen&x=-5B-5BCategorie%3A",
                         domeinwaardeCategorie[domeinElementtype],"-5D-5D-20",sep = "")
      
      kenmerken <- NULL
      for (i in 1:length(lMetadata)) kenmerken <- paste(kenmerken,"%2F-3F",lMetadata[i],sep="")
      columnNames <- list()
      for (i in 1:length(lMetadata)) columnNames[[i]] <- lMetadata[i]
      columnNames[[length(columnNames)+1]] <- "Guid"
      domValuesDFloc <- data.frame(matrix(ncol = length(lMetadata)+1, nrow = 0))
      colnames(domValuesDFloc) <- columnNames
      
      lOffset <- 0
      lLimit <- 500
      lDoorgaan <- TRUE
      while (lDoorgaan) {
        opmaakJson <- paste("/format%3Djson/link%3Dall/headers%3Dshow/searchlabel=JSON/class=sortable-20wikitable-20smwtable"
                            ,"/sort%3DWijzigingsdatum/order%3Dasc"
                            ,"/theme=bootstrap/offset=",lOffset,"/limit=",lLimit
                            ,"/mainlabel=/prettyprint=true/unescape=true"
                            ,sep="")
        json_file <- maakTekstURL(tekstUrl,categorie,beperking,kenmerken,opmaakJson)
        #message(paste("Domeinwaarden:",json_file))
        req <- httr::GET(json_file, curl=curl)
        if (req$status_code == 200 && length(req$content) > 0) {
          gevonden <- TRUE
          tryCatch(
            {
              domValuesJson <- jsonlite::fromJSON(httr::content(req, "text", encoding="UTF-8"))$results
              #message(length(domValuesJson))
              message(paste(toString(Sys.time()),"Aantal waarden opgehaald:",length(domValuesJson)+lOffset, sep = " "))
            },
            warning = function(w){
              gevonden <<- FALSE
            },
            error = function(e){
              gevonden <<- FALSE
            },
            finally={
            }
          )
          if (gevonden) {
            for (i in 1:length(domValuesJson)) {
              j <- i + lOffset
              domValuesDFloc[j,"Guid"] <- domValuesJson[[i]]$fulltext
              lColumns <- colnames(domValuesDFloc)
              lColumns <- lColumns[!lColumns %in% c("Guid")]
              for (x in lColumns) {
                if (length(unlist(domValuesJson[[i]]$printouts[x]) > 0 && is.na(unlist(domValuesJson[[i]]$printouts[x])))) {
                  if (x == "Begin geldigheid" || x == "Eind geldigheid" || x == "Wijzigingsdatum") {
                    domValuesDFloc[j,x] <- unlist(domValuesJson[[i]]$printouts[x][[1]]$raw) #bewerkDatum(unlist(domValuesJson[[i]]$printouts[x][[1]]$raw))
                    domValuesDFloc[j,x] <- bewerkDatum(unlist(domValuesJson[[i]]$printouts[x][[1]]$raw))
                  }
                  else {
                    if (x == "Gerelateerd") {
                      if (length(unlist(domValuesJson[[i]]$printouts["Gerelateerd"][[1]]$fulltext)) > 0) {
                        gerelateerd <- NULL
                        for (k in 1:length(unlist(domValuesJson[[i]]$printouts["Gerelateerd"][[1]]$fulltext))) {
                          #message("er is lengte")
                          if (k == 1) {
                            gerelateerd <- unlist(domValuesJson[[i]]$printouts["Gerelateerd"][[1]]$fulltext[1])
                          }
                          else {
                            #message("lengte > 1")
                            gerelateerd <- paste(gerelateerd,unlist(domValuesJson[[i]]$printouts["Gerelateerd"][[1]]$fulltext[k]),sep=",")
                          }
                        }
                        #message(gerelateerd)
                        domValuesDFloc[j,x] <- gerelateerd
                      }
                    }
                    else {
                      domValuesDFloc[j,x] <- toString(unlist(domValuesJson[[i]]$printouts[x]))
                    }
                  }
                }
              }
            }
            if (length(domValuesJson) == lLimit) {
              lOffset <- lOffset + lLimit
              #message("We zijn nog niet klaar")
            }
            else lDoorgaan <- FALSE
          }
        }
        else {
          lDoorgaan <- FALSE
          message("Domeinwaarden bestaat niet")
        }
      }
      return(domValuesDFloc)
    }
  }
  else {
    domValuesDFloc <- data.frame(matrix(ncol = 2, nrow = 0))
    colnames(domValuesDFloc) <- as.list(c("Domeintabel","Melding"))
    domValuesDFloc[1,"Domeintabel"] <- pDomeintabel
    domValuesDFloc[1,"Melding"] <- "Domeintabel bestaat niet"
  }
  return(domValuesDFloc)
}