R/opal.table.R

Defines functions opal.table_perm_delete opal.table_perm opal.table_perm_add opal.table_dictionary_get opal.table_dictionary_update opal.table_export opal.table_import opal.table_save opal.table_truncate opal.table_view_update opal.table_view_create opal.table_create opal.table_exists opal.table_delete opal.table_get

Documented in opal.table_create opal.table_delete opal.table_dictionary_get opal.table_dictionary_update opal.table_exists opal.table_export opal.table_get opal.table_import opal.table_perm opal.table_perm_add opal.table_perm_delete opal.table_save opal.table_truncate opal.table_view_create opal.table_view_update

#-------------------------------------------------------------------------------
# Copyright (c) 2021 OBiBa. All rights reserved.
#  
# This program and the accompanying materials
# are made available under the terms of the GNU Public License v3.0.
#  
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#-------------------------------------------------------------------------------

#' Get a Opal table as a tibble
#'
#' Shortcut function to assign a Opal table to a tibble in the R server-side session
#' and then retrieve it into the R client-side session. Requires to have the permission to
#' see the individual values of the table and to perform R assignments.
#'
#' @family table functions
#' @param opal Opal connection object.
#' @param project Project name where the table is located.
#' @param table Table name from which the tibble should be extracted.
#' @param id.name The name of the column representing the entity identifiers. Default is 'id'. Requires Opal 4.0+.
#' @param variables (Deprecated) List of variable names or Javascript expression that selects the variables of a table (ignored if value does not refer to a table). See javascript documentation: http://wiki.obiba.org/display/OPALDOC/Variable+Methods
#' @param missings (Deprecated) Include the missing values (default is TRUE).
#' @examples 
#' \dontrun{
#' o <- opal.login('administrator','password', url='https://opal-demo.obiba.org')
#' cqx <- opal.table_get(o, "CPTP", "Cag_coreqx")
#' opal.logout(o)
#' }
#' @export
opal.table_get <- function(opal, project, table, id.name='id', variables = NULL, missings = TRUE) {
  tblObj <- opal.table(opal, project, table, counts = TRUE)
  if (tblObj$valueSetCount == 0) {
    tibble::tibble()
  } else {
    pb <- NULL
    localfile <- tempfile(fileext = ".rds")
    if (opal.version_compare(opal,"4.0")<0) {
      pb <- .newProgress(total = 5)
      .tickProgress(pb, tokens = list(what = paste0("Assigning ", project, ".", table)))
      opal.assign.table.tibble(opal, symbol = ".D", value = paste0(project, ".", table), variables = variables, missings = missings)
      
      .tickProgress(pb, tokens = list(what = paste0("Saving in R data file")))
      opal.assign.script(opal, ".file", quote(tempfile(tmpdir = getwd(), fileext = '.rds')))
      file <- opal.execute(opal, ".file")
      filename <- basename(file)
      opal.execute(opal, paste0("saveRDS(.D, file=.file)"))
    
      # clean up 
      tryCatch(opal.symbol_rm(opal, ".D"))
      opal.execute(opal, "gc()")
      
      .tickProgress(pb, tokens = list(what = paste0("Downloading R data file")))
      opaltmp <- opal.file_mkdir_tmp(opal)
      opalfile <- paste0(opaltmp, "/", filename)
      opal.file_read(opal, filename, opalfile)
      opal.execute(opal, paste0("unlink(.file)"))
      opal.file_download(opal, opalfile, localfile)
      opal.file_rm(opal, opaltmp)
      
    } else {
      pb <- .newProgress(total = 4)
      .tickProgress(pb, tokens = list(what = paste0("Exporting ", project, ".", table)))
      localfile <- tempfile(fileext = ".rds")
      filename <- basename(localfile)
      opaltmp <- opal.file_mkdir_tmp(opal)
      opalfile <- paste0(opaltmp, "/", filename)
      opal.table_export(opal, project, table, file = opalfile, id.name = id.name)
      
      .tickProgress(pb, tokens = list(what = paste0("Downloading R data file")))
      opal.file_download(opal, opalfile, localfile)
      opal.file_rm(opal, opaltmp)
    }
    
    .tickProgress(pb, tokens = list(what = paste0("Loading R data file")))
    rval <- readRDS(localfile)
    unlink(localfile)
    .tickProgress(pb, tokens = list(what = "Data loaded"))
    rval
  }
}

#' Delete a Opal table
#'
#' Removes both values and data dictionary of a table, or remove the table's logic if the table is a view.
#' Fails if the table does not exist. See also \link{opal.table_truncate}.
#'
#' @family table functions
#' @param opal Opal connection object.
#' @param project Project name where the table is located.
#' @param table Table name to be deleted.
#' @param silent Warn if table does not exist, default is TRUE.
#' @examples 
#' \dontrun{
#' o <- opal.login('administrator','password', url='https://opal-demo.obiba.org')
#' opal.table_delete(o, "CNSIM", "CNSIM1")
#' opal.logout(o)
#' }
#' @export
opal.table_delete <- function(opal, project, table, silent = TRUE) {
  if (opal.table_exists(opal, project, table)) {
    ignore <- opal.delete(opal, "datasource", project, "table", table)  
  } else if (!silent) {
    warning("Table '", table,"' does not exist in project '", project, "'")
  }
}

#' Check a Opal table exists
#'
#' Check whether a Opal table exists (and is visible). Optionally check whether the table is a raw table 
#' or a view.
#'
#' @family table functions
#' @param opal Opal connection object.
#' @param project Project name where the table is located.
#' @param table Table name.
#' @param view Logical to perform an additional check whether the table is a view (TRUE) or a raw table (FALSE).
#' If NULL or NA, the table can be indifferently a view or a raw table. Default is NA.
#' @examples 
#' \dontrun{
#' o <- opal.login('administrator','password', url='https://opal-demo.obiba.org')
#' # check table exists
#' opal.table_exists(o, "CNSIM", "CNSIM1")
#' # check table exists AND is a NOT a view
#' opal.table_exists(o, "CNSIM", "CNSIM1", view = FALSE)
#' # check table exists AND is a view
#' opal.table_exists(o, "CNSIM", "CNSIM1", view = TRUE)
#' opal.logout(o)
#' }
#' @export
opal.table_exists <- function(opal, project, table, view = NA) {
  res <- tryCatch(opal.table(opal, datasource = project, table = table), 
                  error = function(cond) {
                    NULL
                  })
  if (!is.null(res) && !.is.empty(view) && is.logical(view)) {
    if (view) {
      !is.null(res$viewLink)
    } else {
      is.null(res$viewLink)
    }
  } else {
    !is.null(res)  
  }
}

#' Create an Opal table or view
#'
#' Create an Opal table if it does not already exist. If a list of table references are provided,
#' the table will be a view. The table/view created will have no dictionary, use 
#' \link{opal.table_dictionary_update} to apply a dictionary.
#'
#' @family table functions
#' @param opal Opal connection object.
#' @param project Project name where the table will be located.
#' @param table Table name to be created
#' @param type Entity type, default is "Participant". Ignored if some table references are 
#' provided.
#' @param tables List of the fully qualified table names that are referred by the view.
#' @examples 
#' \dontrun{
#' o <- opal.login('administrator','password', url='https://opal-demo.obiba.org')
#' # make a raw table
#' opal.table_create(o, "CNSIM", "CNSIM4")
#' # make a view
#' opal.table_create(o, "CNSIM", "CNSIM123", 
#'                   tables = c("CNSIM.CNSIM1", "CNSIM.CNSIM2", "CNSIM.CNSIM3"))
#' opal.logout(o)
#' }
#' @export
opal.table_create <- function(opal, project, table, type = "Participant", tables = NULL) {
  if (!opal.table_exists(opal, project, table)) {
    if (.is.empty(tables)) {
      body <- jsonlite::toJSON(list(name = table, entityType = type), auto_unbox = TRUE)
      ignore <- opal.post(opal, "datasource", project, "tables", contentType = "application/json", body = body)
    } else {
      body <- jsonlite::toJSON(list(name = table, from = tables, "Magma.VariableListViewDto.view" = list(variables = list())), auto_unbox = TRUE)
      ignore <- opal.post(opal, "datasource", project, "views", contentType = "application/json", body = body)
    }
  } else {
    stop("Table '", table,"' already exists in project '", project, "'.")
  }
}


#' Create an Opal view over tables
#'
#' Create an Opal view if a table with same name does not already exist. The view
#' created will have no dictionary, use \link{opal.table_dictionary_update} to 
#' apply a dictionary.
#'
#' @family table functions
#' @param opal Opal connection object.
#' @param project Project name where the table will be located.
#' @param table Table name to be created
#' @param tables List of the fully qualified table names that are referred by the view.
#' @param type Entity type, default is "Participant". Ignored if some table references are 
#' provided.
#' @examples 
#' \dontrun{
#' o <- opal.login('administrator','password', url='https://opal-demo.obiba.org')
#' # make a view
#' opal.table_view_create(o, "CNSIM", "CNSIM123", 
#'                        c("CNSIM.CNSIM1", "CNSIM.CNSIM2", "CNSIM.CNSIM3"))
#' opal.logout(o)
#' }
#' @export
opal.table_view_create <- function(opal, project, table, tables, type = "Participant") {
  if (!opal.table_exists(opal, project, table)) {
    body <- jsonlite::toJSON(list(name = table, from = tables, "Magma.VariableListViewDto.view" = list(variables = list())), auto_unbox = TRUE)
    ignore <- opal.post(opal, "datasource", project, "views", contentType = "application/json", body = body)
  } else {
    stop("Table '", table,"' already exists in project '", project, "'.")
  }
}

#' Update the table references and the entity filter of an Opal view
#'
#' Update the table references and/or the entity filter of an existing Opal view. The view
#' dictionary will NOT be modified (use \link{opal.table_dictionary_update} to
#' apply a dictionary).
#'
#' @family table functions
#' @param opal Opal connection object.
#' @param project Project name where the table will be located.
#' @param table Table name to be created.
#' @param tables List of the fully qualified table names that are referred by the view. Not modified when NULL (default).
#' @param where The entity filter script. Not modified when NULL (default). To remove the filter, set an empty string.
#' @examples
#' \dontrun{
#' o <- opal.login('administrator','password', url='https://opal-demo.obiba.org')
#' # make a view
#' opal.table_view_create(o, "CNSIM", "CNSIM123",
#'                        c("CNSIM.CNSIM1"))
#' 
#' # update the table references
#' opal.table_view_update(o, "CNSIM", "CNSIM123",
#'                        tables = c("CNSIM.CNSIM1", "CNSIM.CNSIM2", "CNSIM.CNSIM3"))
#' 
#' # update the entity filter
#' opal.table_view_update(o, "CNSIM", "CNSIM123", where = "$('LAB_TSC').ge(5)")
#' 
#' # remove the entity filter
#' opal.table_view_update(o, "CNSIM", "CNSIM123", where = "")
#' 
#' # update both the table references and the entity filter
#' opal.table_view_update(o, "CNSIM", "CNSIM123",
#'                        tables = c("CNSIM.CNSIM1", "CNSIM.CNSIM2", "CNSIM.CNSIM3"),
#'                        where = "$('LAB_TSC').ge(5)")
#' opal.logout(o)
#' }
#' @export
opal.table_view_update <- function(opal, project, table, tables = NULL, where = NULL) {
  view <- opal.get(opal, "datasource", project, "view", table)
  if (!is.null(tables)) {
    view$from <- tables  
  }
  if (!is.null(where)) {
    if (nchar(where) == 0) {
      view$where <- NULL
    } else {
      view$where <- where  
    }
  }
  ignore <- opal.put(opal, "datasource", project, "view", table, body = jsonlite::toJSON(view, auto_unbox = TRUE), contentType = "application/json")
}

#' Truncate a Opal table
#'
#' Removes the values of a table and keep the dictionary untouched. Fails if the table does
#' not exist or is a view. See also \link{opal.table_delete}.
#'
#' @family table functions
#' @param opal Opal connection object.
#' @param project Project name where the table is located.
#' @param table Table name to be truncated.
#' @examples 
#' \dontrun{
#' o <- opal.login('administrator','password', url='https://opal-demo.obiba.org')
#' opal.table_truncate(o, "CNSIM", "CNSIM1")
#' opal.logout(o)
#' }
#' @export
opal.table_truncate <- function(opal, project, table) {
  if (opal.table_exists(opal, project = project, table = table, view = FALSE)) {
    ignore <- opal.delete(opal, "datasource", project, "table", table, "valueSets")  
  } else {
    warning("Table '", table,"' does not exist in project '", project, "' or is a view.")
  }
}

#' Save a local tibble as a Opal table
#'
#' Upload a local tibble to the R server side through Opal, assign this tibble to the provided
#' symbol name and import it as a table into a Opal project.
#'
#' @family table functions
#' @param opal Opal connection object.
#' @param tibble The tibble object to be imported.
#' @param project Project name where the table will be located.
#' @param table Destination table name.
#' @param overwrite If the destination table already exists, it will be replaced (deleted, 
#' re-created with associated permissions reinstated and then imported). Otherwise the table
#' will be updated (data dictionaries merge may conflict). Default  is TRUE. See 
#' also \link{opal.table_truncate} function.
#' @param force If the destination already exists, stop with an informative message if this flag 
#' is FALSE (default).
#' @param identifiers Name of the identifiers mapping to use when assigning entities to Opal.
#' @param policy Identifiers policy: 'required' (each identifiers must be mapped prior importation 
#' (default)), ignore' (ignore unknown identifiers) and 'generate' (generate a system identifier for 
#' each unknown identifier).
#' @param id.name The name of the column representing the entity identifiers. Default is 'id'.
#' @param type Entity type (what the data are about). Default is 'Participant'
#' @return An invisible logical indicating whether the destination table exists.
#' @examples 
#' \dontrun{
#' o <- opal.login('administrator','password', url='https://opal-demo.obiba.org')
#' cqx <- opal.table_get(o, "CPTP", "Cag_coreqx")
#' # do some (meta)data transformations, then save in opal's database
#' opal.table_save(o, cqx, "CPTP", "Cag_coreqx", overwrite = TRUE, force = TRUE)
#' # or overwrite data only (keep original data dictionary)
#' opal.table_save(o, cqx, "CPTP", "Cag_coreqx", overwrite = 'values', force = TRUE)
#' opal.logout(o)
#' }
#' @export
#' @import jsonlite
opal.table_save <- function(opal, tibble, project, table, overwrite = TRUE, force = FALSE, identifiers=NULL, policy='required', id.name='id', type='Participant') {
  tbl <- tibble
  if (!tibble::is_tibble(tibble)) {
    if (!is.data.frame(tibble))
      stop("The tibble parameter must be a tibble.")
    else {
      warning("Coercing data.frame to a tibble...")
      tbl <- tibble::as_tibble(tibble)
    }
  }
  if (!(id.name %in% names(tbl))) {
    stop("The identifiers column '", id.name,"' is missing.")
  }
  if (!is.character(tbl[[id.name]])) {
    tbl[[id.name]] <- as.character(tbl[[id.name]])  
  }
  dictionary.inspect(tbl, id.name = id.name)
  
  if (opal.version_compare(opal,"4.0")<0) {
    pb <- .newProgress(total = 7)
  } else {
    pb <- .newProgress(total = 6)
  }
  
  .tickProgress(pb, tokens = list(what = paste0("Checking ", project, " project")))
  if (opal.table_exists(opal, project, table, view = FALSE)) {
    if (overwrite) {
      if (!force) {
        stop("Destination table needs to be deleted or truncated. Use 'force' parameter to proceed.")
      }
      .tickProgress(pb, tokens = list(what = paste0("Deleting ", table, " from ", project)))
      acls <- opal.table_perm(opal, project, table)
      opal.table_delete(opal, project, table)
      opal.table_create(opal, project, table, type = type)
      if (nrow(acls)>0) {
        lapply(1:nrow(acls), function(i) {
          acl <- acls[i,]
          opal.table_perm_add(opal, project, table, acl$subject, acl$type, acl$permission)
        })
      }
    } else {
      if (!force) {
        stop("Destination table will be updated. There could be data dictionary conflicts. Use 'force' parameter to proceed.")
      }
      .tickProgress(pb, tokens = list(what = paste0("Merging with ", table, " from ", project)))
    }
  } else if (opal.table_exists(opal, project, table, view = TRUE)) {
    stop("Destination table is a view.")
  } else {
    .tickProgress(pb, tokens = list(what = paste0("Creating table ", table, " in ", project)))
    opal.table_create(opal, project, table, type = type)
  }
  
  .tickProgress(pb, tokens = list(what = paste0("Saving in R data file")))
  file <- tempfile(fileext = ".rds")
  saveRDS(tbl, file = file)
  
  .tickProgress(pb, tokens = list(what = paste0("Uploading R data file")))
  tmp <- opal.file_mkdir_tmp(opal)
  opal.file_upload(opal, file, tmp)
  filename <- basename(file)
  unlink(file)
  opalFile <- paste0(tmp, filename)
  
  if (opal.version_compare(opal,"4.0")<0) {
    # write file in R session
    opal.file_write(opal, opalFile)
    opal.file_rm(opal, tmp)
    
    .tickProgress(pb, tokens = list(what = paste0("Loading R data file")))
    opal.execute(opal, paste0("assign('", table, "', readRDS('", filename, "'))"))
    opal.execute(opal, paste0("unlink('", filename, "')"))
    
    .tickProgress(pb, tokens = list(what = paste0("Importing ", table, " into ", project)))
    opal.symbol_import(opal, table, project = project, identifiers = identifiers, policy = policy, id.name = id.name, type = type)
    
    # clean up R session
    tryCatch(opal.symbol_rm(opal, table))
    opal.execute(opal, "gc()")
  } else {
    .tickProgress(pb, tokens = list(what = paste0("Importing ", table, " into ", project)))
    opal.table_import(opal, file = opalFile, project = project, table = table, identifiers = identifiers, policy = policy, id.name = id.name, type = type)
    opal.file_rm(opal, tmp)
  }
  
  rval <- table %in% opal.datasource(opal, project)$table
  .tickProgress(pb, tokens = list(what = "Save completed"))
  invisible(rval)
}

#' Import a file as table
#' 
#' Import a file as a table in Opal. The file formats supported are: RDS (.rds), SPSS (.sav), 
#' SPSS compressed (.zsav), SAS (.sas7bdat), SAS Transport (.xpt), Stata (.dta). 
#' The RDS format is a serialized single R object (expected to be of tibble class), that can be obtained using base::saveRDS().
#' The other file formats are the ones supported by the haven R package.
#' This operation creates an importation task in Opal that can be followed (see tasks related functions).
#' 
#' @family table functions
#' @param opal Opal object.
#' @param file Path in Opal to the file that will be read as a tibble.
#' @param project Name of the project into which the data are to be imported.
#' @param table Destination table name.
#' @param identifiers Name of the identifiers mapping to use when assigning entities to Opal.
#' @param policy Identifiers policy: 'required' (each identifiers must be mapped prior importation (default)), 'ignore' (ignore unknown identifiers) and 'generate' (generate a system identifier for each unknown identifier). 
#' @param id.name The name of the column representing the entity identifiers. Default is 'id'.
#' @param type Entity type (what the data are about). Default is 'Participant'.
#' @param wait Wait for import task completion. Default is TRUE.
#' @examples 
#' \dontrun{
#' o <- opal.login('administrator','password', url='https://opal-demo.obiba.org')
#' opal.table_import(o, '/home/administrator/mydataset.rds', 'test', 'mytable')
#' opal.logout(o)
#' }
#' @export
#' @import tools
opal.table_import <- function(opal, file, project, table, identifiers=NULL, policy='required', id.name='id', type='Participant', wait=TRUE) {
  if (!(tools::file_ext(file) %in% c("rds", "sav", "zsav", "sas7bdat", "xpt", "dta"))) {
    stop("File extension not supported for import: ", tools::file_ext(file))
  }
  if (endsWith(file, "rds") && !is.na(opal$version) && opal.version_compare(opal,"4.0")<0) {
    stop("Importing a RDS data file into a table is not available for opal ", opal$version, " (4.0.0 or higher is required)")
  } else {
    # create a transient datasource
    dsFactory <- list(file=file, symbol=table, entityType=type, idColumn=id.name)
    if (is.null(identifiers)) {
      dsFactory <- paste0('{"Magma.RHavenDatasourceFactoryDto.params": ', .listToJson(dsFactory), '}') 
    } else {
      idConfig <- list(name=identifiers)
      if (policy == 'required') {
        idConfig["allowIdentifierGeneration"] <- TRUE
        idConfig["ignoreUnknownIdentifier"] <- TRUE
      } else if (policy == 'ignore') {
        idConfig["allowIdentifierGeneration"] <- FALSE
        idConfig["ignoreUnknownIdentifier"] <- TRUE
      } else {
        idConfig["allowIdentifierGeneration"] <- FALSE
        idConfig["ignoreUnknownIdentifier"] <- FALSE
      }
      dsFactory <- paste0('{"Magma.RHavenDatasourceFactoryDto.params": ', .listToJson(dsFactory), ', "idConfig":', .listToJson(idConfig),'}')
    }
    created <- opal.post(opal, "project", project, "transient-datasources", body=dsFactory, contentType="application/json")
    # launch a import task
    importCmd <- list(destination=project, tables=list(paste0(created$name, '.', table)))
    location <- opal.post(opal, "project", project, "commands", "_import", body=.listToJson(importCmd), contentType="application/json", callback=.handleResponseLocation)
    if (!is.null(location)) {
      # /shell/command/<id>
      task <- substring(location, 16)
      if (wait) {
        status <- 'NA'
        waited <- 0
        while(!is.element(status, c('SUCCEEDED','FAILED','CANCELED'))) {
          # delay is proportional to the time waited, but no more than 10s
          delay <- min(10, max(1, round(waited/10)))
          Sys.sleep(delay)
          waited <- waited + delay
          command <- opal.project_command(opal, project, task)
          status <- command$status
        }
        if (is.element(status, c('FAILED','CANCELED'))) {
          stop(paste0('Import of "', file, '" ended with status: ', status), call.=FALSE)
        }
      } else {
        # returns the task ID so that task completion can be followed
        task
      }
    } else {
      # not supposed to be here
      location
    }
  }
}

#' Export a table as a file
#' 
#' Export a table as file in the specified format. The file destination is in the Opal server 
#' file system. See \link{opal.file_download} to download the file locally. See also 
#' \link{opal.table_get} to get directly the table as an R object.
#'
#' @family table functions
#' @param opal Opal connection object.
#' @param project Project name where the table is located.
#' @param table Table name to export.
#' @param file Destination file in the Opal file system. The expected file extensions are: 
#' rds (RDS), sav (SPSS), zsav (SPSS compressed), sas7bdat (SAS), xpt (SAS Transport), 
#' dta (Stata).RDS (serialized single R object) is to be read by base::readRDS(), 
#' while other formats are supported by the haven R package.
#' @param identifiers Name of the identifiers mapping to use when exporting entities from Opal.
#' @param id.name The name of the column representing the entity identifiers. Default is 'id'.
#' @param wait Wait for import task completion. Default is TRUE.
#' @examples 
#' \dontrun{
#' o <- opal.login('administrator','password', url='https://opal-demo.obiba.org')
#' cqx <- opal.table_export(o, "CNSIM", "CNSIM1", 
#'                          file = "/home/administrator/cnsim1.sav")
#' opal.logout(o)
#' }
#' @export
opal.table_export <- function(opal, project, table, file, identifiers=NULL, id.name='id', wait = TRUE) {
  format <- tools::file_ext(file)
  if (!(format %in% c("rds", "sav", "zsav", "sas7bdat", "xpt", "dta"))) {
    stop("Format not supported for export: ", format)
  }
  config <- list(
    tables = list(paste0(project, ".", table)),
    format = format,
    out = file,
    nonIncremental = TRUE,
    noVariables = FALSE,
    copyNullValues = TRUE,
    entityIdNames = id.name
  )
  if (!is.null(identifiers)) {
    config$idConfig <- list(
      name = identifiers,
      allowIdentifierGeneration = FALSE,
      ignoreUnknownIdentifier = FALSE
    )
  }
  location <- opal.post(opal, "project", project, "commands", "_export", body=jsonlite::toJSON(config, auto_unbox = TRUE), contentType="application/json", callback=.handleResponseLocation)
  if (!is.null(location)) {
    # /shell/command/<id>
    task <- substring(location, 16)
    if (wait) {
      status <- 'NA'
      waited <- 0
      while(!is.element(status, c('SUCCEEDED','FAILED','CANCELED'))) {
        # delay is proportional to the time waited, but no more than 10s
        delay <- min(10, max(1, round(waited/10)))
        Sys.sleep(delay)
        waited <- waited + delay
        command <- opal.get(opal, "shell", "command", task)
        status <- command$status
      }
      if (is.element(status, c('FAILED','CANCELED'))) {
        stop(paste0('Export of "', project, ".", table, '" ended with status: ', status), call.=FALSE)
      }
    } else {
      # returns the task ID so that task completion can be followed
      task
    }
  } else {
    # not supposed to be here
    location
  }
}

#' Update the dictionary of a Opal table
#' 
#' Directly update the dictionary of a Opal table with the provided dictionary.
#' 
#' @family table functions
#' @param opal Opal connection object.
#' @param project Project name where the table will be located.
#' @param table Destination table name.
#' @param variables A data frame with one row per variable (column name) and then one column per property/attribute (Opal Excel format).
#' @param categories A data frame with one row per category (columns variable and name) and then column per property/attribute (Opal Excel format). If there are
#' no categories, this parameter is optional.
#' @examples 
#' \dontrun{
#' o <- opal.login('administrator','password', url='https://opal-demo.obiba.org')
#' variables <- tibble::tribble(
#'   ~name, ~valueType, ~`label:en`,  ~`Namespace::Name`, ~unit, ~repeatable, ~index,
#'   "mpg", "decimal", "Mpg label",  "Value1", "years", 0, 1,
#'   "cyl", "decimal", "Cyl label",  "Value2", "kg/m2", 0, 2,
#'   "disp", "decimal", "Disp label", NA, NA, 1, 3
#' )
#' categories <- tibble::tribble(
#'   ~variable, ~name, ~missing, ~`label:en`, ~`label:fr`,
#'   "cyl", "4", 0, "Four", "Quatre",
#'   "cyl", "6", 0, "Six", "Six",
#'   "cyl", "8", 1, "Height", "Huit"
#' )
#' opal.table_dictionary_update(o, "test", "mtcars", variables, categories)
#' opal.logout(o)
#' }
#' @export
opal.table_dictionary_update <- function(opal, project, table, variables, categories = NULL) {
  body <- .toJSONVariables(table=table, variables = variables, categories = categories)
  ignore <- opal.post(opal, "datasource", project, "table", table, "variables", contentType = "application/json", body = body)
}

#' Get the dictionary of a Opal table
#' 
#' Get the dictionary of a Opal table in a format that can be re-applied with opal.table_dictionary_update.
#' 
#' @family table functions
#' @param opal Opal connection object.
#' @param project Project name where the table will be located.
#' @param table Table name.
#' @examples 
#' \dontrun{
#' o <- opal.login('administrator','password', url='https://opal-demo.obiba.org')
#' dico <- opal.table_dictionary_get(o, "CNSIM", "CNSIM1")
#' opal.logout(o)
#' }
#' @export
opal.table_dictionary_get <- function(opal, project, table) {
  
  toAttributeKey <- function(attr) {
    key <- attr$name
    if ("namespace" %in% names(attr)) {
      key <- paste0(attr$namespace, "::", key)  
    }
    if ("locale" %in% names(attr)) {
      key <- paste0(key, ":", attr$locale)  
    }
    key
  }
  
  res <- opal.get(opal, "datasource", project, "table", table, "variables")
  n <- length(res)
  if (n > 0) {
    name <- rep(NA_character_, n)
    entityType <- rep(NA_character_, n)
    valueType <- rep(NA_character_, n)
    unit <- rep(NA_character_, n)
    referencedEntityType <- rep(NA_character_, n)
    mimeType <- rep(NA_character_, n)
    repeatable <- rep(FALSE, n)
    occurrenceGroup <- rep(NA_character_, n)
    index <- rep(NA_integer_, n)
    variables.attributes <- list()
    
    categories.variable <- c()
    categories.name <- c()
    categories.missing <- c()
    categories.attributes <- list()
    
    # read variables
    for (i in 1:n) {
      var <- res[[i]]
      name[i] <- var$name
      entityType[i] <- var$entityType
      valueType[i] <- var$valueType
      unit[i] <- as.character(.nullToNA(var$unit))
      referencedEntityType[i] <- as.character(.nullToNA(var$referencedEntityType))
      mimeType[i] <- as.character(.nullToNA(var$mimeType))
      repeatable[i] <- ifelse(is.null(var$isRepeatable), FALSE, var$isRepeatable)
      occurrenceGroup[i] <- as.character(.nullToNA(var$occurrenceGroup))
      index[i] <- var$index
      
      # read variable's attributes
      if (!is.null(var$attributes)) {
        for (attribute in var$attributes) {
          key <- toAttributeKey(attribute)
          if (!(key %in% c("class", "labels_names") || startsWith(key, "opal."))) {
            if (!(key %in% names(variables.attributes))) {
              a <- list()
              a[[key]] <- rep(NA, n)
              variables.attributes <- append(variables.attributes, a)
            }
            variables.attributes[[key]][i] <- attribute$value
          }
        }
      }
      
      # read variable's categories
      catn <- length(var$categories)
      cat.name <- rep(NA, catn)
      cat.missing <- rep(NA, catn)
      cat.attributes <- list()
      if (catn > 0) {
        for (j in 1:catn) {
          cat <- var$categories[[j]]
          cat.name[j] <- cat$name
          cat.missing[j] <- ifelse(cat$isMissing, TRUE, FALSE)
          if (!is.null(cat$attributes)) {
            for (attribute in cat$attributes) {
              key <- toAttributeKey(attribute)
              if (!(key %in% names(cat.attributes))) {
                a <- list()
                a[[key]] <- rep(NA_character_, catn)
                cat.attributes <- append(cat.attributes, a)
              }
              cat.attributes[[key]][j] <- attribute$value
            }
          }
        }
        
        lg <- length(categories.name) # original length before appending
        categories.variable <- append(categories.variable, rep(var$name, catn))
        categories.name <- append(categories.name, cat.name)
        categories.missing <- append(categories.missing, cat.missing)
        for (col in names(cat.attributes)) {
          if (!(col %in% names(categories.attributes))) {
            # init with NAs
            categories.attributes[[col]] <- rep(NA, lg)
          } else {
            # complete with NAs
            times <- lg - length(categories.attributes[[col]])
            categories.attributes[[col]] <- append(categories.attributes[[col]], rep(NA, times))
          }
          categories.attributes[[col]] <- append(categories.attributes[[col]], cat.attributes[[col]])
        }
      }
    }
    
    # build output data frames
    variables <- data.frame(name, entityType, valueType, unit, referencedEntityType, mimeType, repeatable, occurrenceGroup, index, stringsAsFactors = FALSE) 
    for (col in names(variables.attributes)) {
      variables[[col]] <- variables.attributes[[col]]
    }
    categories <- data.frame(variable = categories.variable, name = categories.name, missing = categories.missing, stringsAsFactors = FALSE)
    for (col in names(categories.attributes)) {
      times <- length(categories.name) - length(categories.attributes[[col]])
      if (times>0) {
        categories.attributes[[col]] <- append(categories.attributes[[col]], rep(NA, times))
      }
      categories[[col]] <- categories.attributes[[col]]
    }
    list(project = project, table = table, variables = variables, categories = categories)
  } else {
    list()
  }
}

#' Add or update a permission on a table
#' 
#' Add or update a permission on a table.
#' 
#' @family table functions
#' @param opal Opal connection object.
#' @param project Project name where the table will be located.
#' @param table Destination table name.
#' @param subject A vector of subject identifiers: user names or group names (depending on the type).
#' @param type The type of subject: user (default) or group.
#' @param permission The permission to apply: view, view-values, edit, edit-values, administrate. The 'view' permission
#' is suitable for DataSHIELD operations. 
#' @examples 
#' \dontrun{
#' o <- opal.login('administrator','password', url='https://opal-demo.obiba.org')
#' opal.table_perm_add(o, 'CNSIM', 'CNSIM1', c('andrei', 'valentina'), 'user', 'view')
#' opal.table_perm(o, 'CNSIM', 'CNSIM1')
#' opal.table_perm_delete(o, 'CNSIM', 'CNSIM1', c('andrei', 'valentina'), 'user')
#' opal.logout(o)
#' }
#' @export
opal.table_perm_add <- function(opal, project, table, subject, type = "user", permission) {
  if (!(tolower(type) %in% c("user", "group"))) {
    stop("Not a valid subject type: ", type)
  }
  perms <- list('view' = 'TABLE_READ',
               'view-values' = 'TABLE_VALUES',
               'edit' = 'TABLE_EDIT',
               'edit-values' = 'TABLE_VALUES_EDIT',
               'administrate' = 'TABLE_ALL')
  perm <- perms[[permission]]
  if (is.null(perm)) {
    stop("Not a valid table permission name: ", permission)
  }
  opal.table_perm_delete(opal, project, table, subject, type)
  for (i in 1:length(subject)) {
    ignore <- opal.post(opal, "project", project, "permissions", "table", table, query = list(principal = subject[i], type = toupper(type), permission = perm))
  }
}

#' Get the permissions on a table
#' 
#' Get the permissions that were applied on a table.
#' 
#' @family table functions
#' @param opal Opal connection object.
#' @param project Project name where the table will be located.
#' @param table Destination table name.
#' 
#' @return A data.frame with columns: subject, type, permission
#' @examples 
#' \dontrun{
#' o <- opal.login('administrator','password', url='https://opal-demo.obiba.org')
#' opal.table_perm_add(o, 'CNSIM', 'CNSIM1', c('andrei', 'valentina'), 'user', 'view')
#' opal.table_perm(o, 'CNSIM', 'CNSIM1')
#' opal.table_perm_delete(o, 'CNSIM', 'CNSIM1', c('andrei', 'valentina'), 'user')
#' opal.logout(o)
#' }
#' @export
opal.table_perm <- function(opal, project, table) {
  perms <- list('TABLE_READ' = 'view',
                'TABLE_VALUES' = 'view-values',
                'TABLE_EDIT' = 'edit',
                'TABLE_VALUES_EDIT' = 'edit-values',
                'TABLE_ALL' = 'administrate')
  acls <- opal.get(opal, "project", project, "permissions", "table", table)
  .aclsToDataFrame(perms, acls)
}

#' Delete a permission from a table
#' 
#' Delete a permission that was applied on a table. Silently returns when there is no such permission.
#' 
#' @family table functions
#' @param opal Opal connection object.
#' @param project Project name where the table will be located.
#' @param table Destination table name.
#' @param subject A vector of subject identifiers: user names or group names (depending on the type).
#' @param type The type of subject: user (default) or group.
#' @examples 
#' \dontrun{
#' o <- opal.login('administrator','password', url='https://opal-demo.obiba.org')
#' opal.table_perm_add(o, 'CNSIM', 'CNSIM1', c('andrei', 'valentina'), 'user', 'view')
#' opal.table_perm(o, 'CNSIM', 'CNSIM1')
#' opal.table_perm_delete(o, 'CNSIM', 'CNSIM1', c('andrei', 'valentina'), 'user')
#' opal.logout(o)
#' }
#' @export
opal.table_perm_delete <- function(opal, project, table, subject, type = "user") {
  if (!(tolower(type) %in% c("user", "group"))) {
    stop("Not a valid subject type: ", type)
  }
  if (length(subject)<1) {
    stop("At least one subject is required")
  }
  for (i in 1:length(subject)) {
    ignore <- opal.delete(opal, "project", project, "permissions", "table", table, query = list(principal = subject[i], type = toupper(type)))
  }
}

Try the opalr package in your browser

Any scripts or data that you put into this service are public.

opalr documentation built on Oct. 6, 2023, 5:08 p.m.