impl #309 #376

r-geoflow · Nov 27, 2023 · a72a9bf · a72a9bf
1 parent 33771d9
commit a72a9bf
Show file tree

Hide file tree

Showing 4 changed files with 77 additions and 34 deletions.
diff --git a/R/executeWorkflowJob.R b/R/executeWorkflowJob.R
@@ -29,6 +29,7 @@ executeWorkflowJob <- function(config, jobdir = NULL, queue = NULL, monitor = NU
       skipDataDownload = config$profile$options$skipFileDownload
     }
     skipDataDownload <- if(!is.null(config$profile$options$skipDataDownload)) config$profile$options$skipDataDownload else FALSE
+    skipEnrichWithData = if(!is.null(config$profile$options$skipEnrichWithData)) config$profile$options$skipEnrichWithData else FALSE
 
     #Actions onstart
     config$log_separator("-")
@@ -136,17 +137,22 @@ executeWorkflowJob <- function(config, jobdir = NULL, queue = NULL, monitor = NU
               entity$copyDataToJobDir(config, jobdir)
               #vector data: we enrich entity with features
               #control is added in case of entity already enriched with features/coverages (when loaded from custom R entity handlers)
-              if(is.null(entity$data$features) && is.null(entity$data$coverages)){
+              if(!skipEnrichWithData) if(is.null(entity$data$features) && is.null(entity$data$coverages)){
                 entity$enrichWithData(config, jobdir)
               }
 
               setwd(entity$getEntityJobDirPath(config, jobdir)) #make sure we are in entity jobdir
               #we check if the source and upload are both different file format (csv,shp,gpkg) and process automatically to conversion from source to upload type
               entity$prepareFeaturesToUpload(config)
             }else{
-              config$logger.info("SkipDataDownload is true: fetching spatial coverage from data (for DB sources only)...")
-              #alternative behaviors in case we don't download data, applies to DB only
-              entity$enrichSpatialCoverageFromDB(config)
+              config$logger.info("SkipDataDownload is true:")
+              if(!skipEnrichWithData){
+                config$logger.info("SkipEnrichWithData is false: Fetching spatial coverage from data (for DB sources only)...")
+                #alternative behaviors in case we don't download data, applies to DB only
+                entity$enrichSpatialCoverageFromDB(config)
+              }else{
+                config$logger.info("SkipEnrichWithData is true")
+              }
             }
 
             #extra identifiers to use in entity identification/actions

diff --git a/R/geoflow_featuremember.R b/R/geoflow_featuremember.R
@@ -49,8 +49,8 @@ geoflow_featuremember <- R6Class("geoflow_featuremember",
      initialize = function(type, code, name, def, defSource = NULL,
                            minOccurs = NULL, maxOccurs = NULL, uom = NULL,
                            registerId = NULL){
-       if(!type %in% c("attribute", "variable")){
-         stop("The member type should be either 'attribute' or 'variable'")
+       if(!(type %in% c("attribute", "variable") | startsWith(type, "gml:"))){
+         stop("The member type should be either 'attribute' or 'variable' or be a GML geometry type")
        }
        self$id = code
        self$type = type

diff --git a/doc/documentation.Rmd b/doc/documentation.Rmd
@@ -176,8 +176,9 @@ The ``options`` are by definition optional. The table below defines the possible
 Name|Definition|Default value
 ----|----------|-------------
 ``line_separator``|Defines the suite of characters used for splitting metadata components with a single tabular cell of an _entity_ (eg. Description field)|**_\n**
-``skipDataDownload``|Indicates whether data associated to an entity should be download|**false**
+``skipDataDownload``|Indicates whether downloading data associated to an entity should be skipped|**false**
 ``skipFileDownload``|Deprecated, use `skipDataDownload` instead.|**false**
+``skipEnrichWithData``|Indicates whether actual data objects (features/coverages) reading and association with entity data should be skipped or not|**false**
 ``skipDynamicBbox``|Indicates whether bbox inherited from data should be ignored.|**false**
 ``enrichDataStrategy``|Strategy to use when inheriting spatial bbox from multiple data objects, either "first" (take the first data object for the bbox, or "union" (union of bboxes from the different data objects).|**"first"*
 

diff --git a/inst/actions/geometa_create_iso_19110.R b/inst/actions/geometa_create_iso_19110.R
@@ -6,6 +6,8 @@ function(action, entity, config){
 
   ISOMetadataNamespace$GML$uri <- "http://www.opengis.net/gml/3.2"
 
+  skipEnrichWithData = if(!is.null(config$profile$options$skipEnrichWithData)) config$profile$options$skipEnrichWithData else FALSE
+
   #manage multiple sources (supposes a common data structure to expose as ISO 19110)
   data_objects <- list()
   if(is.null(entity$data$dir)){
@@ -15,11 +17,25 @@ function(action, entity, config){
   }
 
   #features if any
+  build_catalog_from_features = TRUE
   features = do.call("rbind", lapply(data_objects, function(data_object){data_object$features}))
   if(is.null(features)){
-    warnMsg <- sprintf("No data features associated to entity '%s'. Skip feature catalogue creation", entity$identifiers[["id"]])
-    config$logger.warn(warnMsg)
-    return(FALSE)
+    if(!skipEnrichWithData){
+      warnMsg <- sprintf("No data features associated to entity '%s' and global option 'skipEnrichWithData' is false. Skip feature catalogue creation", entity$identifiers[["id"]])
+      config$logger.warn(warnMsg)
+      return(FALSE)
+    }else{
+      fto <- entity$data$featureTypeObj
+      if(!is.null(fto)){
+        infoMsg <- "Global option 'skipEnrichWithData' is true. Feature catalogue will be created based on the dictionary only"
+        config$logger.info(infoMsg)
+        build_catalog_from_features = FALSE
+      }else{
+        warnMsg <- "Global option 'skipEnrichWithData' is true, but no dictionary available. Skip feature catalogue creation"
+        config$logger.warn(warnMsg)
+        return(FALSE)
+      }
+    }
   }
 
   #options
@@ -154,7 +170,14 @@ function(action, entity, config){
   ft$setCode(entity$identifiers$id)
   ft$setIsAbstract(FALSE)
 
-  columns <- c(colnames(features), unlist(extra_attributes))
+  columns <- if(build_catalog_from_features){
+    #from data features
+    c(colnames(features), unlist(extra_attributes))
+  }else{
+    #from dictionary
+    fto <- entity$data$featureTypeObj
+    sapply(fto$getMembers(), function(x){x$id})
+  }
   for(featureAttrName in columns){
 
     if(featureAttrName %in% exclude_attributes){
@@ -221,13 +244,12 @@ function(action, entity, config){
     }
 
     #add listed values
-    if(featureAttrName %in% colnames(features)){
+    featureAttrValues <- fat_attr_register$data$code
+    if(build_catalog_from_features) if(featureAttrName %in% colnames(features)){
       featureAttrValues <- switch(class(features)[1],
                                   "sf" = features[,featureAttrName][[1]],
                                   "data.frame" = features[,featureAttrName]
       )
-    }else{
-      featureAttrValues <- fat_attr_register$data$code
     }
 
     addValues <- TRUE
@@ -242,7 +264,7 @@ function(action, entity, config){
         if(fat_attr$type == "variable") addValues <- FALSE
       }
     }
-    if(addValues){
+    if(!is.null(featureAttrValues) & addValues){
       config$logger.info(sprintf("Listing values for feature Attribute '%s'...", featureAttrName)) 
       featureAttrValues <- unique(featureAttrValues)
       featureAttrValues <- featureAttrValues[order(featureAttrValues)]
@@ -273,26 +295,40 @@ function(action, entity, config){
     }
 
     #add primitive type + data type (attribute or variable) as valueType
-    fat_type <- switch(class(featureAttrValues[1])[1],
-                       "integer" = "xsd:int",
-                       "numeric" = "xsd:decimal",
-                       "character" = "xsd:string",
-                       "logical" = "xsd:boolean",
-                       "Date" = "xsd:date",
-                       "POSIXct" = "xsd:datetime",
-                       "sfc_POINT" = "gml:PointPropertyType",
-                       "sfc_MULTIPOINT" = "gml:MultiPointPropertyType",
-                       "sfc_LINESTRING" = "gml:LineStringPropertyType",
-                       "sfc_MULTILINESTRING" = "gml:MultiLineStringPropertyType",
-                       "sfc_POLYGON" = "gml:PolygonPropertyType",
-                       "sfc_MULTIPOLYGON" = "gml:MultiPolygonPropertyType"
-    )
+    fat_type <- if(build_catalog_from_features){
+      switch(class(featureAttrValues[1])[1],
+       "integer" = "xsd:int",
+       "numeric" = "xsd:decimal",
+       "character" = "xsd:string",
+       "logical" = "xsd:boolean",
+       "Date" = "xsd:date",
+       "POSIXct" = "xsd:datetime",
+       "sfc_POINT" = "gml:PointPropertyType",
+       "sfc_MULTIPOINT" = "gml:MultiPointPropertyType",
+       "sfc_LINESTRING" = "gml:LineStringPropertyType",
+       "sfc_MULTILINESTRING" = "gml:MultiLineStringPropertyType",
+       "sfc_POLYGON" = "gml:PolygonPropertyType",
+       "sfc_MULTIPOLYGON" = "gml:MultiPolygonPropertyType"
+      )
+    }else{
+      type = if(!is.null(fto)) fto$getMemberById(featureAttrName)$type else "attribute"
+      switch(type,
+        "attribute" = "xsd:string",
+        "variable" = "xsd:decimal",
+        type
+      )
+    }
     config$logger.info(sprintf("Set primitive type '%s' for feature Attribute '%s'...", fat_type, featureAttrName))
-    fat_generic_type <- switch(class(featureAttrValues[1])[1],
-                               "integer" = "variable",
-                               "numeric" = "variable",
-                               "attribute"
-    )
+    fat_generic_type <- if(build_catalog_from_features){
+      switch(class(featureAttrValues[1])[1],
+       "integer" = "variable",
+       "numeric" = "variable",
+       "attribute"
+      )
+    }else{
+      if(!is.null(fto)) fto$getMemberById(featureAttrName)$type else "attribute"
+    }
+    config$logger.info(sprintf("Feature member generic type for '%s': %s", featureAttrName, fat_generic_type))
     if(!is.null(fat_attr)) fat_generic_type <- fat_attr$type
     fat_type_anchor <- ISOAnchor$new(name = fat_type, href = fat_generic_type)
     fat$setValueType(fat_type_anchor)