Skip to content

Commit

Permalink
#181 support M1, M2, M3 + test ISODate, ISODateType
Browse files Browse the repository at this point in the history
  • Loading branch information
eblondel committed Sep 9, 2024
1 parent 0295619 commit f62c0f9
Show file tree
Hide file tree
Showing 723 changed files with 56,780 additions and 822 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@ Package: geometa
Type: Package
Title: Tools for Reading and Writing ISO/OGC Geographic Metadata
Version: 0.9
Date: 2024-04-18
Date: 2024-09-03
Authors@R: c(person("Emmanuel", "Blondel", role = c("aut", "cre"), email = "[email protected]", comment = c(ORCID = "0000-0002-5870-5762")))
Maintainer: Emmanuel Blondel <[email protected]>
Description: Provides facilities to read, write and validate geographic metadata
Expand Down
9 changes: 9 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -129,8 +129,12 @@ export(ISOCharacterSet)
export(ISOCitation)
export(ISOCitationSeries)
export(ISOClassification)
export(ISOCodeDefinition)
export(ISOCodeListDictionary)
export(ISOCodeListValue)
export(ISOCodelist)
export(ISOCodelistCatalogue)
export(ISOCodelistValue)
export(ISOCompletenessCommission)
export(ISOCompletenessOmission)
export(ISOConceptualConsistency)
Expand Down Expand Up @@ -245,6 +249,8 @@ export(ISOLocalName)
export(ISOLocale)
export(ISOLocaleContainer)
export(ISOLocalisedCharacterString)
export(ISOMLCodeDefinition)
export(ISOMLCodeListDictionary)
export(ISOMaintenanceFrequency)
export(ISOMaintenanceInformation)
export(ISOMeasure)
Expand Down Expand Up @@ -352,9 +358,11 @@ export(getISOCodelists)
export(getISOInternalCodelists)
export(getISOMetadataNamespace)
export(getISOMetadataNamespaces)
export(getISOMetadataSchemaFile)
export(getISOMetadataSchemas)
export(getMappingFormats)
export(getMappings)
export(getMetadataStandard)
export(pivot_converter)
export(pivot_format)
export(readISO19139)
Expand All @@ -369,6 +377,7 @@ export(setISOCodelists)
export(setISOMetadataNamespaces)
export(setISOMetadataSchemas)
export(setMappingFormats)
export(setMetadataStandard)
import(XML)
import(crayon)
import(httr)
Expand Down
104 changes: 75 additions & 29 deletions R/ISOAbstractObject.R
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@
#' The object returned is a \code{data.frame} containing the specification reference
#' and title.
#' }
#' \item{\code{getISOStandard(clazz)}}{
#' \item{\code{getISOStandard(clazz, version)}}{
#' Inherit the ISO (and/or OGC) standard reference for a given \pkg{geometa} class.
#' The object returned is a \code{data.frame} containing the specification reference
#' and title.
Expand Down Expand Up @@ -55,6 +55,7 @@ ISOAbstractObject <- R6Class("ISOAbstractObject",
inherit = geometaLogger,
cloneable = FALSE,
private = list(
metadataStandardCompliance = TRUE,
xmlElement = "AbstractObject",
xmlNamespacePrefix = "GCO",
encoding = options("encoding"),
Expand Down Expand Up @@ -236,6 +237,7 @@ ISOAbstractObject <- R6Class("ISOAbstractObject",
initialize = function(xml = NULL, element = NULL, namespace = NULL,
attrs = list(), defaults = list(),
wrap = TRUE, value_as_field = FALSE){
self$checkMetadataStandardCompliance()
if(!is.null(element)){ private$xmlElement <- element }
if(!is.null(namespace)){ private$xmlNamespacePrefix <- toupper(namespace)}
self$element = private$xmlElement
Expand All @@ -249,9 +251,32 @@ ISOAbstractObject <- R6Class("ISOAbstractObject",
}
},

#Metadata standard compliance methods
#---------------------------------------------------------------------------

#'@description Check if object can be instantiated vs. the current metadata standard
checkMetadataStandardCompliance = function(){
if(private$metadataStandardCompliance){
xmlnsp = private$xmlNamespacePrefix
if(is.list(xmlnsp)) if(!getMetadataStandard() %in% names(xmlnsp)) {
stop(sprintf("Class '%s' can't be loaded with current metadata standard '%s'", self$getClassName(), getMetadataStandard()))
}
}
},

#'@description Utility to stop in case a the current metadata standard does not match the one required for the code. This utility
#' can be used to check applicability of a certain method, depending on on the current metadata standard.
#'@param version version
stopIfMetadataStandardIsNot = function(version){
if(getMetadataStandard() != version){
stop(sprintf("The method can't be used with current metadata standard '%s'", getMetadataStandard()))
}
},

#Main methods
#---------------------------------------------------------------------------


#'@description Provides a custom print output (as tree) of the current class
#'@param ... args
#'@param depth class nesting depth
Expand Down Expand Up @@ -460,12 +485,13 @@ ISOAbstractObject <- R6Class("ISOAbstractObject",
},
fieldValue
)
if(length(fieldValue)==0) fieldValue = NA
if(length(fieldValue)==0) fieldValue = NA
}else{
fieldValue <- fieldClass$new(xml = child)
fieldValue$parentAttrs <- parentAttrs
attrs <- as.list(xmlAttrs(child, TRUE, FALSE))
if(length(attrs)>0) attrs <- attrs[attrs != "gmd:PT_FreeText_PropertyType"]
if(length(attrs)>0) attrs <- attrs[attrs != "lan:PT_FreeText_PropertyType"]
fieldValue$attrs <- attrs
}
if(is(self[[fieldName]], "list")){
Expand Down Expand Up @@ -613,6 +639,7 @@ ISOAbstractObject <- R6Class("ISOAbstractObject",

attrs <- as.list(xmlattrs)
if(length(attrs)>0) attrs <- attrs[attrs != "gmd:PT_FreeText_PropertyType"]
if(length(attrs)>0) attrs <- attrs[attrs != "lan:PT_FreeText_PropertyType"]
self$attrs <- attrs
if("gco:nilReason" %in% names(xmlattrs)) self$isNull <- TRUE
},
Expand Down Expand Up @@ -670,7 +697,10 @@ ISOAbstractObject <- R6Class("ISOAbstractObject",
rootXMLAttrs <- self[["attrs"]]
rootXMLAttrs <- rootXMLAttrs[!is.na(rootXMLAttrs)]
}
freeTextAttr <- list("xsi:type" = "gmd:PT_FreeText_PropertyType")
freeTextAttr <- list("xsi:type" = switch(getMetadataStandard(),
"19115-1/2" = "gmd:PT_FreeText_PropertyType",
"19115-3" = "lan:PT_FreeText_PropertyType",
))

#fields
fields <- fields[!sapply(fields, function(x){
Expand Down Expand Up @@ -726,7 +756,9 @@ ISOAbstractObject <- R6Class("ISOAbstractObject",
if(field != "value"){
klass <- self$isFieldInheritedFrom(field)
if(!is.null(klass)){
ns <- ISOMetadataNamespace[[klass$private_fields$xmlNamespacePrefix]]$getDefinition()
xmlnsp <- klass$private_fields$xmlNamespacePrefix
if(is.list(xmlnsp)) if(getMetadataStandard() %in% names(xmlnsp)) xmlnsp <- xmlnsp[[getMetadataStandard()]]
ns <- ISOMetadataNamespace[[xmlnsp]]$getDefinition()
}
}
namespaceId <- names(ns)
Expand Down Expand Up @@ -1131,7 +1163,9 @@ ISOAbstractObject <- R6Class("ISOAbstractObject",
if(x != "value"){
klass <- self$isFieldInheritedFrom(x)
if(!is.null(klass)){
ns <- ISOMetadataNamespace[[klass$private_fields$xmlNamespacePrefix]]$getDefinition()
xmlnsp <- klass$private_fields$xmlNamespacePrefix
if(is.list(xmlnsp)) if(getMetadataStandard() %in% names(xmlnsp)) xmlnsp <- xmlnsp[[getMetadataStandard()]]
ns <- ISOMetadataNamespace[[xmlnsp]]$getDefinition()
if(!(ns %in% nsdefs)){
nsdefs <<- c(nsdefs, ns)
}
Expand Down Expand Up @@ -1336,7 +1370,9 @@ ISOAbstractObject <- R6Class("ISOAbstractObject",
#'@param addNS add namespace definition? Default is \code{FALSE}
setId = function(id, addNS = FALSE){
attrKey <- "id"
prefix <- tolower(private$xmlNamespacePrefix)
xmlnsp <- private$xmlNamespacePrefix
if(is.list(xmlnsp)) if(getMetadataStandard() %in% names(xmlnsp)) xmlnsp <- xmlnsp[[getMetadataStandard()]]
prefix <- tolower(xmlnsp)
if(startsWith(prefix, "gml")) prefix <- "gml"
if(addNS) attrKey <- paste(prefix, attrKey, sep=":")
self$attrs[[attrKey]] <- id
Expand Down Expand Up @@ -1424,27 +1460,22 @@ ISOAbstractObject <- R6Class("ISOAbstractObject",
)

ISOAbstractObject$getStandardByPrefix = function(prefix){
std <- switch(prefix,
"GCO" = data.frame(specification = "ISO/TS 19103:2005", title = "Geographic Common extensible markup language", stringsAsFactors = FALSE),
"GFC" = data.frame(specification = "ISO/TC211 19110:2005", title = "Geographic Information - Methodology for feature cataloguing", stringsAsFactors = FALSE),
"GMD" = data.frame(specification = "ISO/TC211 19115-1:2003", title = "Geographic Information - Metadata", stringsAsFactors = FALSE),
"GMI" = data.frame(specification = "ISO/TC211 19115-2:2009", title = "Geographic Information - Metadata - Part 2: Extensions for imagery and gridded data", stringsAsFactors = FALSE),
"GTS" = data.frame(specification = "ISO/TC211 19139:2007", title = "Geographic Metadata XML Schema - Geographic Temporal Schema (GTS)", stringsAsFactors = FALSE),
"SRV" = data.frame(specification = "ISO/TC211 19119:2005", title = "Geographic Information - Service Metadata", stringsAsFactors = FALSE),
"GMX" = data.frame(specification = "ISO/TC211 19139:2007", title = "Geographic Metadata XML Schema", stringsAsFactors = FALSE),
"GML" = data.frame(specification = "GML 3.2.1 (ISO 19136)", title = "Geographic Markup Language", stringsAsFactors = FALSE),
"GMLCOV" = data.frame(specification = "GML 3.2.1 Coverage (OGC GMLCOV)", title = "OGC GML Coverage Implementation Schema", stringsAsFactors = FALSE),
"GMLRGRID" = data.frame(specification = "GML 3.3 Referenceable Grid (OGC GML)", title = "OGC GML Referenceable Grid", stringsAsFactors = FALSE),
"SWE" = data.frame(specification = "SWE 2.0", title = "Sensor Web Enablement (SWE) Common Data Model", stringsAsFactors = FALSE)
)
ns <- getISOMetadataNamespace(prefix)
std <- ns$getStandard()
return(std)
}

ISOAbstractObject$getISOStandard = function(clazz){
ISOAbstractObject$getISOStandard = function(clazz, version = "19115-1/2"){
std <- NA
if(is.null(clazz$private_fields)) return(std)
if(is.null(clazz$private_fields$xmlNamespacePrefix)) return(std)
std <- ISOAbstractObject$getStandardByPrefix(clazz$private_fields$xmlNamespacePrefix)
xmlnsp <- clazz$private_fields$xmlNamespacePrefix
if(is.list(xmlnsp)) if(version %in% names(xmlnsp)){
xmlnsp <- xmlnsp[[version]]
}else{
xmlnsp <- xmlnsp[[1]]
}
std <- ISOAbstractObject$getStandardByPrefix(xmlnsp)
return(std)
}

Expand Down Expand Up @@ -1474,15 +1505,26 @@ ISOAbstractObject$getISOClasses = function(extended = FALSE, pretty = FALSE){
if(pretty){
std_info <- do.call("rbind",lapply(list_of_classes, function(x){
clazz <- invisible(try(eval(parse(text=x)),silent=TRUE))
std <- ISOAbstractObject$getISOStandard(clazz)
std_info <- cbind(
std <- ISOAbstractObject$getISOStandard(clazz, version = getMetadataStandard())
xmlnsp <- clazz$private_fields$xmlNamespacePrefix
refactored = FALSE
if(is.list(xmlnsp)){
refactored = TRUE
if(getMetadataStandard() %in% names(xmlnsp)){
xmlnsp <- xmlnsp[[getMetadataStandard()]]
}else{
xmlnsp <- xmlnsp[[1]]
}
}
stdinfo <- cbind(
std,
ns_prefix = clazz$private_fields$xmlNamespacePrefix,
ns_uri = ISOMetadataNamespace[[clazz$private_fields$xmlNamespacePrefix]]$uri,
ns_prefix = if(!is.null(xmlnsp)) xmlnsp else NA,
ns_uri = if(!is.null(xmlnsp)) ISOMetadataNamespace[[xmlnsp]]$uri else NA,
element = clazz$private_fields$xmlElement,
refactored = refactored,
stringsAsFactors = FALSE
)
return(std_info)
return(stdinfo)
}))

list_of_classes <- data.frame(
Expand All @@ -1496,7 +1538,7 @@ ISOAbstractObject$getISOClasses = function(extended = FALSE, pretty = FALSE){

ISOAbstractObject$getISOClassByNode = function(node){
outClass <- NULL
if(!is(node, "XMLInternalDocument")) node <- xmlDoc(node)
if(!is(node, "XMLInternalDocument") & !is(node, "XMLInternalCommentNode")) node <- xmlDoc(node)
nodeElement <- xmlRoot(node)
nodeElementName <- xmlName(nodeElement)
nodeElementNames <- unlist(strsplit(nodeElementName, ":"))
Expand Down Expand Up @@ -1648,10 +1690,14 @@ getClassesInheriting <- function(classname, extended = FALSE, pretty = FALSE){
std_infos <- do.call("rbind",lapply(list_of_classes, function(x){
clazz <- try(eval(parse(text=x)),silent=TRUE)
if(is(clazz,"try-error")) clazz <- try(eval(parse(text=paste0("geometa::",x))),silent=TRUE)

xmlnsp <- clazz$private_fields$xmlNamespacePrefix
if(is.list(xmlnsp)) if(getMetadataStandard() %in% names(xmlnsp)) xmlnsp <- xmlnsp[[getMetadataStandard()]]

std_info <- data.frame(
environment = environmentName(clazz$parent_env),
ns_prefix = if(!is.null(clazz$private_fields$xmlNamespacePrefix))clazz$private_fields$xmlNamespacePrefix else NA,
ns_uri = if(!is.null(clazz$private_fields$xmlNamespacePrefix)) ISOMetadataNamespace[[clazz$private_fields$xmlNamespacePrefix]]$uri else NA,
ns_prefix = if(!is.null(xmlnsp)) xmlnsp else NA,
ns_uri = if(!is.null(xmlnsp)) ISOMetadataNamespace[[xmlnsp]]$uri else NA,
element = if(!is.null(clazz$private_fields$xmlElement)) clazz$private_fields$xmlElement else NA,
stringsAsFactors = FALSE
)
Expand Down
46 changes: 46 additions & 0 deletions R/ISOCodeDefinition.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,46 @@
#' ISOCodeDefinition
#'
#' @docType class
#' @importFrom R6 R6Class
#' @export
#' @keywords ISO code definition
#' @return Object of \code{\link{R6Class}} for modelling an ISO Metadata code definition
#' @format \code{\link{R6Class}} object.
#'
#' @note Abstract ISO codelist class used internally by geometa
#'
#' @references
#' ISO/TS 19139:2007 Geographic information -- XML
#'
#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
#'
ISOCodeDefinition <- R6Class("ISOCodeDefinition",
inherit = ISOAbstractObject,
private = list(
xmlElement = "CodeDefinition",
xmlNamespacePrefix = list(
"19115-1/2" = "GMX"
)
),
public = list(
#'@field identifier identifier
identifier = NA,
#'@field description description
description = NA,

#'@description Initializes object
#'@param xml object of class \link{XMLInternalNode-class}
initialize = function(xml = NULL){
super$initialize(xml = xml)
},

#'@description Converts to \link{ISOCodelistValue}
#'@return object of class \link{ISOCodelistValue}
toISOCodelistValue = function(){
clv = ISOCodelistValue$new()
clv$identifier = self$identifier$value
clv$description = self$description$value
return(clv)
}
)
)
53 changes: 53 additions & 0 deletions R/ISOCodeListDictionary.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,53 @@
#' ISOCodeListDictionary
#'
#' @docType class
#' @importFrom R6 R6Class
#' @export
#' @keywords ISO code element
#' @return Object of \code{\link{R6Class}} for modelling an ISO Metadata codelist dictionary
#' @format \code{\link{R6Class}} object.
#'
#' @note Abstract ISO codelist class used internally by geometa
#'
#' @references
#' ISO/TS 19139:2007 Geographic information -- XML
#'
#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
#'
ISOCodeListDictionary <- R6Class("ISOCodeListDictionary",
inherit = ISOAbstractObject,
private = list(
xmlElement = "CodeListDictionary",
xmlNamespacePrefix = list(
"19115-1/2" = "GMX"
)
),
public = list(
#'@field identifier identifier
identifier = NA,
#'@field description description
description = NA,
#'@field codeEntry code entries
codeEntry = list(),

#'@description Initializes object
#'@param xml object of class \link{XMLInternalNode-class}
initialize = function(xml = NULL){
super$initialize(xml = xml)
},

#'@description Converts to \link{ISOCodelist}
#'@return an object of class \link{ISOCodelist}
toISOCodelist = function(){
cl = ISOCodelist$new()
identifier = ISOScopedName$new(value = self$identifier$value)
identifier$setCodeSpace(self$identifier$attrs$codeSpace)
cl$identifier = identifier
cl$description = self$description$value
cl$codeEntry = lapply(self$codeEntry, function(codeEntry){
codeEntry$toISOCodelistValue()
})
return(cl)
}
)
)
Loading

0 comments on commit f62c0f9

Please sign in to comment.