implement #346

NAMESPACE

@@ -64,9 +64,12 @@ export(initWorkflowJob)
 export(is_absolute_path)
 export(list_action_options)
 export(list_actions)
+export(list_contact_handler_options)
 export(list_contact_handlers)
 export(list_data_accessors)
+export(list_dictionary_handler_options)
 export(list_dictionary_handlers)
+export(list_entity_handler_options)
 export(list_entity_handlers)
 export(list_registers)
 export(list_software)

R/geoflow_handler.R

@@ -8,9 +8,10 @@
 #' @title Geoflow handler class
 #' @description This class models a content handler. An handler is a method to handle
 #' some content (eg entity or contact). It is mainly driven by a function that takes
-#' as argument a \code{config} object, as the overall configuration created by geoflow 
-#' \code{initWorkflow} function, and a source which identifiers the source to be handled,
-#' that can be of a different type (eg a URL, a file path) depending on the handler.
+#' as argument the \code{handler} considered (as self accessible object), a \code{source} 
+#' which identifiers the source to be handled, that can be of a different type (eg a URL, a file path) 
+#' depending on the handler, and a \code{config} object, as the overall configuration created by geoflow 
+#' \code{initWorkflow} function. 
 #' @keywords handler
 #' @return Object of \code{\link{R6Class}} for modelling a handler
 #' @format \code{\link{R6Class}} object.
@@ -21,7 +22,8 @@
 #'    id = "some-id",
 #'    def = "some definition",
 #'    packages = list(),
-#'    fun = function(config, source){}
+#'    fun = function(handler, source, config){},
+#'    available_options = list()
 #'  )
 #' }
 #' 
@@ -42,19 +44,28 @@ geoflow_handler <- R6Class("geoflow_handler",
     fun = NA,
     #'@field script handler script
     script = NA,
+    #'@field options options
+    options = list(),
+    #'@field available_options available options
+    available_options = list(),
 
     #'@description Initializes a \link{geoflow_handler}
     #'@param id id
     #'@param def def
     #'@param packages list of packages required for the handler
     #'@param fun the handler \code{function} having 2 arguments \code{config} and \code{source}
     #'@param script a handler script
-    initialize = function(id, def = "", packages = list(), fun = NULL, script = NULL){
+    #'@param options action options
+    #'@param available_options available options for the action
+    initialize = function(id, def = "", packages = list(), fun = NULL, script = NULL, 
+                          options = list(), available_options = list()){
       self$id <- id
       self$def <- def
       self$packages <- packages
       self$fun <- fun
       self$script <- script
+      self$options <- options
+      self$available_options <- available_options
     },
 
     #'@description Check that all packages required for the handler are available, if yes,
@@ -77,6 +88,17 @@ geoflow_handler <- R6Class("geoflow_handler",
           print(out_pkgs)
         }
       }
+    },
+
+    #'@description Get handler option value
+    #'@param option option id
+    #'@return the option value, either specified through a workflow, or the default value
+    getOption = function(option){
+      option_value <- self$options[[option]]
+      if(is.null(option_value)){
+        option_value <- self$available_options[[option]]$default
+      }
+      return(option_value)
     }
   )
 )

R/geoflow_handler_contact.R

@@ -77,3 +77,39 @@ list_contact_handlers <- function(raw = FALSE){
   }
   return(handlers)
 }
+
+#' @name list_contact_handler_options
+#' @aliases list_contact_handler_options
+#' @title list_contact_handler_options
+#' @description \code{list_contact_handler_options} lists the options available for a given contact handler supported by geoflow.
+#'
+#' @usage list_contact_handler_options(id, raw)
+#' 
+#' @param id An contact handler identifier
+#' @param raw if raw list should be returned
+#' 
+#' @return an object of class \code{data.frame} (or \code{list} if raw is TRUE) listing the available handler options.
+#' 
+#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
+#' @export
+#'
+list_contact_handler_options <- function(id, raw = FALSE){
+  out <- NULL
+  handlers <- list_contact_handlers(raw = TRUE)
+  handler <- handlers[sapply(handlers, function(x){x$id == id})]
+  if(length(handler)==0) stop(sprintf("No handler with id '%s'!", id))
+  handler <- handler[[1]]
+  if(raw) return(handler$available_options)
+  if(length(handler$available_options)>0){
+    out <- data.frame(
+      name = names(handler$available_options),
+      definition = sapply(handler$available_options, function(x){x$def}),
+      default = sapply(handler$available_options, function(x){paste0(x$default, collapse=",")}),
+      stringsAsFactors = FALSE
+    )
+    row.names(out) <- 1:nrow(out)
+  }else{
+    out <- data.frame(name = character(0), definition = character(0))
+  }
+  return(out)
+}

R/geoflow_handler_dictionary.R

@@ -78,4 +78,38 @@ list_dictionary_handlers <- function(raw = FALSE){
   return(handlers)
 }
 
-
+#' @name list_dictionary_handler_options
+#' @aliases list_dictionary_handler_options
+#' @title list_dictionary_handler_options
+#' @description \code{list_dictionary_handler_options} lists the options available for a given dictionary handler supported by geoflow.
+#'
+#' @usage list_dictionary_handler_options(id, raw)
+#' 
+#' @param id An dictionary handler identifier
+#' @param raw if raw list should be returned
+#' 
+#' @return an object of class \code{data.frame} (or \code{list} if raw is TRUE) listing the available handler options.
+#' 
+#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
+#' @export
+#'
+list_dictionary_handler_options <- function(id, raw = FALSE){
+  out <- NULL
+  handlers <- list_dictionary_handlers(raw = TRUE)
+  handler <- handlers[sapply(handlers, function(x){x$id == id})]
+  if(length(handler)==0) stop(sprintf("No handler with id '%s'!", id))
+  handler <- handler[[1]]
+  if(raw) return(handler$available_options)
+  if(length(handler$available_options)>0){
+    out <- data.frame(
+      name = names(handler$available_options),
+      definition = sapply(handler$available_options, function(x){x$def}),
+      default = sapply(handler$available_options, function(x){paste0(x$default, collapse=",")}),
+      stringsAsFactors = FALSE
+    )
+    row.names(out) <- 1:nrow(out)
+  }else{
+    out <- data.frame(name = character(0), definition = character(0))
+  }
+  return(out)
+}

R/geoflow_handler_entity.R

@@ -15,7 +15,10 @@ register_entity_handlers <- function(){
     geoflow_handler$new(
       id = "csv",
       def = "Handle metadata entities from a CSV file",
-      fun = source(system.file("metadata/entity", "entity_handler_csv.R", package = "geoflow"))$value
+      fun = source(system.file("metadata/entity", "entity_handler_csv.R", package = "geoflow"))$value,
+      available_options = list(
+        guess_max = list(def = "Guess max argument, see readr::read_csv", default = 0)
+      )
     ),
     geoflow_handler$new(
       id = "excel",
@@ -123,4 +126,40 @@ list_entity_handlers <- function(raw = FALSE){
     }))
   }
   return(handlers)
-}
+}
+
+#' @name list_entity_handler_options
+#' @aliases list_entity_handler_options
+#' @title list_entity_handler_options
+#' @description \code{list_entity_handler_options} lists the options available for a given entity handler supported by geoflow.
+#'
+#' @usage list_entity_handler_options(id, raw)
+#' 
+#' @param id An entity handler identifier
+#' @param raw if raw list should be returned
+#' 
+#' @return an object of class \code{data.frame} (or \code{list} if raw is TRUE) listing the available handler options.
+#' 
+#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
+#' @export
+#'
+list_entity_handler_options <- function(id, raw = FALSE){
+  out <- NULL
+  handlers <- list_entity_handlers(raw = TRUE)
+  handler <- handlers[sapply(handlers, function(x){x$id == id})]
+  if(length(handler)==0) stop(sprintf("No handler with id '%s'!", id))
+  handler <- handler[[1]]
+  if(raw) return(handler$available_options)
+  if(length(handler$available_options)>0){
+    out <- data.frame(
+      name = names(handler$available_options),
+      definition = sapply(handler$available_options, function(x){x$def}),
+      default = sapply(handler$available_options, function(x){paste0(x$default, collapse=",")}),
+      stringsAsFactors = FALSE
+    )
+    row.names(out) <- 1:nrow(out)
+  }else{
+    out <- data.frame(name = character(0), definition = character(0))
+  }
+  return(out)
+}

R/initWorkflow.R

@@ -277,7 +277,11 @@ initWorkflow <- function(file, dir = ".", jobDirPath = NULL, handleMetadata = TR
 
         md_dict_handler <- loadMetadataHandler(config, x, type = "dictionary")
         config$logger.info("Execute handler to load dictionary data structures...")
-        dict <- md_dict_handler(config, source = x$source)
+        dict <- md_dict_handler$fun(
+          handler = md_dict_handler,
+          source = x$source,
+          config = config
+        )
 
         if(!is(dict, "geoflow_dictionary")){
           errMsg <- "The output of the dictionary handler should return an object of class 'geoflow_dictionary'"
@@ -392,7 +396,11 @@ initWorkflow <- function(file, dir = ".", jobDirPath = NULL, handleMetadata = TR
                                    x$source, x$handler))
         md_contact_handler <- loadMetadataHandler(config, x, type = "contacts")
         config$logger.info("Execute contact handler to load contacts...")
-        contacts <- md_contact_handler(config, source = x$source)
+        contacts <- md_contact_handler$fun(
+          handler = md_contact_handler, 
+          source = x$source,
+          config = config
+        )
 
         if(!is(contacts, "list") | !all(sapply(contacts, is, "geoflow_contact"))){
           errMsg <- "The output of the contacts handler should return a list of objects of class 'geoflow_entity_contact'"
@@ -427,7 +435,11 @@ initWorkflow <- function(file, dir = ".", jobDirPath = NULL, handleMetadata = TR
                                    x$source, x$handler))
         md_entity_handler <- loadMetadataHandler(config, x, type = "entities")
         config$logger.info("Execute handler to load entities...")
-        entities <- md_entity_handler(config, source = x$source)
+        entities <- md_entity_handler$fun(
+          handler = md_entity_handler,
+          source = x$source,
+          config = config
+        )
 
         if(!is(entities, "list") | !all(sapply(entities, is, "geoflow_entity"))){
           errMsg <- "The output of the entities handler should return a list of objects of class 'geoflow_entity'"

R/loadMetadataHandler.R

@@ -8,6 +8,7 @@
 #' @param config a geoflow configuration (as list). Only used to write logs, can be NULL.
 #' @param element a geoflow configuration metadata list element
 #' @param type either 'contacts', 'entities' or 'dictionnary'
+#' @return an object of class \link{geoflow_handler}
 #' 
 #' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
 #' @export
@@ -42,7 +43,8 @@ loadMetadataHandler <- function(config, element, type){
       errMsg <- sprintf("Missing 'source' for handler '%s'", h)
     }
 
-    md_handler <- md_default_handlers[sapply(md_default_handlers, function(x){x$id==h})][[1]]$fun
+    md_handler <- md_default_handlers[sapply(md_default_handlers, function(x){x$id==h})][[1]]
+    md_handler$options = element$options
 
   }else{
     #in case handler is a script
@@ -55,20 +57,21 @@ loadMetadataHandler <- function(config, element, type){
       stop(errMsg)
     }
     source(h_script) #load script
-    md_handler <- try(eval(parse(text = h)))
-    if(is(md_handler,"try-error")){
+    md_handler_fun <- try(eval(parse(text = h)))
+    if(is(md_handler_fun,"try-error")){
       errMsg <- sprintf("Failed loading function '%s. Please check the script '%s'", h, h_script)
       if(!is.null(config)) config$logger.error(errMsg)
       stop(errMsg)
     }
 
     #check custom handler arguments
-    args <- names(formals(md_handler))
-    if(!all(c("config", "source") %in% args)){
-      errMsg <- "The handler function should at least include the parameters (arguments) 'config' and 'source'"
+    args <- names(formals(md_handler_fun))
+    if(!all(c("handler", "source", "config") %in% args)){
+      errMsg <- "The handler function should at least include the parameters (arguments) 'handler', 'source' and 'config'"
       if(!is.null(config)) config$logger.error(errMsg)
       stop(errMsg)
     }
+    md_handler = geoflow_handler$new(id = h, fun = md_handler_fun, options = element$options)
   }
   return(md_handler)
 }

inst/metadata/contact/contact_handler_csv.R

@@ -1,5 +1,5 @@
 #handle_contacts_csv
-handle_contacts_csv <- function(config, source, handle = TRUE){
+handle_contacts_csv <- function(handler, source, config, handle = TRUE){
 
   #read csv TODO -> options management: sep, encoding etc
   #source <- read.csv(source)
@@ -8,6 +8,6 @@ handle_contacts_csv <- function(config, source, handle = TRUE){
 
   #apply generic handler
   handle_contacts_df <- source(system.file("metadata/contact", "contact_handler_df.R", package = "geoflow"))$value
-  contacts <- handle_contacts_df(config, source)
+  contacts <- handle_contacts_df(handler, source, config)
   return(contacts)
 }

inst/metadata/contact/contact_handler_dbi.R

@@ -1,5 +1,5 @@
 #handle_contacts_dbi
-handle_contacts_dbi <- function(config, source, handle = TRUE){
+handle_contacts_dbi <- function(handler, source, config, handle = TRUE){
   dbi <- config$software$input$dbi
   if(is.null(dbi)){
     stop("There is no database input software configured to handle contacts from DB")
@@ -26,7 +26,7 @@ handle_contacts_dbi <- function(config, source, handle = TRUE){
 
   #apply generic handler
   handle_contacts_df <- source(system.file("metadata/contact", "contact_handler_df.R", package = "geoflow"))$value
-  contacts <- handle_contacts_df(config, source)
+  contacts <- handle_contacts_df(handler, source, config)
   return(contacts)
 
 }

inst/metadata/contact/contact_handler_df.R

@@ -1,5 +1,5 @@
 #handle_contacts_df
-handle_contacts_df <- function(config, source){
+handle_contacts_df <- function(handler, source, config){
 
   if(!is(source, "data.frame")){
     errMsg <- "Error in 'handle_contact_df': source parameter should be an object of class 'data.frame'"

inst/metadata/contact/contact_handler_excel.R

@@ -1,5 +1,5 @@
 #handle_contacts_excel
-handle_contacts_excel <- function(config, source, handle = TRUE){
+handle_contacts_excel <- function(handler, source, config, handle = TRUE){
 
   isSourceUrl <- regexpr("(http|https)[^([:blank:]|\\\"|<|&|#\n\r)]+", source) > 0
   if(isSourceUrl){
@@ -16,6 +16,6 @@ handle_contacts_excel <- function(config, source, handle = TRUE){
 
   #apply generic handler
   handle_contacts_df <- source(system.file("metadata/contact", "contact_handler_df.R", package = "geoflow"))$value
-  contacts <- handle_contacts_df(config, source)
+  contacts <- handle_contacts_df(handler, source, config)
   return(contacts)
 }

inst/metadata/contact/contact_handler_gsheet.R

@@ -1,12 +1,12 @@
 #handle_contacts_gsheet
-handle_contacts_gsheet <- function(config, source, handle = TRUE){
+handle_contacts_gsheet <- function(handler, source, config, handle = TRUE){
 
   #read gsheet URL
   source <- as.data.frame(gsheet::gsheet2tbl(source))
   if(!handle) return(source)
 
   #apply generic handler
   handle_contacts_df <- source(system.file("metadata/contact", "contact_handler_df.R", package = "geoflow"))$value
-  contacts <- handle_contacts_df(config, source)
+  contacts <- handle_contacts_df(handler, source, config)
   return(contacts)
 }

inst/metadata/contact/contact_handler_ocs.R

@@ -1,5 +1,5 @@
 #handle_contacts_ocs
-handle_contacts_ocs <- function(config, source, handle = TRUE){
+handle_contacts_ocs <- function(handler, source, config, handle = TRUE){
 
   if(!requireNamespace("ocs4R", quietly = TRUE)){
     stop("The OCS handler requires the 'ocs4R' package")
@@ -15,11 +15,11 @@ handle_contacts_ocs <- function(config, source, handle = TRUE){
   contacts <- switch(mime::guess_type(contacts_file),
                      "text/csv" = {
                        handle_contacts_csv <- source(system.file("metadata/contact", "contact_handler_csv.R", package = "geoflow"))$value
-                       handle_contacts_csv(config = config, source = contacts_file, handle = handle)
+                       handle_contacts_csv(handler = handler, source = contacts_file, config = config, handle = handle)
                       },
                      "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet" = {
                        handle_contacts_excel <- source(system.file("metadata/contact", "contact_handler_excel.R", package = "geoflow"))$value
-                       handle_contacts_excel(config = config, source = contacts_file, handle = handle)
+                       handle_contacts_excel(handler = handler, source = contacts_file, config = config, handle = handle)
                      }
   )
   return(contacts)