#298 impl for subjects and complex lists (with uris, list of values) …

…+ apply it to subjects in ISO 19115

DESCRIPTION

@@ -68,6 +68,8 @@ Suggests:
   d4storagehub4R,
   rmarkdown,
   dataverse
+Remotes:
+  eblondel/geometa
 License: MIT + file LICENSE
 URL: https://github.com/r-geoflow/geoflow
 BugReports: https://github.com/r-geoflow/geoflow

R/geoflow_kvp.R

@@ -11,34 +11,25 @@
 #' @return Object of \code{\link{R6Class}} for modelling an kvp (Key Values pair)
 #' @format \code{\link{R6Class}} object.
 #' 
-#' @examples
-#' \dontrun{
-#'   #with setters
-#'   kvp <- geoflow_kvp$new()
-#'   kvp$setKey("thekey")
-#'   kvp$setValue("thevalue")
-#'   #from string
-#'   kvp <- geoflow_kvp$new(str = "thekey:thevalue1,thevalue2")
-#' }
-#' 
 #' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
 #'
 geoflow_kvp <- R6Class("geoflow_kvp",
   public = list(
     #'@field key the KVP key
     key = NULL,
-    #'@field value the KVP value
-    value = NULL,
+    #'@field values the KVP values
+    values = NULL,
+    #'@field locale a locale definition for the KVP
+    locale = NULL,
 
     #'@description Initializes a Key-Value pair (KVP)
-    #'@param str character string to initialize from using key-based syntax
-    initialize = function(str = NULL){
-      if(!is.null(str)){
-        kvp <- unlist(strsplit(str,':\\s*(?=([^"]*"[^"]*")*[^"]*$)', perl = T))
-        if(length(kvp)!=2) stop("Invalid Key-value pair string")
-        self$setKey(kvp[1])
-        self$setValue(kvp[2])
-      }
+    #'@param key key
+    #'@param values values
+    #'@param locale locale
+    initialize = function(key = NULL, values = NULL, locale = NULL){
+      if(!is.null(key)) self$setKey(key)
+      if(!is.null(values)) self$setValues(values)
+      if(!is.null(locale)) self$setLocale(locale)
     },
 
     #'@description Set KVP key
@@ -47,10 +38,16 @@ geoflow_kvp <- R6Class("geoflow_kvp",
       self$key <- key
     },
 
-    #'@description Set KVP value
-    #'@param value the value
-    setValue = function(value){
-      self$value <- value
+    #'@description Set KVP values
+    #'@param values the values
+    setValues = function(values){
+      self$values <- values
+    },
+
+    #'@description Set KVP locale
+    #'@param locale locale
+    setLocale = function(locale){
+      self$locale <- locale
     }
   )                                  
 )

R/geoflow_subject.R

@@ -39,7 +39,8 @@ geoflow_subject <- R6Class("geoflow_subject",
 
     #'@description Initializes an object of class \link{geoflow_subject}
     #'@param str a character string to initialize from, using key-based syntax
-    initialize = function(str = NULL){
+    #'@param kvp an object of class \link{geoflow_kvp}
+    initialize = function(str = NULL, kvp = NULL){
       if(!is.null(str)){
         subject_kvp <- extract_kvp(str)
         key <- subject_kvp$key
@@ -51,6 +52,48 @@ geoflow_subject <- R6Class("geoflow_subject",
         self$setUri(uri)
         self$setName(name)
         invisible(lapply(subject_kvp$values, self$addKeyword))
+      }else if(!is.null(kvp)){
+        #key
+        subject_key <- kvp$key
+        key_attrs <- attributes(subject_key)
+        attributes(subject_key) <- NULL
+        self$setKey(subject_key)
+        #name
+        name <- key_attrs$description
+        if(!is.null(name)){
+          key_desc_attrs <- key_attrs[startsWith(names(key_attrs),"description") & names(key_attrs)!="description"]
+          for(attr_name in names(key_desc_attrs)){
+            locale <- unlist(strsplit(attr_name,"description#"))[2]
+            attr(name, paste0("locale#",locale)) <- key_desc_attrs[[attr_name]]
+          }
+          self$setName(name)
+        }
+        #uri
+        uri <- key_attrs$uri
+        if(!is.null(uri)){
+          key_uri_attrs <- key_attrs[startsWith(names(key_attrs),"uri") & names(key_attrs)!="uri"]
+          for(attr_name in names(key_uri_attrs)){
+            locale <- unlist(strsplit(attr_name, "uri#"))[2]
+            attr(uri, paste0("locale#",locale)) <- key_uri_attrs[[attr_name]]
+          }
+          self$setUri(uri)
+        }
+        #keywords
+        for(i in 1:length(kvp$values)){
+          kwd = kvp$values[[i]]
+          kwd_uri <- attr(kwd,"uri")
+          attributes(kwd) <- NULL
+
+          val_locale_attrs <- attributes(kvp$values)
+          for(attr_name in names(val_locale_attrs)){
+            locale_value <- val_locale_attrs[[attr_name]][[i]]
+            if(!is.null(kwd_uri)) attr(kwd_uri, attr_name) <- attr(locale_value, "uri")
+            attributes(locale_value) <- NULL
+            attr(kwd, attr_name) <- locale_value
+          }
+          self$addKeyword(keyword = kwd, uri = kwd_uri)
+        }
+
       }
     },
 

R/geoflow_utils.R

@@ -125,13 +125,15 @@ extract_kvp <- function(str){
 
   #locale management
   locale = NULL
+  key_attrs <- attributes(key)
   key_parts <- unlist(strsplit(key, "#"))
   if(length(key_parts)>1){
     key <- key_parts[1]
+    attributes(key) <- key_attrs
     locale <- key_parts[2]
   }
 
-  return(list(key = key, values = values, locale = locale))
+  return(geoflow_kvp$new(key = key, values = values, locale = locale))
 }
 
 #' @name extract_kvp
@@ -159,19 +161,28 @@ extract_kvps <- function(strs, collapse = NULL){
     kvps_for_key <- kvps[sapply(kvps, function(kvp){kvp$key == key})]
     with_null_locale <- any(sapply(kvps_for_key, function(x){is.null(x$locale)}))
     kvp_with_default_locale <- kvps_for_key[sapply(kvps_for_key, function(x){is.null(x$locale)})]
+    kvp_with_locale <- kvps_for_key[sapply(kvps_for_key, function(x){!is.null(x$locale)})]
     if(length(kvp_with_default_locale)>0){
       kvp_with_default_locale <- kvp_with_default_locale[[1]]
     }else{
       #TODO support default language in geoflow
     }
+    #localization
+    key <- kvp_with_default_locale$key
+    #locale key descriptions
+    for(kvp in kvp_with_locale){
+      if(!is.null(attr(kvp$key, "uri"))) attr(key, paste0("uri#", kvp$locale)) <- attr(kvp$key, "uri")
+      if(!is.null(attr(kvp$key, "description"))) attr(key, paste0("description#", kvp$locale)) <- attr(kvp$key, "description")
+    }
+    #locale key uris
+    #locale values
     locale_values <- kvp_with_default_locale$values
     if(length(locale_values)==1) locale_values <- locale_values[[1]]
-    kvp_with_locale <- kvps_for_key[sapply(kvps_for_key, function(x){!is.null(x$locale)})]
     for(item in kvp_with_locale){
       attr(locale_values, paste0("locale#", toupper(item$locale))) <- item$values
     }
 
-    kvp_with_locales <- list(key = key, values = locale_values)
+    kvp_with_locales <- geoflow_kvp$new(key = key, values = locale_values)
     return(kvp_with_locales)
   })
 

inst/actions/geometa_create_iso_19115.R

@@ -475,20 +475,43 @@ function(action, entity, config){
     kwds <- ISOKeywords$new()
     for(kwd in subject$keywords){
       iso_kwd <- kwd$name
+      iso_kwd_locales <- geoflow::get_locales_from(kwd$name)
+      iso_kwd_locales_codes = names(iso_kwd_locales)
       if(!is.null(kwd$uri)){
         iso_kwd <- ISOAnchor$new(name = kwd$name, href = kwd$uri)
+        iso_kwd_locales_uris <- geoflow::get_locales_from(kwd$uri)
+        if(length(iso_kwd_locales_uris)>0){
+          iso_kwd_locales <- lapply(iso_kwd_locales_codes, function(locale){
+            iso_kwd_locale <- iso_kwd_locales[[locale]]
+            attr(iso_kwd_locale, "uri") <- iso_kwd_locales_uris[[locale]]
+            return(iso_kwd_locale)
+          })
+          names(iso_kwd_locales) <- iso_kwd_locales_codes
+        }
       }
-      kwds$addKeyword(iso_kwd)
+      kwds$addKeyword(iso_kwd, locales = iso_kwd_locales)
     }
     kwds$setKeywordType(subject$key)
     #theausurus
     if(!is.null(subject$name)){
       th <- ISOCitation$new()
       title <- subject$name
+      title_locales <- geoflow::get_locales_from(subject$name)
+      title_locales_codes <- names(title_locales)
+
       if(!is.null(subject$uri)){
         title <- ISOAnchor$new(name = subject$name, href = subject$uri)
+        title_locales_uris <- geoflow::get_locales_from(subject$uri)
+        if(length(title_locales_uris)>0){
+          title_locales <- lapply(title_locales_codes, function(locale){
+            title_locale <- title_locales[[locale]]
+            attr(title_locale, "uri") <- title_locales_uris[[locale]]
+            return(title_locale)
+          })
+          names(title_locales) <- title_locales_codes
+        }
       }
-      th$setTitle(title)
+      th$setTitle(title, locales = title_locales)
 
       if(length(subject$dates)>0){
         for(subj_datetype in names(subject$dates)){

inst/metadata/entity/entity_handler_df.R

@@ -135,10 +135,11 @@ handle_entities_df <- function(config, source){
     src_subject <- sanitize_str(source_entity[,"Subject"])
     subjects <- if(!is.na(src_subject)) extract_cell_components(src_subject) else list()
     if(length(subjects)>0){
-      invisible(lapply(subjects, function(subject){
-        subject_obj <- geoflow_subject$new(str = subject)
+      kvps <- extract_kvps(subjects)
+      for(kvp in kvps){
+        subject_obj <- geoflow_subject$new(kvp = kvp)
         entity$addSubject(subject_obj)
-      }))
+      }
     }
 
     #formats