R/gft_create.R

In jpshanno/gft: Access Google Fusion Tables API (v2)

#' Create a new Fusion Table from an R Object
#'
#' Upload an R object as a Fusion Table. If x is class \link[sf]{st_sf} then the
#' geometry will be converted to KML text prior to uploading for automatic
#' geo-referencing within Fusion Tables. Currently sf_to_kml() only supports
#' point features.
#'
#' @param x A dataframe or simple feature to be written to Google Fusion Table
#' @param name A string representing the name of the new fusion table
#' @param duplicate A logical, where TRUE allows Fusion Tables with the same
#'   name (note that the ID is generated by Fusion Tables will be different even
#'   if names match)
#' @param ... Named arguments specifying path and file to direct
#'   \link{gft_get_token} to the cached OAuth token or a token object
#'
#' @return A string of length 1, the Fusion Table ID
#' @export
#'
gft_create <-
  function(x,
           name,
           duplicate = FALSE,
           ...){

    if(is.character(quote(x))){
      table.file <- x
    } else {
      if(exists(deparse(substitute(x)))){
        table.file <- tempfile(fileext = ".csv")
        if(any(grepl("^sf$", class(x)))){
          x <- sf_to_kml(x)
        }
        utils::write.csv(x,
                         file = table.file,
                         row.names = FALSE)
      } else {
        stop(x, "does not exist in the current environment.")
      }
    }

    token <-
      gft_get_token(...)

    if(!duplicate){
      existing_tables <-
        gft::gft_list(token = token)[["name"]]

      if(name %in% existing_tables){
        stop("A table with that name already exists. Change the name, or set duplicate = TRUE")
      }
    }

    url <-
      paste0("https://www.googleapis.com/upload/fusiontables/v2/tables/import?uploadType=media&name=",
             as.character(name))

    response <-
      httr::POST(url = url,
                 httr::add_headers(`Content-Type` = 'application/octet-stream'),
                 httr::config(token = token),
                 body = httr::upload_file(table.file))

    if(httr::status_code(response) == 200){
      table_id <-
        httr::content(response)$tableId
      return(table_id)
    } else {
      stop("Something went wrong and the table was not uploaded.")
    }
  }