diff --git a/R/geoflow_action_geometa_create_iso_19115.R b/R/geoflow_action_geometa_create_iso_19115.R index dfcf480..727fd0d 100644 --- a/R/geoflow_action_geometa_create_iso_19115.R +++ b/R/geoflow_action_geometa_create_iso_19115.R @@ -264,12 +264,25 @@ geometa_create_iso_19115 <- function(entity, config, options){ #extents extent <- ISOExtent$new() #geographic extent - if(!is.null(entity$spatial_extent)){ - sf_bbox <- entity$spatial_extent + if(!is.null(entity$spatial_bbox)){ + sf_bbox <- entity$spatial_bbox bbox <- ISOGeographicBoundingBox$new(minx = sf_bbox$xmin, miny = sf_bbox$ymin, maxx = sf_bbox$xmax, maxy = sf_bbox$ymax) extent$addGeographicElement(bbox) } - #bounding polygons (if any features & 'addfeatures' option is enabled) + #bounding polygons from spatial coverage + #(applies to spatial coverage set-up from wkt) + if(is(entity$spatial_extent, "sfc")){ + bbox_sfc <- sf::st_as_sfc(sf::st_bbox(entity$spatial_extent)) + #if bbox (as geometry) is different from the spatial extent + #then we have more complex geometries + if(bbox_sfc != entity$spatial_extent){ + sbp <- ISOBoundingPolygon$new() + geom <- GMLAbstractGeometry$fromSimpleFeatureGeometry(entity$spatial_extent[[1]]) + sbp$addPolygon(geom) + extent$addGeographicElement(sbp) + } + } + #bounding polygons from data (if any features & 'addfeatures' option is enabled) if(!is.null(features) && addfeatures){ bp <- ISOBoundingPolygon$new() for(i in 1:nrow(features)){ diff --git a/R/geoflow_action_geosapi_publish_ogc_services.R b/R/geoflow_action_geosapi_publish_ogc_services.R index 669b66c..7eefaaf 100644 --- a/R/geoflow_action_geosapi_publish_ogc_services.R +++ b/R/geoflow_action_geosapi_publish_ogc_services.R @@ -114,7 +114,7 @@ geosapi_publish_ogc_services <- function(entity, config, options){ featureType$setNativeCRS(epsgCode) featureType$setEnabled(TRUE) featureType$setProjectionPolicy("FORCE_DECLARED") - bbox <- entity$spatial_extent + bbox <- entity$spatial_bbox featureType$setLatLonBoundingBox(bbox$xmin, bbox$ymin, bbox$xmax, bbox$ymax, crs = epsgCode) featureType$setNativeBoundingBox(bbox$xmin, bbox$ymin, bbox$xmax, bbox$ymax, crs = epsgCode) for(subject in entity$subjects){ diff --git a/R/geoflow_entity.R b/R/geoflow_entity.R index 6542c5c..a69f60b 100644 --- a/R/geoflow_entity.R +++ b/R/geoflow_entity.R @@ -13,6 +13,7 @@ geoflow_entity <- R6Class("geoflow_entity", relations = list(), rights = list(), spatial_extent = NULL, + spatial_bbox = NULL, srid = NULL, temporal_extent = NULL, provenance = NULL, @@ -85,18 +86,37 @@ geoflow_entity <- R6Class("geoflow_entity", self$rights <- c(self$rights, right) }, - #setSpatialExtent + #setSpatialExtent (method call from handler, but not from enrichWithFeatures) setSpatialExtent = function(wkt = NULL, bbox = NULL, data = NULL, crs = NA){ if(is.null(wkt) & is.null(bbox) & is.null(data)){ stop("At least one of the arguments 'wkt' (WKT string) or 'bbox' should be provided!") } - if(!is.null(wkt)) spatial_extent <- attr(sf::st_as_sfc(wkt, crs = crs), "bbox") + spatial_extent <- NULL + if(!is.null(wkt)) spatial_extent <- sf::st_as_sfc(wkt, crs = crs) if(!is.null(bbox)) spatial_extent <- bbox - if(!is.null(data)) spatial_extent <- sf::st_bbox(data) + if(!is.null(data)) spatial_extent <- data + if(class(spatial_extent)[1]=="try-error"){ stop("The spatial extent is invalid!") } self$spatial_extent <- spatial_extent + self$setSpatialBbox(wkt, bbox, data, crs) + }, + + #setSpatialBbox (method call from handler in setSpatialExtent, and from enrichWithFeatures) + setSpatialBbox = function(wkt = NULL, bbox = NULL, data = NULL, crs = NA){ + if(is.null(wkt) & is.null(bbox) & is.null(data)){ + stop("At least one of the arguments 'wkt' (WKT string) or 'bbox' should be provided!") + } + spatial_bbox <- NULL + if(!is.null(wkt)) spatial_bbox <- sf::st_bbox(sf::st_as_sfc(wkt, crs = crs)) + if(!is.null(bbox)) spatial_bbox <- bbox + if(!is.null(data)) spatial_bbox <- sf::st_bbox(data) + + if(class(spatial_bbox)[1]=="try-error"){ + stop("The spatial bbox is invalid!") + } + self$spatial_bbox <- spatial_bbox }, #setSrid @@ -337,8 +357,8 @@ geoflow_entity <- R6Class("geoflow_entity", } } #dynamic spatial extent - config$logger.info("Overwriting entity extent with shapefile extent") - self$setSpatialExtent(data = sf.data) + config$logger.info("Overwriting entity bounding box with shapefile bounding box") + self$setSpatialBbox(data = sf.data) }else{ warnMsg <- sprintf("Cannot read data source '%s'. Dynamic metadata computation aborted!", trgShp) @@ -372,8 +392,8 @@ geoflow_entity <- R6Class("geoflow_entity", } } #dynamic spatial extent - config$logger.info("Overwriting entity extent with DB spatial table extent") - self$setSpatialExtent(data = sf.data) + config$logger.info("Overwriting entity bounding box with DB spatial table bounding box") + self$setSpatialBbox(data = sf.data) }else{ warnMsg <- sprintf("DB table '%s' is not spatialized. Dynamic metadata computation aborted!", datasource_name) config$logger.warn(warnMsg) @@ -412,8 +432,8 @@ geoflow_entity <- R6Class("geoflow_entity", } } #dynamic spatial extent - config$logger.info("Overwriting entity extent with DB spatial view extent") - self$setSpatialExtent(data = sf.data) + config$logger.info("Overwriting entity bounding box with DB spatial view bounding box") + self$setSpatialBbox(data = sf.data) }else{ warnMsg <- sprintf("DB view '%s' is not spatialized. Dynamic metadata computation aborted!", datasource_name) config$logger.warn(warnMsg) @@ -494,8 +514,8 @@ geoflow_entity <- R6Class("geoflow_entity", } } #dynamic spatial extent - config$logger.info("Overwriting entity extent with SQL query output extent") - self$setSpatialExtent(data = sf.data) + config$logger.info("Overwriting entity bounding box with SQL query output bounding box") + self$setSpatialBbox(data = sf.data) #dynamic view properties required geomtype <- as.character(unique(sf::st_geometry_type(sf.data))[1]) @@ -551,7 +571,7 @@ geoflow_entity <- R6Class("geoflow_entity", new_thumbnail$setLink(sprintf("%s/%s/ows?service=WMS&version=1.1.0&request=GetMap&layers=%s&bbox=%s&width=600&height=300&srs=EPSG:%s&format=image/png", config$software$output$geoserver_config$parameters$url, config$software$output$geoserver_config$properties$workspace, - layername, paste(self$spatial_extent,collapse=","),self$srid)) + layername, paste(self$spatial_bbox,collapse=","),self$srid)) self$relations <- c(new_thumbnail, self$relation) #here we use native vector to put WMS as first thumbnail #WMS new_wms <- geoflow_relation$new()