R/RomEntity.R

In HARPgroup/hydro-tools: Data processing and accessors for VAHydro

#' Base entity data object
#' @description Object for storing a single entity with attribute and timeseries related
#' @details Has standard methods for managing data and meta data
#' @importFrom R6 R6Class  
#' @param datasource optional RomDataSource for remote and local storage
#' @param config list of attributes to set
#' @return reference class of type openmi.om.base.
#' @seealso NA
#' @examples NA
#' @export RomEntity
RomEntity <- R6Class(
  "RomEntity",
  public = list(
    #' @field name what is it called
    name = NA,
    #' @field base_entity_type kind of entity
    base_entity_type = NA,
    #' @field datasource RomDataSource
    datasource = NA,
    #' @field pk_name the name of this entity's pk column
    pk_name = "entity_id",
    #' @field entity_id unique ID of entity
    entity_id = NA,
    #' @field sql_select_from syntax to use to select via an odbc or other SQL based datasource
    sql_select_from = NA,
    #' @field base_only - how to export to list in case of complex multi table entity and ODBC
    base_only = FALSE,
    #' @return get_id the unique id of this entity alias to remote pkid, subclassed as function
    get_id = function() {
      return(self$entity_id)
    },
    #' @field has_vardef is pluggable?
    has_vardef = FALSE,
    #' @field varid (optional) integer field for pluggable entities
    varid = NA,
    #' @field vardef (optional) full RomVariableDefinition
    vardef = NULL,
    #' @field plugin (optional) instance of dHVariablePlugin class
    plugin = NA,
    #'@field matrix_revision_id Populated by any use of this object's
    #'  save_field() method to indicate the revision ID of this change to the
    #'  field table. Used to match Drupal 7's now deprecated revision system.
    matrix_revision_id = NA,
    #' @return propvalues unique properties of this entity
    #' @param propname optional name to filter
    #' @param varid option variable to filter
    #' @param propcode optional code to filter
    propvalues = function(propname = NULL, varid = NULL, propcode = NULL) {
      config <- list(
        featureid = self$get_id(), 
        entity_type=self$base_entity_type
      )
      if (!is.null(varid)) { config$varid = varid } 
      if (!is.null(propname)) { config$propname = propname } 
      if (!is.null(propcode)) { config$propcode = propcode } 
      ps <- self$datasource$get_prop(
        config
      )
      return(ps)
    },
    #' @return tsvalues unique timeseries records for this entity
    #' @param varkey option variable to filter
    #' @param tstime timespan begin
    #' @param tsendtime timespan end
    tsvalues = function(varkey = NULL, tstime = NULL, tsendtime = NULL) {
      ts_obj = RomTS$new(self$datasource)
      config <- list(
        featureid = self$get_id(), 
        entity_type=self$base_entity_type
      )
      if (!is.null(varkey)) { 
        vardef <- self$datasource$get_vardef(varkey)
        config$varid = vardef$hydroid
      } 
      if (!is.null(tstime)) { config$tstime = tstime } 
      if (!is.null(tsendtime)) { config$tsendtime = tsendtime } 
      ts <- self$datasource$get_ts(config)
      return(ts)
    },
    #' @param datasource RESTful repository (optional)
    #' @param config list of attributes to set, see also: to_list() for format
    #' @param load_remote automatically query REST data source for matches?
    #' @return object instance
    initialize = function(datasource = NULL, config = list(), load_remote = FALSE) {
      # a config template can be generated by using the to_list() method 
      # of a blank object
      # todo: some of this can be handled by the RomDataSource?
      stopifnot(class(datasource)[[1]] == "RomDataSource")
      self$datasource = datasource 
      if (self$datasource$connection_type == 'odbc') {
        self$base_only = TRUE
      }
      config <- self$handle_config(config)
      if (is.logical(config)) {
        message("Configuration information faild validation. Returning.")
        return(FALSE)
      }
      # if requested, we try to load will return first feature if multiple are
      # preliminaryily returned from get()
      if (load_remote) {
        feature <- self$datasource$get(self$base_entity_type, self$pk_name, config, self)
        # merge config with prop
        message("Found")
        if (!is.logical(feature)) {
            #Grab only the first feature returned
            config = feature[1,]
        }
      }
      self$load_data(config, load_remote)
    },
    #' @param config 
    #' @returns an updated config if necessary or FALSE if it fails
    handle_config = function(config) {
      return(config)
    },
    #' @param config 
    #' @returns loads the varid
    insure_varid = function(config) {
      # this is used by variable enabled objects properties, timeseries, ...
      # it converts a varkey to varid if varkey is supplied
      config_cols <- names(config)
      if (is.element("varkey", config_cols)) {
        if (!is.element("varid", config_cols)) {
          if (!is.null(self$datasource)) {
            vardef = self$get_vardef(config)
            config$varid = vardef$hydroid
            # eliminate this since if passed raw to rest will cause problems
            config$varkey <- NULL
          }
        }
      }
      return(config)
    },
    #' @param config list of attributes to set, see also: to_list() for format
    #' @param refresh automatically refresh var info?
    #' @returns the variable definition object for this entity
    get_vardef = function(config = FALSE, refresh=FALSE) {
      if (self$has_vardef == FALSE) {
        return(FALSE)
      }
      if (!is.null(self$vardef) & !refresh) {
        return(self$vardef)
      }
      #message(paste("config$varkey =",config$varkey,"self$varid =", self$varid))
      if (!is.logical(config)) {
        if ( !('varkey' %in% names(config)) && !('varid' %in% names(config)) ) {
          return(FALSE)
        }
        vardef = self$datasource$get_vardef(config$varkey)
      } else {
        if (is.null(self$varid) && is.null(self$varkey)) {
          return(FALSE)
        }
        if (is.null(self$varid) || is.na(self$varid)) {
          vardef = self$datasource$get_vardef(self$varkey)
        } else {
          vardef = self$datasource$get_vardef(self$varid)
        }
      }
      if (is.logical(vardef)) {
        return(FALSE)
      }
      #message("vardef retrieved, creating RomVar object")
      self$vardef = RomVariableDefinition$new(self$datasource,as.list(vardef))
      return(self$vardef)
    },
    #' @description
        #' Get a 1st order property from this entity (assuming this entities
        #' \code{entity_type}. This method will search for a user propname,
        #' varkey, or propcode from dh_properties using this entity's id
        #' (derived from \code{RomEntity$get_id()} as the featureid. If the
        #' property is not set locally (if remote = FALSE) or in the DB (if
        #' remote = TRUE), then it will return an instance of RomProperty with
        #' the specified user inputs and this entity's ID.
    #' @param propname Propname of the first order property
    #' @param varkey varkey of the first order property (usually used in case of
    #'   new prop creation)
    #' @param propcode propcode of the first order property (usually used in
    #'   case of new prop creation)
    #' @param remote look at remote datasource for properties?
    #' @returns A property object for this entity derived from the local or
    #'   remote DB OR populated by user inputs if property does not exist
    get_prop = function(propname = NULL, varkey = NULL,
                        propcode = NULL, remote = TRUE) {
      if (is.na(self$get_id())) {
        # An object whose id is not set has not been saved and cannot have properties
        return(FALSE)
      }
      #If user provides no data, warn them that only one property will be returned
      if(all(is.null(propname),is.null(propcode),is.null(varkey))) {
        message("No identifying data provided for property, will return the first 1st order property found in db")
      }
      #Create a config for RomProperty using self id as feature id and self
      #entity type
      plist = list(
        featureid=self$get_id(), 
        entity_type=self$base_entity_type,
        propname=propname,
        # these may be a create request, populate varkey
        propcode=propcode,
        varkey=varkey
      )
      #Remove any NULLs where user has not provided data
      plist[!sapply(plist,is.null)]
      #Get (and return) the user specified property
      child_prop = RomProperty$new(
        datasource = self$datasource,
        config = plist[!sapply(plist,is.null)],
        load_remote = remote
      )
      return(child_prop)
    },
    #' @param propname name or property
    #' @param propcode if alpha property use this
    #' @param propvalue if numeric property use this
    #' @param varkey which varkey? defaults to guess Constant and AlphanumericConstant
    #' @param data_matrix dataframe contained rows/cols
    #' @param remote look at remote datasource?
    #' @returns the property object for this entity
    set_prop = function(
    propname, propcode=NULL,propvalue=NULL,varkey=NULL,
    data_matrix=NULL, remote=TRUE
    ) {
      # first, see if it exists to load and update
      # then, change/set the varid and values
      if (is.na(self$get_id())) {
        # An object whose id is not set has not been saved and cannot have properties
        message(paste("Properties without IDs cannot have properties. Returnin FALSE from set_prop() called with for propname,varkey",propname,varkey))
        return(FALSE)
      }
      child_prop = self$get_prop(propname=propname,varkey=varkey,remote=remote)
      if (is.na(child_prop$pid)) {
        # this is new, so we do an update, 
        if(is.null(varkey)) {
          # guess the varkey
          if (!is.null(propcode)) {
            varkey = 'om_class_AlphanumericConstant'
          } else if (!is.null(data_matrix)) {
            varkey = 'om_class_DataMatrix'
          } else {
            varkey = 'om_class_Constant'
          }
        }
      }
      if(!is.null(varkey)) {
        # this may be a create request, populate varkey
        message(paste("searching for varkey",varkey))
        child_prop$varid=self$datasource$get_vardef(varkey)$hydroid
        message(paste("Found ID",child_prop$varid))
      }
      if (!is.null(propvalue)) {child_prop$propvalue = propvalue}
      if (!is.null(propcode)) {child_prop$propcode = propcode}
      if (!is.null(data_matrix)) {child_prop$set_matrix(data_matrix) }
      child_prop$save(remote)
      return(child_prop)
    },
    #' @param config list of attributes to set, see also: to_list() for format
    #' @return NULL
    from_list = function(config) {
      return(TRUE)
    },
    #' @param config 
    #' @param load_remote automatically query remote data source for matches?
    #' @returns the data from the remote connection
    load_data = function(config, load_remote) {
      #message(paste("load_data() called "))
      self$from_list(config)
      #message(paste("Loaded object: "))
      #message(self)
      self$get_vardef()
      #message(paste("Loaded vardef: "))
      self$load_plugin()
      #message(paste("Loaded plugin: "))
      #message("self$pk_name=(below)")
      #message(self$pk_name)
      # this should be handled better.  We need to decide if we want to 
      # still use the local datasource as a repository for remote data
      # at first the thinking was no with ODBC, but maybe that's not correct?
      # in other words, it was thought that ODBC replaced the local storage...
      if (!is.na(self[[self$pk_name]]) && (load_remote == TRUE) ) {
        # stash a copy in the local datasource database 
        # if this was a valid retrieval from remote
        message("Saving to local db")
        #if (self$datasource$connection_type != 'odbc') {
          self$save(FALSE) 
        #}
      } else {
        #message("not saving to local")
      }
      return(TRUE)
    },
    #' @return nothing, but loads the objects plugin
    load_plugin = function() {
      if (is.null(self$vardef)) {
        # this is only valid for types that have vardefs
        return(FALSE)
      }
      # get_plugin method is 
      self$plugin = self$vardef$get_plugin(self)
    },
    #' @param base_only whether to only use base columns (TRUE) or add fields (FALSE)
    #' @return list of object attributes suitable for input to new() and from_list() methods
    to_list = function(base_only=FALSE) {
      # returns as a list, which can be set and fed back to 
      # from_list() or new(config)
      t_list <- list(
        entity_id = self$get_id(),
        name = self$name
      )
      return(t_list)
    },
    #' @param push_remote update locally only or push to remote database
    #' @return NULL
    save = function(push_remote=FALSE) {
      # object class responsibilities
      # - know the required elemenprop such as varid, featureid, entity_type
      #   fail if these required elemenprop are not available 
      if (push_remote) {
        finfo <- self$to_list()
        fid = self$datasource$post(self$base_entity_type, self$pk_name, finfo)
        if (!is.logical(fid)) {
          self[[self$pk_name]] = fid
        }
      }
    },
    #' @param delete_remote update locally only or push to remote database
    #' @return NULL
    delete = function(delete_remote=FALSE) {
      # object class responsibilities
      # - know the required elemenprop such as varid, featureid, entity_type
      #   fail if these required elemenprop are not available 
      if (delete_remote) {
        finfo <- self$to_list()
        fid = self$datasource$delete(self$base_entity_type, self$pk_name, finfo)
      }
    },
    #' @param class_field_name what is this field called on this object (deprecated)
    #' @param field_table table to insert into
    #' @param value_pairs attriutes to add to insert above the basic entity info (field value here)
    #' @param pkeys whether to automatically propagate changes to remote data source
    #' @return NULL
    save_field = function(class_field_name, field_table, value_pairs, pkeys=c('entity_type', 'entity_id')) {
      if (!is.logical(self$get_id()) & (self$datasource$connection_type == 'odbc')) {
        if (!(class_field_name %in% names(self))) {
          message(
            paste(
              "Warning: cannot set field named", class_field_name, 
              "because local property ", class_field_name, 
              "does not exist on object")
          )
          return(FALSE)
        }
        if ( !is.na(self[[class_field_name]])) {
          params <- list(
            entity_id = self$get_id(),
            bundle = self$bundle,
            entity_type = self$base_entity_type,
            language = 'und',
            delta = 0,
            revision_id=self$get_id()
          )
          for (k in names(value_pairs)) {
            params[[k]] = value_pairs[[k]]
          }
          check_list = list()
          for (k in pkeys) {
            check_list[[k]] = params[[k]]
          }
          #message("Check list:")
          #message(check_list)
          # check the table to see if a record exists, if not nullify the rev id
          field_check <- self$datasource$get(
            field_table,"", check_list
          )
          if (is.logical(field_check) || nrow(field_check) == 0) {
            pk <- NA # forces insert
          } else {
            # must delete first because our odbc updates are not sophisticated 
            # enough to handle multiple key matches
            pk <- NA # forces insert
            #message("Deleting old")
            fn_delete_odbc(entity_type = field_table, pk = "", 
                           inputs = check_list, con = self$datasource$connection,
                           obj = FALSE, debug = TRUE)
            #self$datasource$delete(field_table,"", check_list)
          }
          #message("Inserting new")
          self$matrix_revision_id = self$datasource$post(
            entity_type = field_table, pk = pk,
            config = params
          )
        }
      }
      if (is.na(self$get_id()) | is.logical(self$get_id())) {
        message("Cannot save field because property id is null")
      }
    }
  )
)