Skip to content

Commit 10c792f

Browse files
eblondeleblondel
committed
support #390 
1 parent 0ca73de commit 10c792f

File tree

5 files changed

+458
-1
lines changed

5 files changed

+458
-1
lines changed

‎R/geoflow_action.R

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -519,7 +519,17 @@ register_actions <- function(){
519519
output_format = list(def = "output format generate by Rmarkdown template (e.g. 'html','pdf')", class = "character",choices = list("html","pdf","word","odt","rtf","md","github"), add_choices = FALSE, multiple = FALSE, default = "html")
520520
),
521521
fun = source(system.file("actions", "rmarkdown_create_metadata.R", package = "geoflow"))$value
522-
)
522+
),
523+
geoflow_action$new(
524+
id="metadataeditr-create-project",
525+
types = list("Metadata publication"),
526+
def = "Create and publish a geospatial project in the World bank metadata editor",
527+
target = "entity",
528+
target_dir = "metadata",
529+
packages = list("metadataeditr"),
530+
available_options = list(),
531+
fun = source(system.file("actions", "metadataeditr_create_project.R", package = "geoflow"))$value
532+
)
523533
)
524534
.geoflow$actions <- objs
525535
}

‎R/geoflow_software.R

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -690,6 +690,23 @@ register_software <- function(){
690690
pwd = list(label = "Password", def = "Password for user authentication", class = "character"),
691691
logger = list(label = "Logger", def = "Level for 'geonode4R' logger messages (NULL,INFO or DEBUG)", class = "character", choices = c("INFO", "DEBUG"))
692692
)
693+
),
694+
#-------------------------------------------------------------------------------------------------------
695+
#WORLDBANK METADATA EDITOR CLIENT
696+
#-------------------------------------------------------------------------------------------------------
697+
geoflow_software$new(
698+
software_type = "metadataeditr",
699+
definition = "World Bank metadata editor client powered by 'metadataeditr' package",
700+
packages = list("metadataeditr"),
701+
handler = try(metadataeditr:::set_api, silent = TRUE),
702+
arguments = list(
703+
api_url = list(label = "API URL", def = "Metadata editor API endpoint URL", class = "character"),
704+
api_key = list(label = "API key", def = "An API user authorization key (to be generated in the Metadata editor)", class = "character"),
705+
verbose = list(label = "verbose", def = "Whether messages should be displayed or not", class = "logical", default = FALSE)
706+
),
707+
attributes = list(
708+
collection_names = list(label = "Collection_names", def = "A coma-separated list of collection names where projects will be associated with", class = "character")
709+
)
693710
)
694711
)
695712
.geoflow$software <- software

‎inst/actions/metadataeditr_create_project.R

Lines changed: 347 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,347 @@
1+
function(action, entity, config){
2+
3+
if(!requireNamespace("metadataeditr", quietly = TRUE)){
4+
stop("The 'metadataeditr-create-project' action requires the 'metadataeditr' package")
5+
}
6+
7+
#fetch software
8+
MD_EDITOR = config$software$output$metadataeditr
9+
if(is.null(MD_EDITOR)){
10+
stop("A 'metadataeditr' software must be configured to use this action")
11+
}
12+
MD_EDITOR_CONFIG = config$software$output$metadataeditr_config
13+
collection_names = list()
14+
if(!is.null(MD_EDITOR_CONFIG$properties$collection_names)){
15+
collection_names = as.list(strsplit(MD_EDITOR_CONFIG$properties$collection_names, ",")[[1]])
16+
}
17+
18+
#basic function to map a geoflow_contact to a metadata editor contact
19+
produce_md_contact = function(x){
20+
21+
md_contact = list()
22+
23+
if(is.null(x$firstName)) x$firstName = NA
24+
if(is.null(x$lastName)) x$lastName = NA
25+
if(!is.na(x$firstName) && !is.na(x$lastName)) md_contact$individualName = paste(x$firstName, x$lastName)
26+
if(!is.na(x$organizationName)) md_contact$organisationName = x$organizationName
27+
if(!is.na(x$positionName)) md_contact$positionName = x$positionName
28+
if(!is.na(x$role)) md_contact$role = x$role
29+
30+
md_contact$contactInfo = list()
31+
md_contact$contactInfo$address = list()
32+
if(!is.na(x$email)) md_contact$contactInfo$address$electronicMailAddress = x$email
33+
if(!is.na(x$postalAddress)) md_contact$contactInfo$address$deliveryPoint = x$postalAddress
34+
if(!is.na(x$city)) md_contact$contactInfo$address$city = x$city
35+
if(!is.na(x$postalCode)) md_contact$contactInfo$address$postalCode = x$postalCode
36+
if(!is.na(x$country)) md_contact$contactInfo$address$country = x$country
37+
md_contact$contactInfo$phone = list()
38+
if(!is.na(x$voice)) md_contact$contactInfo$phone$voice = x$voice
39+
if(!is.na(x$facsimile)) md_contact$contactInfo$phone$facsimile = x$facsimile
40+
md_contact$contactInfo$onlineResource = list()
41+
if(!is.na(x$websiteUrl)) md_contact$contactInfo$onlineResource$linkage = x$websiteUrl
42+
if(!is.na(x$websiteName)) md_contact$contactInfo$onlineResource$name = x$websiteName
43+
44+
return(md_contact)
45+
}
46+
47+
metadata_maintainers = entity$contacts[sapply(entity$contacts, function(x){tolower(x$role) %in% c("metadata")})]
48+
producers = entity$contacts[sapply(entity$contacts, function(x){tolower(x$role) %in% c("owner","originator")})]
49+
poc = entity$contacts[sapply(entity$contacts, function(x){!tolower(x$role) %in% c("metadata", "processor")})]
50+
distributors = entity$contacts[sapply(entity$contacts, function(x){!tolower(x$role) %in% c("distributor")})]
51+
52+
thumbnails = entity$relations[sapply(entity$relations, function(x){x$key == "thumbnail"})]
53+
#thumbnail management
54+
if(length(thumbnails)>0){
55+
dir.create("thumbnails")
56+
57+
thumbnails = lapply(1:length(thumbnails), function(i){
58+
thumbnail = thumbnails[[i]]
59+
if(startsWith(thumbnail$link, "http")){
60+
req_head = httr::HEAD(thumbnail$link)
61+
if(httr::status_code(req_head) == 200){
62+
fileext = unlist(strsplit(httr::headers(req_head)[["content-type"]], "image/"))[2]
63+
filename = paste0("thumbnail_", i, ".", fileext)
64+
download.file(thumbnail$link, destfile = file.path(getwd(), "thumbnails", filename), mode = "wb")
65+
thumbnail$link = filename
66+
}
67+
}else{
68+
file.copy(from = thumbnail$link, to = file.path(getwd(), "thumbnails", basename(thumbnail$link)))
69+
thumbnail$link = basename(thumbnail$link)
70+
}
71+
return(thumbnail)
72+
})
73+
}
74+
75+
project <- list()
76+
77+
production_date = Sys.Date()
78+
79+
#metadata_information
80+
project$metadata_information = list(
81+
title = entity$titles[["title"]],
82+
producers = lapply(producers, function(x){
83+
contact = produce_md_contact(x)
84+
name = contact$organisationName
85+
if(!is.null(contact$individualName)) name = contact$individualName
86+
list(name = name)
87+
}),
88+
production_date = production_date,
89+
version = entity$descriptions$edition
90+
)
91+
92+
#description (~ ISO 19115)
93+
#description/metadata
94+
project$description = list(
95+
idno = entity$identifiers[["id"]],
96+
language = entity$language,
97+
characterSet = list(codeListValue = "utf8"),
98+
hierarchyLevel = entity$types[["generic"]],
99+
contact = lapply(metadata_maintainers, produce_md_contact),
100+
dateStamp = production_date,
101+
metadataStandardName = "ISO 19115:2003/19139"
102+
)
103+
104+
#description/spatialRepresentationInfo
105+
project$description$spatialRepresentationInfo = list()
106+
#spatial representation
107+
if(!is.null(entity$data)) {
108+
spatialRepresentationType <- entity$data$spatialRepresentationType
109+
if(!is.null(spatialRepresentationType)){
110+
if(spatialRepresentationType=="vector"){
111+
features = entity$data$features
112+
if(!is.null(features)){
113+
#support vector spatial representation
114+
if(is(features, "sf")){
115+
geomtypes <- as.list(table(sf::st_geometry_type(features)))
116+
geomtypes <- geomtypes[geomtypes > 0]
117+
if(length(geomtypes)>0){
118+
#spatialRepresentationType <- "vector"
119+
for(geomtype in names(geomtypes)){
120+
vsr = list()
121+
geomLevel <- "geometryOnly"
122+
if(geomtype == "TIN") geomLevel = "planarGraph"
123+
if(geomLevel == "geometryOnly"){
124+
isoGeomType <- switch(geomtype,
125+
"GEOMETRY" = "composite", "GEOMETRYCOLLECTION" = "composite",
126+
"POINT" = "point", "MULTIPOINT" = "point",
127+
"LINESTRING" = "curve", "CIRCULARSTRING" = "curve", "MULTILINESTRING" = "curve", "CURVE" = "curve", "COMPOUNDCURVE" = "curve",
128+
"POLYGON" = "surface", "MULTIPOLYGON" = "surface", "TRIANGLE" = "surface",
129+
"CURVEPOLYGON" = "surface", "SURFACE" = "surface", "MULTISURFACE" = "surface",
130+
"POLYHEDRALSURFACE" = "solid"
131+
)
132+
133+
vsr = list(
134+
topologyLevel = geomLevel,
135+
geometricObjects = list(
136+
list(
137+
geometricObjectType = isoGeomType,
138+
geometricObjectCount = nrow(features[sf::st_geometry_type(features)==geomtype,])
139+
)
140+
)
141+
)
142+
}
143+
project$description$spatialRepresentationInfo[[1]] = list(
144+
vectorSpatialRepresentation = vsr
145+
)
146+
}
147+
}else{
148+
spatialRepresentationType <- "textTable"
149+
}
150+
}
151+
}
152+
}
153+
154+
if(spatialRepresentationType=="grid"){
155+
gsr = list()
156+
gsr$numberOfDimensions = length(entity$data$dimensions)
157+
for(dimension in names(entity$data$dimensions)){
158+
dimObject <- list()
159+
dimObject$dimensionName = dimension
160+
dimObject$dimensionSize = entity$data$dimensions[[dimension]]$size
161+
resolution<-entity$data$dimensions[[dimension]]$resolution
162+
if(!is.null(resolution$value)){
163+
dimObject$resolution = resolution$value
164+
}
165+
gsr$axisDimensionproperties[[length(gsr$axisDimensionproperties)+1]] = dimObject
166+
}
167+
gsr$cellGeometry = "area"
168+
project$description$spatialRepresentationInfo = list(
169+
gridSpatialRepresentation = gsr
170+
)
171+
}
172+
}
173+
}
174+
175+
#description/referenceSystemInfo
176+
project$description$referenceSystemInfo = list()
177+
if(!is.null(entity$srid)){
178+
project$description$referenceSystemInfo[[1]] = list(
179+
code = as.character(entity$srid),
180+
codeSpace = "EPSG"
181+
)
182+
if(entity$srid == 4326){
183+
#we add also the WGS one
184+
project$description$referenceSystemInfo[[2]] = list(
185+
code = "WGS 84",
186+
codeSpace = "World Geodetic System (WGS)"
187+
)
188+
}
189+
}
190+
191+
#description/identificationInfo
192+
project$description$identificationInfo = list(
193+
citation = list(
194+
title = entity$titles[["title"]],
195+
alternateTitle = if(!is.null(entity$titles[["alternative"]])) entity$titles[["alternative"]] else "",
196+
date = lapply(entity$dates, function(x){
197+
list(date = x$value, type = x$key)
198+
}),
199+
edition = entity$descriptions$edition,
200+
editionDate = if(any(sapply(entity$dates, function(x){x$key == "edition"}))){
201+
entity$dates[sapply(entity$dates, function(x){x$key == "edition"})][[1]]$value
202+
}else "",
203+
identifier = list(authority = "WB-DECDG", code = entity$identifiers[["id"]]),
204+
#otherCitationDetails = ""
205+
citedResponsibleParty = lapply(producers, produce_md_contact)
206+
),
207+
abstract = entity$descriptions$abstract,
208+
purpose = if(!is.null(entity$descriptions$purpose)) entity$descriptions$purpose else "",
209+
credit = if(!is.null(entity$descriptions$credit)) entity$descriptions$credit else "",
210+
status = if(!is.null(entity$descriptions$status)) entity$descriptions$status else "",
211+
pointOfContact = lapply(poc, produce_md_contact),
212+
resourceMaintenance = list(
213+
list(maintenanceOrUpdateFrequency = "asNeeded")
214+
),
215+
graphicOverview= if(length(thumbnails)>0) lapply(1:length(thumbnails), function(i){
216+
thumbnail = thumbnails[[i]]
217+
th = list(fileName = thumbnail$link)
218+
if(!is.null(thumbnail$description)) th$fileDescription = thumbnail$description
219+
return(th)
220+
}) else list(),
221+
resourceFormat = lapply(entity$formats[sapply(entity$formats, function(x){x$key == "resource"})], function(resourceFormat){
222+
rf = list(name = resourceFormat$name)
223+
if(!is.null(resourceFormat$description)) rf$specification = resourceFormat$description
224+
return(rf)
225+
}),
226+
descriptiveKeywords = do.call(c, lapply(entity$subjects[sapply(entity$subjects, function(x){return(x$key != "topic")})], function(subject){
227+
lapply(subject$keywords, function(kwd){
228+
out_kwd = list(type = subject$key, keyword = kwd$name)
229+
if(!is.null(subject$name)) out_kwd$thesaurusName = subject$name
230+
return(out_kwd)
231+
})
232+
})),
233+
resourceConstraints = list(
234+
list(
235+
legalConstraints = list(
236+
useLimitation = lapply(entity$rights[sapply(entity$rights, function(x){tolower(x$key) == "uselimitation"})], function(cons){
237+
cons$values[[1]]
238+
}),
239+
accessConstraints = lapply(entity$rights[sapply(entity$rights, function(x){tolower(x$key) == "accessconstraint"})], function(cons){
240+
cons$values[[1]]
241+
}),
242+
useConstraints = lapply(entity$rights[sapply(entity$rights, function(x){tolower(x$key) == "useconstraint"})], function(cons){
243+
cons$values[[1]]
244+
})
245+
)
246+
)
247+
),
248+
#resourceSpecificUsage
249+
#aggregationInfo
250+
extent = list(
251+
geographicElement = list(
252+
list(
253+
geographicBoundingBox = list(
254+
southBoundLatitude = entity$spatial_bbox$ymin,
255+
westBoundLongitude = entity$spatial_bbox$xmin,
256+
northBoundLatitude = entity$spatial_bbox$ymax,
257+
eastBoundLongitude = entity$spatial_bbox$xmax
258+
)
259+
)
260+
),
261+
temporalElement = list(
262+
if(!is.null(entity$temporal_extent$instant)){
263+
list(timePosition = entity$temporal_extent$instant)
264+
}else if(!is.null(entity$temporal_extent$start) & !is.null(entity$temporal_extent$end)){
265+
list(beginPosition = entity$temporal_extent$start, endPosition = entity$temporal_extent$end)
266+
}
267+
)
268+
),
269+
spatialRepresentationType = entity$data$spatialRepresentationType,
270+
language = list(entity$language),
271+
characterSet = list(
272+
list(codeListValue = "utf8")
273+
),
274+
supplementalInformation = if(!is.null(entity$descriptions$info)) entity$descriptions$info else ""
275+
)
276+
277+
#description/distributionInfo
278+
project$description$distributionInfo = list(
279+
distributionFormat = lapply(entity$formats[sapply(entity$formats, function(x){x$key == "distribution"})], function(distFormat){
280+
df = list(name = distFormat$name)
281+
if(!is.null(distFormat$description)) df$specification = distFormat$description
282+
return(df)
283+
}),
284+
distributor = lapply(distributors, produce_md_contact)
285+
)
286+
287+
#description/dataQualityInfo
288+
project$description$dataQualityInfo = list()
289+
if(!is.null(entity$provenance)){
290+
project$description$dataQualityInfo = list(
291+
list(
292+
lineage = list(
293+
statement = entity$provenance$statement,
294+
processStep = lapply(entity$provenance$processes, function(process){
295+
list(
296+
description = process$description,
297+
rationale = process$rationale,
298+
processor = lapply(process$processors, produce_md_contact)
299+
)
300+
})
301+
)
302+
)
303+
)
304+
}
305+
306+
#description/metadataMaintenance
307+
project$description$metadataMaintenance = list(maintenanceAndUpdateFrequency = "asNeeded")
308+
309+
#description/contentInfo
310+
#description/feature_catalogue (common to all metadata standards?)
311+
312+
#creation
313+
output = metadataeditr::create_project(
314+
type = "geospatial",
315+
idno = entity$identifiers[["id"]],
316+
metadata = project,
317+
collection_names = collection_names,
318+
thumbnail = if(length(thumbnails)>0) file.path(getwd(), "thumbnails", thumbnails[[1]]$link) else NULL, #TODO
319+
overwrite = TRUE
320+
)
321+
322+
if(output$response$status == "success"){
323+
config$logger.info(sprintf("Project '%s' successfully submitted to metadata editor", entity$identifiers$id))
324+
}
325+
326+
#add resources
327+
#first remove existing resources
328+
reslist = metadataeditr::resources_list(entity$identifiers[["id"]])
329+
if(reslist$status_code==200){
330+
existing_resources = reslist$response$resources
331+
if(length(existing_resources)>0) for(i in 1:nrow(existing_resources)){
332+
metadataeditr::resources_delete(idno = entity$identifiers[["id"]], resource_id = existing_resources[i,]$id)
333+
}
334+
}
335+
336+
#thumbnails
337+
if(length(thumbnails)>0){
338+
for(thumbnail in thumbnails){
339+
metadataeditr::resources_add(
340+
idno = entity$identifiers[["id"]],
341+
dctype = "pic",
342+
title = thumbnail$name,
343+
file_path = file.path(getwd(), "thumbnails", thumbnail$link)
344+
)
345+
}
346+
}
347+
}

0 commit comments

Comments
 (0)