From 55571e7ec9512bc4b8d48fb3de29cc60f7bfe601 Mon Sep 17 00:00:00 2001 From: eblondel Date: Sat, 13 Feb 2021 02:09:18 +0100 Subject: [PATCH] #118 --- DESCRIPTION | 4 +- R/geoflow.R | 4 +- ...w_action_atom4R_dataverse_deposit_record.R | 2 +- R/geoflow_action_eml_create_eml.R | 2 +- R/geoflow_action_geometa_create_iso_19115.R | 57 ++++++++++--------- R/geoflow_subject.R | 20 ++++++- R/geoflow_utils.R | 14 +++++ man/geoflow.Rd | 4 +- man/geoflow_subject.Rd | 4 ++ 9 files changed, 75 insertions(+), 36 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5b613c8..4ae0f84 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: geoflow -Version: 0.0.20210209 -Date: 2021-02-09 +Version: 0.0.20210213 +Date: 2021-02-13 Title: R engine to orchestrate and run geospatial (meta)data workflows Authors@R: c( person("Emmanuel", "Blondel", role = c("aut", "cre"), email = "emmanuel.blondel1@gmail.com", comment = c(ORCID = "0000-0002-5870-5762")), diff --git a/R/geoflow.R b/R/geoflow.R index e7f38b3..346d948 100644 --- a/R/geoflow.R +++ b/R/geoflow.R @@ -24,8 +24,8 @@ #' \tabular{ll}{ #' Package: \tab geoflow\cr #' Type: \tab Package\cr -#' Version: \tab 0.0.20210209\cr -#' Date: \tab 2021-02-09\cr +#' Version: \tab 0.0.20210213\cr +#' Date: \tab 2021-02-13\cr #' License: \tab MIT\cr #' LazyLoad: \tab yes\cr #' } diff --git a/R/geoflow_action_atom4R_dataverse_deposit_record.R b/R/geoflow_action_atom4R_dataverse_deposit_record.R index 982c672..6594997 100644 --- a/R/geoflow_action_atom4R_dataverse_deposit_record.R +++ b/R/geoflow_action_atom4R_dataverse_deposit_record.R @@ -65,7 +65,7 @@ atom4R_dataverse_deposit_record <- function(entity, config, options){ dcentry$addDCType(dctype_dataverse) ##subjects subjects <- entity$subjects - if(length(subjects)>0) subjects <- subjects[sapply(subjects, function(x){return(x$name != "topic")})] + if(length(subjects)>0) subjects <- subjects[sapply(subjects, function(x){return(x$key != "topic")})] if(length(subjects)>0) for(subject in subjects){ for(kwd in subject$keywords){ dcentry$addDCSubject(kwd$name) diff --git a/R/geoflow_action_eml_create_eml.R b/R/geoflow_action_eml_create_eml.R index d8cc849..16e458d 100644 --- a/R/geoflow_action_eml_create_eml.R +++ b/R/geoflow_action_eml_create_eml.R @@ -178,7 +178,7 @@ eml_create_eml <- function(entity, config, options){ } #taxonomic - taxo <- entity$subjects[sapply(entity$subjects, function(x){x$name == taxonomySubject})] + taxo <- entity$subjects[sapply(entity$subjects, function(x){x$key == taxonomySubject})] if(length(taxo)>0){ taxo <- taxo[[1]] if(is.null(dataset$coverage)) dataset$coverage <- list() diff --git a/R/geoflow_action_geometa_create_iso_19115.R b/R/geoflow_action_geometa_create_iso_19115.R index cc13d0c..e4996ec 100644 --- a/R/geoflow_action_geometa_create_iso_19115.R +++ b/R/geoflow_action_geometa_create_iso_19115.R @@ -14,9 +14,11 @@ geometa_create_iso_19115 <- function(entity, config, options){ featureid <- if(!is.null(options$featureid)){ options$featureid } else { if(!is.null(features)) colnames(features)[1] else NULL} geographySubject <- if(!is.null(options$subject_geography)) options$subject_geography else "geography" - createResponsibleParty = function(x, role){ + createResponsibleParty = function(x, role=NULL){ if(is.null(role)) role <- x$role rp <- ISOResponsibleParty$new() + if(is.null(x$firstName)) x$firstName = NA + if(is.null(x$lastName)) x$lastName = NA if(!is.na(x$firstName) && !is.na(x$lastName)) rp$setIndividualName(paste(x$firstName, x$lastName)) rp$setOrganisationName(x$organizationName) rp$setPositionName(x$positionName) @@ -146,7 +148,7 @@ geometa_create_iso_19115 <- function(entity, config, options){ ident$setCharacterSet("utf8") #topic categories topics <- list() - if(length(entity$subjects)>0) topics <- entity$subjects[sapply(entity$subjects, function(x){return(tolower(x$name) == "topic")})] + if(length(entity$subjects)>0) topics <- entity$subjects[sapply(entity$subjects, function(x){return(tolower(x$key) == "topic")})] if(length(topics)>0){ for(topic in topics){ for(topicCategory in topic$keywords) ident$addTopicCategory(topicCategory$name) @@ -295,7 +297,7 @@ geometa_create_iso_19115 <- function(entity, config, options){ } #geographic identifiers geothesauri <- list() - if(length(entity$subjects)>0) geothesauri <- entity$subjects[sapply(entity$subjects, function(x){return(tolower(x$name) == geographySubject)})] + if(length(entity$subjects)>0) geothesauri <- entity$subjects[sapply(entity$subjects, function(x){return(tolower(x$key) == geographySubject)})] if(length(geothesauri)>0){ for(geothesaurus in geothesauri){ for(geokwd in geothesaurus$keywords){ @@ -328,7 +330,7 @@ geometa_create_iso_19115 <- function(entity, config, options){ #thesaurus/keywords subjects <- entity$subjects - if(length(subjects)>0) subjects <- subjects[sapply(subjects, function(x){return(x$name != "topic")})] + if(length(subjects)>0) subjects <- subjects[sapply(subjects, function(x){return(x$key != "topic")})] if(length(subjects)>0) for(subject in subjects){ #add keywords kwds <- ISOKeywords$new() @@ -339,30 +341,33 @@ geometa_create_iso_19115 <- function(entity, config, options){ } kwds$addKeyword(iso_kwd) } - kwds$setKeywordType("theme") #TODO need to handle keywordType in thesaurus table definition... - th <- ISOCitation$new() - title <- subject$name - if(!is.null(subject$uri)){ - title <- ISOAnchor$new(name = subject$name, href = subject$uri) - } - th$setTitle(title) - - if(length(subject$dates)>0){ - for(subj_datetype in names(subject$dates)){ - subj_date <- ISODate$new() - subj_date$setDate(subject$dates[[subj_datetype]]) - subj_date$setDateType(subj_datetype) - th$addDate(subj_date) + kwds$setKeywordType(subject$key) + #theausurus + if(!is.null(subject$name)){ + th <- ISOCitation$new() + title <- subject$name + if(!is.null(subject$uri)){ + title <- ISOAnchor$new(name = subject$name, href = subject$uri) + } + th$setTitle(title) + + if(length(subject$dates)>0){ + for(subj_datetype in names(subject$dates)){ + subj_date <- ISODate$new() + subj_date$setDate(subject$dates[[subj_datetype]]) + subj_date$setDateType(subj_datetype) + th$addDate(subj_date) + } + }else{ + #TODO thesaurus date (likely to be different that current date). Required for ISO validity + #this is a limitation of tabular approach to fill metadata + d <- ISODate$new() + d$setDate(Sys.Date()) + d$setDateType("lastRevision") + th$addDate(d) } - }else{ - #TODO thesaurus date (likely to be different that current date). Required for ISO validity - #this is a limitation of tabular approach to fill metadata - d <- ISODate$new() - d$setDate(Sys.Date()) - d$setDateType("lastRevision") - th$addDate(d) + kwds$setThesaurusName(th) } - kwds$setThesaurusName(th) ident$addKeywords(kwds) } diff --git a/R/geoflow_subject.R b/R/geoflow_subject.R index 9707272..b022ca5 100644 --- a/R/geoflow_subject.R +++ b/R/geoflow_subject.R @@ -14,6 +14,7 @@ #' @examples #' \dontrun{ #' subject <- geoflow_subject$new() +#' subject$setKey("theme") #' subject$setName("General") #' subject$setUri("http://somelink/general") #' subject$addKeyword("keyword1", "http://somelink/keyword1") @@ -26,6 +27,9 @@ #' \item{\code{new)}}{ #' This method is used to instantiate a geoflow_subject object #' } +#' \item{\code{setKey(key)}}{ +#' Set key +#' } #' \item{\code{setName(name)}}{ #' Sets name #' } @@ -49,6 +53,7 @@ #' geoflow_subject <- R6Class("geoflow_subject", public = list( + key = NULL, name = NULL, uri = NULL, dates = list(), @@ -56,12 +61,23 @@ geoflow_subject <- R6Class("geoflow_subject", initialize = function(str = NULL){ if(!is.null(str)){ subject_kvp <- extract_kvp(str) - self$setName(subject_kvp$key) - self$setUri(attr(subject_kvp$key,"uri")) + key <- subject_kvp$key + self$setKey(key) + uri <- attr(key, "uri") + name <- attr(key, "description") + attr(key, "uri") <- NULL + attr(key, "description") <- NULL + self$setUri(uri) + self$setName(name) invisible(lapply(subject_kvp$values, self$addKeyword)) } }, + #setKey + setKey = function(key){ + self$key <- key + }, + #setName setName = function(name){ self$name <- name diff --git a/R/geoflow_utils.R b/R/geoflow_utils.R index 1592fff..04cfac7 100644 --- a/R/geoflow_utils.R +++ b/R/geoflow_utils.R @@ -79,6 +79,20 @@ extract_kvp <- function(str){ key <- key_splits[1] attr(key,"uri") <- key_splits[2] } + hasDescription <- regexpr("\\[", key)>0 & endsWith(key, "]") + if(hasDescription){ + attrs <- attributes(key) + value_splits <- unlist(strsplit(key, "\\[")) + key <- value_splits[1] + if(startsWith(key, "\"") && endsWith(key, "\"")) key <- substr(key, 2, nchar(key)-1) + attributes(key) <- attrs + des <- value_splits[2] + des <- substr(des, 1, nchar(des)-1) + if(startsWith(des, "\"") && endsWith(des, "\"")) des <- substr(des, 2, nchar(des)-1) + attr(key, "description") <- des + }else{ + if(startsWith(key, "\"") && endsWith(key, "\"")) key <- substr(key, 2, nchar(key)-1) + } #values values <- unlist(strsplit(kvp[2], ',\\s*(?=([^"]*"[^"]*")*[^"]*$)', perl = TRUE)) diff --git a/man/geoflow.Rd b/man/geoflow.Rd index 2223645..05c1755 100644 --- a/man/geoflow.Rd +++ b/man/geoflow.Rd @@ -12,8 +12,8 @@ R engine to orchestrate and run geospatial (meta)data workflows \tabular{ll}{ Package: \tab geoflow\cr Type: \tab Package\cr - Version: \tab 0.0.20210209\cr - Date: \tab 2021-02-09\cr + Version: \tab 0.0.20210213\cr + Date: \tab 2021-02-13\cr License: \tab MIT\cr LazyLoad: \tab yes\cr } diff --git a/man/geoflow_subject.Rd b/man/geoflow_subject.Rd index 29e9608..a16ff83 100644 --- a/man/geoflow_subject.Rd +++ b/man/geoflow_subject.Rd @@ -22,6 +22,9 @@ geoflow_subject \item{\code{new)}}{ This method is used to instantiate a geoflow_subject object } + \item{\code{setKey(key)}}{ + Set key + } \item{\code{setName(name)}}{ Sets name } @@ -45,6 +48,7 @@ geoflow_subject \examples{ \dontrun{ subject <- geoflow_subject$new() + subject$setKey("theme") subject$setName("General") subject$setUri("http://somelink/general") subject$addKeyword("keyword1", "http://somelink/keyword1")